Upgrade to new Gitlab Version 13.9 on Saturday 19th April 20:00. Expect an interruption of about 30 to 60 minutes

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

dmattek's avatar
dmattek committed
8 9 10
require(DT)
require(data.table)

dmattek's avatar
dmattek committed
11 12

# UI ----
dmattek's avatar
dmattek committed
13 14 15 16 17 18 19 20 21
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
22
# SERVER ----
dmattek's avatar
dmattek committed
23 24 25 26 27 28
modTrackStats = function(input, output, session, 
                         in.data) {
  
  ns <- session$ns
  
  output$uiTabStats = renderUI({
dmattek's avatar
dmattek committed
29
    cat(file = stderr(), 'modTrackStats: uiTabStats\n')
dmattek's avatar
dmattek committed
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
    ns <- session$ns
    
    if(input$chbTabStats) {
      tagList(
        htmlOutput(ns('txtNtracks')),
        #br(),
        #p("Track IDs with duplicated objects in a frame"),
        br(),
        DT::dataTableOutput(ns('outTabStats'))
      )
    }
  })
  
  # unused at the moment
  calcStats = reactive({
dmattek's avatar
dmattek committed
45
    cat(file = stderr(), 'modTrackStats: calsStats\n')
dmattek's avatar
dmattek committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
    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), 
                                                        'rCV (IQR)' = IQR(x)/median(x), 
                                                        'rCV (MAD)'= mad(x)/median(x))), .SDcols = in.meascol, by = in.bycols]
    
    setnames(loc.dt.aggr, c(in.bycols, 'N', 'Mean', 'CV', 'Median', 'rCV IQR', 'rCV MAD'))
    
    return(loc.dt.aggr)
  })
  
  # Print number of tracks
  output$txtNtracks = renderText({
dmattek's avatar
dmattek committed
65 66 67
    cat(file = stderr(), 'modTrackStats: txtNtracks\n')
    loc.dt = in.data()
    
dmattek's avatar
dmattek committed
68 69 70 71 72
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    
dmattek's avatar
dmattek committed
73
    sprintf('<b>Number of time-series: %d <br>Average length: %.2f time units</b>', 
dmattek's avatar
dmattek committed
74 75 76 77 78 79 80
            length(unique(loc.dt[['id']])), 
            loc.dt[, .(trackLength = .N), by = 'id'][, mean(trackLength)])
    
  })
  
  # Print a table with Track IDs assigned to multiple objects in a frame
  output$outTabStats = DT::renderDataTable(server = FALSE, {
dmattek's avatar
dmattek committed
81
    cat(file = stderr(), 'modTrackStats: outTabStats\n')
dmattek's avatar
dmattek committed
82 83 84 85 86 87 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 113
    loc.dt = in.data()
    
    if (is.null(loc.dt))
      return(NULL)
    
    # 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
    loc.duptracks = loc.dt[, .(dup = (sum(duplicated(get('realtime'))) > 0)), by = 'id'][dup == TRUE, 'id', with = FALSE]
    
    if (nrow(loc.duptracks))
      datatable(loc.duptracks, 
                caption = 'Track IDs with duplicated objects in a frame',
                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'))))
    else
      return(NULL)
  })
  
}