dispStats.R 3.46 KB
Newer Older
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
1 2 3 4 5 6
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for displaying stats in an interactive table using DT package
#
dmattek's avatar
Added:  
dmattek committed
7

dmattek's avatar
dmattek committed
8 9 10
helpText.dispStats = c("Display statistics aggregated per group, e.g. mean/median/CV per group." #1
)

Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
11
# UI ----
dmattek's avatar
Added:  
dmattek committed
12 13 14 15
modStatsUI =  function(id, label = "Comparing t-points") {
  ns <- NS(id)
  
  tagList(
dmattek's avatar
dmattek committed
16
    checkboxInput(ns('chbTabStats'), 'Show statistics', FALSE),
dmattek's avatar
dmattek committed
17 18
    bsTooltip(ns('chbTabStats'), helpText.dispStats[1], placement = "bottom", trigger = "hover", options = NULL),
    
dmattek's avatar
Added:  
dmattek committed
19 20 21 22 23
    uiOutput(ns('uiTabStats')),
    uiOutput(ns('uiDownSingleCellData'))
  )
}

Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
24
# SERVER ----
dmattek's avatar
Added:  
dmattek committed
25 26 27 28
modStats = function(input, output, session, 
                   in.data, 
                   in.meascol = 'meas.y', 
                   in.bycols = c('meas.x', 'group'),
dmattek's avatar
dmattek committed
29
                   in.fname = 'data.csv') {
dmattek's avatar
Added:  
dmattek committed
30 31 32
  
  ns <- session$ns
  
dmattek's avatar
dmattek committed
33 34
  
  
dmattek's avatar
Added:  
dmattek committed
35
  output$uiTabStats = renderUI({
dmattek's avatar
dmattek committed
36
    cat(file = stderr(), 'modStats:uiTabStats\n')
dmattek's avatar
Added:  
dmattek committed
37 38 39 40 41 42 43
    ns <- session$ns
    
    if(input$chbTabStats) {
      DT::dataTableOutput(ns('outTabStats'))
    }
  })
  
dmattek's avatar
dmattek committed
44
  
dmattek's avatar
Added:  
dmattek committed
45
  output$uiDownSingleCellData = renderUI({
dmattek's avatar
dmattek committed
46
    cat(file = stderr(), 'modStats:uiDownSingleCellData\n')
dmattek's avatar
Added:  
dmattek committed
47 48 49
    ns <- session$ns
    
    if(input$chbTabStats) {
dmattek's avatar
dmattek committed
50
      downloadButton(ns('downloadData4BoxPlot'), 'Download stats for individual time series')
dmattek's avatar
Added:  
dmattek committed
51 52 53 54 55 56
    }
  })
  
  
  
  calcStats = reactive({
dmattek's avatar
dmattek committed
57
    cat(file = stderr(), 'modStats:calsStats\n')
dmattek's avatar
Added:  
dmattek committed
58 59 60 61 62 63 64 65 66
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)

    loc.dt.aggr = loc.dt[, sapply(.SD, function(x) list('N' = .N, 
                                                        'Mean' = mean(x), 
                                                        'CV' = sd(x)/mean(x), 
                                                        'Median' = median(x), 
dmattek's avatar
dmattek committed
67
                                                        'rCV' = IQR(x)/median(x))), .SDcols = in.meascol, by = in.bycols]
dmattek's avatar
Added:  
dmattek committed
68
    
dmattek's avatar
dmattek committed
69
    setnames(loc.dt.aggr, c(in.bycols, 'nPoints', 'Mean', 'CV', 'Median', 'rCV'))
dmattek's avatar
Added:  
dmattek committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
    
    return(loc.dt.aggr)
  })
  
  output$downloadData4BoxPlot <- downloadHandler(
    filename = in.fname,
    content = function(file) {
      loc.dt = in.data()
      
      if (is.null(loc.dt))
        return(NULL)
      else
        write.csv(loc.dt, file, row.names = FALSE)
    }
  )
  
  output$outTabStats = DT::renderDataTable(server = FALSE, {
dmattek's avatar
dmattek committed
87
    cat(file = stderr(), 'modStats:outTabStats\n')
dmattek's avatar
Added:  
dmattek committed
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
    loc.dt = calcStats()
    
    if (is.null(loc.dt))
      return(NULL)
    
    loc.n.bycols = length(in.bycols)
    
    datatable(loc.dt, 
              rownames = FALSE,
              extensions = 'Buttons', 
              options = list(
                dom = 'Bfrtip',
                buttons = list('copy', 
                               'print', 
                               list(extend = 'collection',
                                    buttons = list(list(extend='csv',
                                                        filename = 'hitStats'),
                                                   list(extend='excel',
                                                        filename = 'hitStats'),
                                                   list(extend='pdf',
                                                        filename= 'hitStats')),
dmattek's avatar
dmattek committed
109 110
                                    text = 'Download')))) %>% formatSignif(seq(loc.n.bycols + 2, loc.n.bycols + 1 + 5), 
                                                                           digits = SIGNIFDIGITSINTAB)
dmattek's avatar
Added:  
dmattek committed
111 112 113
  })
  
}