tabAUC.R 2.27 KB
Newer Older
dmattek's avatar
dmattek committed
1
2
3
4
5
6
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is a tab for plotting Area Under Curve
#
dmattek's avatar
Added:  
dmattek committed
7
8
# Calculates area under curve (AUC) for every single time course provided in the input

dmattek's avatar
dmattek committed
9
# UI ----
dmattek's avatar
Added:  
dmattek committed
10
11
12
13
modAUCplotUI =  function(id, label = "Plot Area Under Curves") {
  ns <- NS(id)
  
  tagList(
14
15
16
17
18
19
20
21
22
    h4(
      "Calculate area under curve and plot per group"
    ),
    br(),
    
    uiOutput(ns('uiSlTimeTrim')),
    modStatsUI(ns('dispStats')),
    br(),
    modBoxPlotUI(ns('boxPlot')
dmattek's avatar
Added:  
dmattek committed
23
24
25
26
    )
  )
}

dmattek's avatar
dmattek committed
27
# SERVER ----
28
modAUCplot = function(input, output, session, in.data, in.fname) {
dmattek's avatar
Added:  
dmattek committed
29
30
31
32
33
34
35
36
37
38
39
40
41
  
  ns <- session$ns
  
  # 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
42
      return(unique(loc.dt[[COLRT]]))
dmattek's avatar
Added:  
dmattek committed
43
44
45
46
47
48
  })
  
  # UI for trimming x-axis (time)
  output$uiSlTimeTrim = renderUI({
    cat(file = stderr(), 'UI uiSlTimeTrim\n')
    
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
    locTpts  = getDataTpts()
    
    if(is.null(locTpts))
      return(NULL)
    
    locRTmin = min(locTpts)
    locRTmax = max(locTpts)
    
    sliderInput(
      ns('slTimeTrim'),
      label = 'Select time range for AUC calculation',
      min = locRTmin,
      max = locRTmax,
      value = c(locRTmin, locRTmax),
      step = 1
    )
    
dmattek's avatar
Added:  
dmattek committed
66
67
68
69
70
71
72
73
74
  })
  
  AUCcells = reactive({
    cat(file = stderr(), 'AUCcells\n')
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    else {
dmattek's avatar
dmattek committed
75
      loc.res = loc.dt[get(COLRT) >= input$slTimeTrim[1] & get(COLRT) <= input$slTimeTrim[2], .(AUC = trapz(get(COLRT), get(COLY))), by = c(COLGR, COLID)]
dmattek's avatar
Added:  
dmattek committed
76
77
78
      return(loc.res)
    }
  })
79
  
dmattek's avatar
Added:  
dmattek committed
80
81
82
  callModule(modStats, 'dispStats',
             in.data = AUCcells,
             in.meascol = 'AUC',
dmattek's avatar
dmattek committed
83
             in.bycols = COLGR,
dmattek's avatar
Added:  
dmattek committed
84
85
86
87
             in.fname = 'data4boxplotAUC.csv')
  
  callModule(modBoxPlot, 'boxPlot', 
             in.data = AUCcells, 
dmattek's avatar
dmattek committed
88
             in.cols = list(meas.x = COLGR,
dmattek's avatar
Added:  
dmattek committed
89
                            meas.y = 'AUC',
dmattek's avatar
dmattek committed
90
91
                            group = COLGR,
                            id = COLID),
dmattek's avatar
Added:  
dmattek committed
92
93
94
95
96
97
98
99
100
101
             in.fname = in.fname)
  
  
}