dispStats.R 3.36 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
109
110
111
112
    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')),
                                    text = 'Download')))) %>% formatRound(seq(loc.n.bycols + 2, loc.n.bycols + 1 + 5), 3)
  })
  
}