tabDist.R 3.34 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6 7 8
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is a tab for plotting box-plots at selected time points
#

# UI ----
dmattek's avatar
dmattek committed
9
tabDistPlotUI =  function(id, label = "Snapshots at time points") {
dmattek's avatar
Added:  
dmattek committed
10 11 12
  ns <- NS(id)
  
  tagList(
dmattek's avatar
Mod:  
dmattek committed
13
    h4(
dmattek's avatar
dmattek committed
14
      "Box-/dot-/violin plots at selected time points"
dmattek's avatar
Mod:  
dmattek committed
15 16 17
    ),
    br(),
    
dmattek's avatar
Added:  
dmattek committed
18 19
    uiOutput(ns('varSelTpts')),
    
dmattek's avatar
dmattek committed
20 21 22 23 24
    # This is an experimental feature to re-normalise data points with respect to a selected time point
    # Current implementation is limited; in the future slider should be replaced by an input field or a choice list.
    # currenlty, if the selected time point is larger than the smallest time point for snapshot plotting, error appears.
    #checkboxInput(ns('chBfoldCh'), 'Fold change w.r.t. t-point:'),
    #uiOutput(ns('uiSlFoldChTp')),
dmattek's avatar
Added:  
dmattek committed
25
    
dmattek's avatar
Added:  
dmattek committed
26
    modStatsUI(ns('dispStats')),
dmattek's avatar
Mod:  
dmattek committed
27
    br(),
dmattek's avatar
Added:  
dmattek committed
28
   
dmattek's avatar
dmattek committed
29
    modDistPlotUI(ns('distPlot')) 
dmattek's avatar
Added:  
dmattek committed
30 31 32
  )
}

dmattek's avatar
dmattek committed
33
# SERVER ----
dmattek's avatar
dmattek committed
34
tabDistPlot = function(input, output, session, in.data, in.fname) {
dmattek's avatar
Added:  
dmattek committed
35 36 37 38
  
  callModule(modStats, 'dispStats',
             in.data = data4boxPlot,
             in.meascol = 'y',
dmattek's avatar
dmattek committed
39
             in.bycols = c(COLRT, COLGR),
majpark21's avatar
majpark21 committed
40
             in.fname = 'individualsTP.csv')
dmattek's avatar
Added:  
dmattek committed
41
  
dmattek's avatar
dmattek committed
42
  callModule(modDistPlot, 'distPlot', 
dmattek's avatar
Added:  
dmattek committed
43
             in.data = data4boxPlot, 
dmattek's avatar
dmattek committed
44 45 46
             in.cols = list(meas.x = COLRT,
                            meas.y = COLY,
                            group = COLGR,
dmattek's avatar
dmattek committed
47 48
                            id = COLID),
             in.labels = list(x = "Time points", y = "", legend = "Groups:"),
dmattek's avatar
Added:  
dmattek committed
49 50
             in.fname = in.fname)
  
dmattek's avatar
Added:  
dmattek committed
51 52 53 54 55 56 57 58 59 60
  # return all unique time points (real time)
  # This will be used to display in UI for box-plot
  # These timepoints are from the original dt and aren't affected by trimming of x-axis
  getDataTpts <- reactive({
    cat(file = stderr(), 'getDataTpts\n')
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    else
dmattek's avatar
dmattek committed
61
      return(unique(loc.dt[[COLRT]])) # column name specified in data4trajPlot
dmattek's avatar
Added:  
dmattek committed
62
  })
dmattek's avatar
Added:  
dmattek committed
63 64 65 66 67 68 69 70 71

  output$uiSlFoldChTp = renderUI({
    ns <- session$ns

    if(input$chBfoldCh)
      sliderInput(ns('slFoldChTp'), 'Time before:', min = 0, max = 10, value = 1)
    
  })
    
dmattek's avatar
Added:  
dmattek committed
72 73 74 75 76 77 78 79 80
  # prepare data for plotting boxplots
  # uses the same dt as for trajectory plotting
  # returns dt with these columns:
  data4boxPlot <- reactive({
    cat(file = stderr(), 'data4boxPlot\n')
    
    loc.dt = in.data()
    if (is.null(loc.dt))
      return(NULL)
dmattek's avatar
Added:  
dmattek committed
81

dmattek's avatar
dmattek committed
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
    # This is part of re-nromalisation with respect to a time point.
    # Test version here; works but needs improvements; see UI section
    # if(input$chBfoldCh) {
    #   out.dt = loc.dt[get(COLRT) %in% input$inSelTpts]
    #   loc.dt.aux = loc.dt[get(COLRT) %in% c(as.numeric(input$inSelTpts) - input$slFoldChTp)]
    #   loc.y.prev = loc.dt.aux[, y]
    # 
    #   out.dt[, y.prev := loc.y.prev]
    # 
    #   out.dt[, y := abs(y / y.prev)]
    # 
    #   out.dt[, y.prev := NULL]
    # 
    # } else
      out.dt = loc.dt[get(COLRT) %in% input$inSelTpts]
dmattek's avatar
Added:  
dmattek committed
97
    
dmattek's avatar
Added:  
dmattek committed
98 99
    
    return(out.dt)
dmattek's avatar
Added:  
dmattek committed
100 101 102 103 104 105 106 107
  })
  
  output$varSelTpts = renderUI({
    cat(file = stderr(), 'UI varSelTpts\n')
    
    ns <- session$ns
    
    loc.v = getDataTpts()
dmattek's avatar
dmattek committed
108
    
dmattek's avatar
Added:  
dmattek committed
109 110 111
    if (!is.null(loc.v)) {
      selectInput(
        ns('inSelTpts'),
dmattek's avatar
dmattek committed
112
        'Select one or more time points:',
dmattek's avatar
Added:  
dmattek committed
113 114
        loc.v,
        width = '100%',
dmattek's avatar
dmattek committed
115
        selected = loc.v[[1]],
dmattek's avatar
Added:  
dmattek committed
116 117 118 119
        multiple = TRUE
      )
    }
  })
dmattek's avatar
Mod:  
dmattek committed
120

dmattek's avatar
Added:  
dmattek committed
121
 
dmattek's avatar
Added:  
dmattek committed
122
}