tabAUC.R 2.85 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(alAUC = paste0("Calculate area under curve (AUC) for every time series using trapezoidal rule. ",
                                   "Display the result as a box-, violin-, or a dot-plot. ",
                                   "The interval used for AUC calculation can be altered using the slider below.")
dmattek's avatar
dmattek committed
12 13
)

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

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