tabAUC.R 2.1 KB
Newer Older
dmattek's avatar
Added:  
dmattek committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
# Calculates area under curve (AUC) for every single time course provided in the input

require(pracma) # for trapz

modAUCplotUI =  function(id, label = "Plot Area Under Curves") {
  ns <- NS(id)
  
  tagList(
      uiOutput(ns('uiSlTimeTrim')),
      modStatsUI(ns('dispStats')),
      br(),
      modBoxPlotUI(ns('boxPlot')
    )
  )
}

modAUCplot = function(input, output, session, in.data, in.fname = 'boxplotAUC.pdf') {
  
  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
      return(unique(loc.dt[['realtime']]))
  })
  
  # UI for trimming x-axis (time)
  output$uiSlTimeTrim = renderUI({
    cat(file = stderr(), 'UI uiSlTimeTrim\n')
    
      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
      )
      
  })
  
  AUCcells = reactive({
    cat(file = stderr(), 'AUCcells\n')
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    else {
      loc.res = loc.dt[realtime >= input$slTimeTrim[1] & realtime <= input$slTimeTrim[2], .(AUC = trapz(realtime, y)), by = .(group, id)]
      return(loc.res)
    }
  })

  callModule(modStats, 'dispStats',
             in.data = AUCcells,
             in.meascol = 'AUC',
             in.bycols = c('group'),
             in.fname = 'data4boxplotAUC.csv')
  
  callModule(modBoxPlot, 'boxPlot', 
             in.data = AUCcells, 
             in.cols = list(meas.x = 'group',
                            meas.y = 'AUC',
                            group = 'group',
                            id = 'id'),
             in.fname = in.fname)
  
  
}