tabBoxPlot.R 2.71 KB
Newer Older
dmattek's avatar
Added:  
dmattek committed
1 2 3 4
tabBoxPlotUI =  function(id, label = "Comparing t-points") {
  ns <- NS(id)
  
  tagList(
dmattek's avatar
Mod:  
dmattek committed
5 6 7 8 9
    h4(
      "Box-/dot-/violin plot at selected time points"
    ),
    br(),
    
dmattek's avatar
Added:  
dmattek committed
10 11
    uiOutput(ns('varSelTpts')),
    
dmattek's avatar
Added:  
dmattek committed
12 13
    checkboxInput(ns('chBfoldCh'), 'Fold change w.r.t. t-point:'),
    uiOutput(ns('uiSlFoldChTp')),
dmattek's avatar
Added:  
dmattek committed
14
    
dmattek's avatar
Added:  
dmattek committed
15
    modStatsUI(ns('dispStats')),
dmattek's avatar
Mod:  
dmattek committed
16
    br(),
dmattek's avatar
Added:  
dmattek committed
17 18
   
    modBoxPlotUI(ns('boxPlot')) 
dmattek's avatar
Added:  
dmattek committed
19 20 21 22 23
  )
}

####
## server box-plot
dmattek's avatar
Added:  
dmattek committed
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
tabBoxPlot = function(input, output, session, in.data, in.fname = 'boxplotTP.pdf') {
  
  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
40 41 42 43 44 45 46 47 48 49 50 51
  # 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
52 53 54 55 56 57 58 59 60

  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
61 62 63 64 65 66 67 68 69
  # 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
70 71 72 73 74 75

    
    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
76 77 78
      print(nrow(loc.dt.aux))
      print(nrow(out.dt))
      
dmattek's avatar
Added:  
dmattek committed
79 80 81 82 83 84 85 86 87
      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
88
    
dmattek's avatar
Added:  
dmattek committed
89 90
    
    return(out.dt)
dmattek's avatar
Added:  
dmattek committed
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
  })
  
  output$varSelTpts = renderUI({
    cat(file = stderr(), 'UI varSelTpts\n')
    
    ns <- session$ns
    
    loc.v = getDataTpts()
    if (!is.null(loc.v)) {
      selectInput(
        ns('inSelTpts'),
        'Select one or more timepoints:',
        loc.v,
        width = '100%',
        selected = 0,
        multiple = TRUE
      )
    }
  })
dmattek's avatar
Mod:  
dmattek committed
110

dmattek's avatar
Added:  
dmattek committed
111
 
dmattek's avatar
Added:  
dmattek committed
112
}