tabAUC.R 2.57 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
dmattek committed
10
tabAUCplotUI =  function(id, label = "Plot Area Under Curves") {
dmattek's avatar
Added:  
dmattek committed
11
12
13
  ns <- NS(id)
  
  tagList(
14
    h4(
dmattek's avatar
dmattek committed
15
      "Area under curve (AUC)"
16
    ),
dmattek's avatar
dmattek committed
17
    actionLink(ns("alAUC"), "Learn more"),
18
19
20
21
22
    br(),
    
    uiOutput(ns('uiSlTimeTrim')),
    modStatsUI(ns('dispStats')),
    br(),
dmattek's avatar
dmattek committed
23
    modAUCplotUI(ns('aucPlot')
dmattek's avatar
Added:  
dmattek committed
24
25
26
27
    )
  )
}

dmattek's avatar
dmattek committed
28
# SERVER ----
dmattek's avatar
dmattek committed
29
tabAUCplot = function(input, output, session, in.data, in.fname) {
dmattek's avatar
Added:  
dmattek committed
30
31
32
33
34
35
36
37
38
39
40
41
42
  
  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
43
      return(unique(loc.dt[[COLRT]]))
dmattek's avatar
Added:  
dmattek committed
44
45
46
47
48
49
  })
  
  # UI for trimming x-axis (time)
  output$uiSlTimeTrim = renderUI({
    cat(file = stderr(), 'UI uiSlTimeTrim\n')
    
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
    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
67
68
69
70
71
72
73
74
75
  })
  
  AUCcells = reactive({
    cat(file = stderr(), 'AUCcells\n')
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    else {
dmattek's avatar
dmattek committed
76
      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
77
78
79
      return(loc.res)
    }
  })
80
  
dmattek's avatar
Added:  
dmattek committed
81
82
83
  callModule(modStats, 'dispStats',
             in.data = AUCcells,
             in.meascol = 'AUC',
dmattek's avatar
dmattek committed
84
             in.bycols = COLGR,
dmattek's avatar
Added:  
dmattek committed
85
86
             in.fname = 'data4boxplotAUC.csv')
  
dmattek's avatar
dmattek committed
87
  callModule(modAUCplot, 'aucPlot', 
dmattek's avatar
Added:  
dmattek committed
88
             in.data = AUCcells, 
dmattek's avatar
dmattek committed
89
             in.cols = list(meas.x = COLGR,
dmattek's avatar
Added:  
dmattek committed
90
                            meas.y = 'AUC',
dmattek's avatar
dmattek committed
91
92
                            group = COLGR,
                            id = COLID),
dmattek's avatar
dmattek committed
93
             in.labels = list(x = "Groups", y = "", legend = ""),
dmattek's avatar
Added:  
dmattek committed
94
95
             in.fname = in.fname)
  
dmattek's avatar
dmattek committed
96
97
98
99
100
  addPopover(session, 
             id = ns("alAUC"), 
             title = "AUC",
             content = "Calculate area under curve (AUC) for every time series using trapezoidal rule",
             trigger = "click")
dmattek's avatar
Added:  
dmattek committed
101
102
103
104
105
106
107
108
  
}