tabAUC.R 2.61 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
10
11
helpText.tabAUC = c("Calculate area under curve (AUC) for every time series using trapezoidal rule." #1
)

dmattek's avatar
dmattek committed
12
# UI ----
dmattek's avatar
dmattek committed
13
tabAUCplotUI =  function(id, label = "Plot Area Under Curves") {
dmattek's avatar
Added:    
dmattek committed
14
15
16
  ns <- NS(id)
  
  tagList(
17
    h4(
dmattek's avatar
dmattek committed
18
      "Area under curve (AUC)"
19
    ),
dmattek's avatar
dmattek committed
20
    actionLink(ns("alAUC"), "Learn more"),
21
22
23
24
25
    br(),
    
    uiOutput(ns('uiSlTimeTrim')),
    modStatsUI(ns('dispStats')),
    br(),
dmattek's avatar
dmattek committed
26
    modAUCplotUI(ns('aucPlot')
dmattek's avatar
Added:    
dmattek committed
27
28
29
30
    )
  )
}

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