dispTrackStats.R 8.57 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6 7 8
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for displaying time series statistics
#

# UI ----
dmattek's avatar
dmattek committed
9 10 11 12 13 14 15 16 17
modTrackStatsUI =  function(id, label = "Comparing t-points") {
  ns <- NS(id)
  
  tagList(
    checkboxInput(ns('chbTabStats'), 'Show stats', FALSE),
    uiOutput(ns('uiTabStats'))
  )
}

dmattek's avatar
dmattek committed
18
# SERVER ----
dmattek's avatar
dmattek committed
19
modTrackStats = function(input, output, session, 
dmattek's avatar
dmattek committed
20 21
                         in.data,
                         in.bycols = COLGR) {
dmattek's avatar
dmattek committed
22 23 24
  
  ns <- session$ns
  
dmattek's avatar
dmattek committed
25
  # UI for displaying various stats
dmattek's avatar
dmattek committed
26
  output$uiTabStats = renderUI({
dmattek's avatar
dmattek committed
27
    cat(file = stderr(), 'modTrackStats:uiTabStats\n')
dmattek's avatar
dmattek committed
28 29 30 31 32 33
    ns <- session$ns
    
    if(input$chbTabStats) {
      tagList(
        htmlOutput(ns('txtNtracks')),
        br(),
dmattek's avatar
dmattek committed
34 35 36 37 38 39 40
        tabsetPanel(
          tabPanel("Tracks stats", 
                   DT::dataTableOutput(ns('outTabStatsTracks'))),
          tabPanel("Measurement stats", 
                   DT::dataTableOutput(ns('outTabStatsMeas'))),
          tabPanel("Duplicated IDs",         
                   DT::dataTableOutput(ns('outTabStatsDup')))
dmattek's avatar
dmattek committed
41
        )
42
      )
dmattek's avatar
dmattek committed
43 44 45
    }
  })
  
dmattek's avatar
dmattek committed
46 47 48 49 50 51 52 53 54 55
  # Print number of tracks
  output$txtNtracks = renderText({
    cat(file = stderr(), 'modTrackStats:txtNtracks\n')
    loc.dt = in.data()
    
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    
dmattek's avatar
dmattek committed
56
    sprintf('<b>Total number of time series: %d <br>Average length: %.2f time points</b>', 
dmattek's avatar
dmattek committed
57 58 59 60 61 62
            length(unique(loc.dt[[COLID]])), 
            loc.dt[, .(trackLength = .N), by = COLID][, mean(trackLength)])
    
  })
  
  
63
  # calculate stats of the measurement (column Y) per group
dmattek's avatar
dmattek committed
64 65
  calcStatsMeas = reactive({
    cat(file = stderr(), 'modTrackStats:calsStats\n')
dmattek's avatar
dmattek committed
66 67 68 69 70
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    
71 72 73 74 75 76
    loc.dt.aggr = loc.dt[, sapply(.SD, function(x) list('nas' = sum(is.na(x)),
                                                        'min' = min(x, na.rm = T),
                                                        'max' = max(x, na.rm = T),
                                                        'measMean' = mean(x, na.rm = T),
                                                        'measSD' = sd(x, na.rm = T),
                                                        'measCV' = sd(x, na.rm = T)/mean(x, na.rm = T), 
dmattek's avatar
dmattek committed
77
                                                        'measMedian' = median(as.double(x), na.rm = T),
78 79
                                                        'measIQR' = IQR(x, na.rm = T),
                                                        'meas_rCV_IQR' = IQR(x, na.rm = T)/median(x, na.rm = T))), .SDcols = COLY, by = c(in.bycols)]
dmattek's avatar
dmattek committed
80
    
dmattek's avatar
dmattek committed
81
    setnames(loc.dt.aggr, c(in.bycols, '#NAs', 'Min Y', 'Max Y', 'Mean Y', 'SD', 'CV', 'Median Y', 'IQR', 'rCV'))
dmattek's avatar
dmattek committed
82 83 84 85
    
    return(loc.dt.aggr)
  })
  
86
  # calculate stats of tracks per group
dmattek's avatar
dmattek committed
87 88
  calcStatsTracks = reactive({
    cat(file = stderr(), 'modTrackStats:calsStats\n')
dmattek's avatar
dmattek committed
89 90
    loc.dt = in.data()
    
dmattek's avatar
dmattek committed
91 92 93 94 95 96
    if (is.null(loc.dt))
      return(NULL)
    
    loc.dt.aggr = loc.dt[, 
                         .(nTpts = .N), 
                         by = c(in.bycols, COLID)][, .(tracksN = .N,
97 98 99
                                                       tracksLenMean = mean(nTpts),
                                                       tracksLenSD = sd(nTpts),
                                                       tracksLenMedian = median(as.double(nTpts)),
dmattek's avatar
dmattek committed
100 101
                                                       tracksLenIQR = IQR(as.double(nTpts))), by = c(in.bycols)]

dmattek's avatar
dmattek committed
102
    setnames(loc.dt.aggr, c(in.bycols, 'nTracks', 'Mean Length', 'SD', 'Median Length', 'IQR'))
dmattek's avatar
dmattek committed
103 104 105 106 107 108 109 110
    
    return(loc.dt.aggr)
  })
  
  # Render a table with track stats
  output$outTabStatsTracks = DT::renderDataTable(server = FALSE, {
    cat(file = stderr(), 'modTrackStats:outTabStats\n')
    loc.dt = calcStatsTracks()
dmattek's avatar
dmattek committed
111
    
112 113 114
    validate(
      need(!is.null(loc.dt), "Cannot calculate statistics. Load data first!")
    )
dmattek's avatar
dmattek committed
115
    
dmattek's avatar
dmattek committed
116 117
    if (nrow(loc.dt))
      datatable(loc.dt, 
dmattek's avatar
dmattek committed
118 119 120
                caption = paste0("Statistics of time series: number of time series, ",
                                 "mean/median track length, ",
                                 "SD - standard deviation, IQR - interquartile range."),
dmattek's avatar
dmattek committed
121 122 123 124 125 126 127 128 129 130 131 132 133
                rownames = TRUE,
                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
134
                                      text = 'Download')))) %>% formatSignif(3:4, digits = SIGNIFDIGITSINTAB)
dmattek's avatar
dmattek committed
135 136 137 138 139 140 141 142 143 144
    else
      return(NULL)
  })
  
  
  # Render a table with measurement stats
  output$outTabStatsMeas = DT::renderDataTable(server = FALSE, {
    cat(file = stderr(), 'modTrackStats:outTabMeas\n')
    loc.dt = calcStatsMeas()
    
145 146 147
    validate(
      need(!is.null(loc.dt), "Cannot calculate statistics. Load data first!")
    )
dmattek's avatar
dmattek committed
148
    
dmattek's avatar
dmattek committed
149 150
    if (nrow(loc.dt))
      datatable(loc.dt, 
dmattek's avatar
dmattek committed
151 152 153 154 155
                caption = paste0("Statistics of measurements: number of NA time points, ",
                                 "min/max/mean/median of the measurmeent selected for the Y-axis. ",
                                 "SD - standard deviation; CV - coefficient of variation; ",
                                 "SD/mean; IQR - interquartile range; ",
                                 "rCV - robust CV, IQR/median."),
dmattek's avatar
dmattek committed
156 157 158 159 160 161 162 163 164 165 166 167 168
                rownames = TRUE,
                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
169
                                      text = 'Download')))) %>% formatSignif(3:10, digits = SIGNIFDIGITSINTAB)
dmattek's avatar
dmattek committed
170 171
    else
      return(NULL)
dmattek's avatar
dmattek committed
172 173
  })
  
dmattek's avatar
dmattek committed
174 175 176
  # Render a table with Track IDs assigned to multiple objects in a frame
  output$outTabStatsDup = DT::renderDataTable(server = FALSE, {
    cat(file = stderr(), 'modTrackStats:outTabStatsDup\n')
dmattek's avatar
dmattek committed
177 178
    loc.dt = in.data()
    
179 180 181
    validate(
      need(!is.null(loc.dt), "Cannot calculate statistics. Load data first!")
    )
dmattek's avatar
dmattek committed
182 183 184 185
    
    # Look whether there were more objects with the same track ID in the frame
    # Such track IDs will have TRUE assigned in 'dup' column
    # Keep only s.track column with dup=TRUE
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
    loc.duptracks = loc.dt[, 
                           .(dup = (sum(duplicated(get(COLRT))) > 0)), 
                           by = COLID][dup == TRUE, COLID, with = FALSE]
    
    DT::datatable(loc.duptracks, 
                  caption = paste0("Time series with duplicated track IDs. ",
                                   "To avoid, create a data-wide unique track ID in ",
                                   "the panel on the left or in your input data."),
                  rownames = TRUE,
                  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')),
                    language = list(
                      zeroRecords = "No records to display")
                  )
dmattek's avatar
dmattek committed
211
    )
dmattek's avatar
dmattek committed
212 213 214
  })
  
}