tabBoxPlot.R 2.86 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
Added:  
dmattek committed
9 10 11 12
tabBoxPlotUI =  function(id, label = "Comparing t-points") {
  ns <- NS(id)
  
  tagList(
dmattek's avatar
Mod:  
dmattek committed
13
    h4(
14
      "Box-/dot-/violin plot at selected t-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
Added:  
dmattek committed
20 21
    checkboxInput(ns('chBfoldCh'), 'Fold change w.r.t. t-point:'),
    uiOutput(ns('uiSlFoldChTp')),
dmattek's avatar
Added:  
dmattek committed
22
    
dmattek's avatar
Added:  
dmattek committed
23
    modStatsUI(ns('dispStats')),
dmattek's avatar
Mod:  
dmattek committed
24
    br(),
dmattek's avatar
Added:  
dmattek committed
25 26
   
    modBoxPlotUI(ns('boxPlot')) 
dmattek's avatar
Added:  
dmattek committed
27 28 29
  )
}

dmattek's avatar
dmattek committed
30
# SERVER ----
31
tabBoxPlot = function(input, output, session, in.data, in.fname) {
dmattek's avatar
Added:  
dmattek committed
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
  
  callModule(modStats, 'dispStats',
             in.data = data4boxPlot,
             in.meascol = 'y',
             in.bycols = c('realtime', 'group'),
             in.fname = 'data4boxplotTP.csv')
  
  callModule(modBoxPlot, 'boxPlot', 
             in.data = data4boxPlot, 
             in.cols = list(meas.x = 'realtime',
                            meas.y = 'y',
                            group = 'group',
                            id = 'id'),
             in.fname = in.fname)
  
dmattek's avatar
Added:  
dmattek committed
47 48 49 50 51 52 53 54 55 56 57 58
  # 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
      return(unique(loc.dt[, realtime])) # column name specified in data4trajPlot
  })
dmattek's avatar
Added:  
dmattek committed
59 60 61 62 63 64 65 66 67

  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
68 69 70 71 72 73 74 75 76
  # 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
77 78 79 80 81 82

    
    if(input$chBfoldCh) {
      out.dt = loc.dt[realtime %in% input$inSelTpts]
      loc.dt.aux = loc.dt[realtime %in% c(as.numeric(input$inSelTpts) - input$slFoldChTp)]
      loc.y.prev = loc.dt.aux[, y]
dmattek's avatar
dmattek committed
83 84 85
      print(nrow(loc.dt.aux))
      print(nrow(out.dt))
      
dmattek's avatar
Added:  
dmattek committed
86 87 88 89 90 91 92 93 94
      out.dt[, y.prev := loc.y.prev]
      print(out.dt)
      out.dt[, y := abs(y / y.prev)]
      print(out.dt)
      out.dt[, y.prev := NULL]
      print(out.dt)
      
    } else
      out.dt = loc.dt[realtime %in% input$inSelTpts]
dmattek's avatar
Added:  
dmattek committed
95
    
dmattek's avatar
Added:  
dmattek committed
96 97
    
    return(out.dt)
dmattek's avatar
Added:  
dmattek committed
98 99 100 101 102 103 104 105 106 107 108
  })
  
  output$varSelTpts = renderUI({
    cat(file = stderr(), 'UI varSelTpts\n')
    
    ns <- session$ns
    
    loc.v = getDataTpts()
    if (!is.null(loc.v)) {
      selectInput(
        ns('inSelTpts'),
109
        'Select one or more t-points:',
dmattek's avatar
Added:  
dmattek committed
110 111 112 113 114 115 116
        loc.v,
        width = '100%',
        selected = 0,
        multiple = TRUE
      )
    }
  })
dmattek's avatar
Mod:  
dmattek committed
117

dmattek's avatar
Added:  
dmattek committed
118
 
dmattek's avatar
Added:  
dmattek committed
119
}