Skip to content

GitLab

S
shiny-timecourse-inspector
Commit ec76057f authored by dmattek's avatar dmattek
Browse files
Options

Expanded track stats

parent 5d11aefb
Hide whitespace changes
Inline Side-by-side
Showing with 115 additions and 28 deletions
modules/dispTrackStats.R
View file @ ec76057f
......@@ -17,64 +17,151 @@ modTrackStatsUI = function(id, label = "Comparing t-points") {
# SERVER ----
modTrackStats = function(input, output, session,
in.data) {
in.data,
in.bycols = COLGR) {
ns <- session$ns
# UI for displaying various stats
output$uiTabStats = renderUI({
cat(file = stderr(), 'modTrackStats: uiTabStats\n')
cat(file = stderr(), 'modTrackStats:uiTabStats\n')
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'))
)
tabsetPanel(
tabPanel("Tracks stats",
DT::dataTableOutput(ns('outTabStatsTracks'))),
tabPanel("Measurement stats",
DT::dataTableOutput(ns('outTabStatsMeas'))),
tabPanel("Duplicated IDs",
DT::dataTableOutput(ns('outTabStatsDup')))
))
}
})
# unused at the moment
calcStats = reactive({
cat(file = stderr(), 'modTrackStats: calsStats\n')
# 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)
sprintf('<b>Total #time-series: %d <br>Average length: %.2f time units</b>',
length(unique(loc.dt[[COLID]])),
loc.dt[, .(trackLength = .N), by = COLID][, mean(trackLength)])
})
# caclulate stats of the measurement (column Y) per group
calcStatsMeas = reactive({
cat(file = stderr(), 'modTrackStats:calsStats\n')
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]
loc.dt.aggr = loc.dt[, sapply(.SD, function(x) list('measMean' = mean(x),
'measSD' = sd(x),
'measCV' = sd(x)/mean(x),
'measMedian' = median(x),
'measIQR' = IQR(x),
'meas_rCV_IQR' = IQR(x)/median(x))), .SDcols = COLY, by = c(in.bycols)]
setnames(loc.dt.aggr, c(in.bycols, 'N', 'Mean', 'CV', 'Median', 'rCV IQR', 'rCV MAD'))
setnames(loc.dt.aggr, c(in.bycols, 'Mean Meas.', 'SD', 'CV', 'Median Meas.', 'IQR', 'rCV IQR'))
return(loc.dt.aggr)
})
# Print number of tracks
output$txtNtracks = renderText({
cat(file = stderr(), 'modTrackStats: txtNtracks\n')
# caclulate stats of tracks per group
calcStatsTracks = reactive({
cat(file = stderr(), 'modTrackStats:calsStats\n')
loc.dt = in.data()
loc.dt = in.data()
if (is.null(loc.dt))
return(NULL)
loc.dt.aggr = loc.dt[,
.(nTpts = .N),
by = c(in.bycols, COLID)][, .(tracksN = .N,
tracksLenMean = mean(nTpts),
tracksLenSD = sd(nTpts),
tracksLenMedian = median(nTpts),
tracksLenIQR = IQR(nTpts)), by = c(in.bycols)]
setnames(loc.dt.aggr, c(in.bycols, '#tracks', 'Mean Length', 'SD', 'Median Length', 'IQR'))
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()
if (is.null(loc.dt))
return(NULL)
sprintf('<b>Number of time-series: %d <br>Average length: %.2f time units</b>',
length(unique(loc.dt[['id']])),
loc.dt[, .(trackLength = .N), by = 'id'][, mean(trackLength)])
if (nrow(loc.dt))
datatable(loc.dt,
caption = 'Track statistics',
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)
})
# Render a table with measurement stats
output$outTabStatsMeas = DT::renderDataTable(server = FALSE, {
cat(file = stderr(), 'modTrackStats:outTabMeas\n')
loc.dt = calcStatsMeas()
if (is.null(loc.dt))
return(NULL)
if (nrow(loc.dt))
datatable(loc.dt,
caption = 'Measurement statistics',
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')))) %>% formatRound(2:7)
else
return(NULL)
})
# Print a table with Track IDs assigned to multiple objects in a frame
output$outTabStats = DT::renderDataTable(server = FALSE, {
cat(file = stderr(), 'modTrackStats: outTabStats\n')
# 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')
loc.dt = in.data()
if (is.null(loc.dt))
......@@ -83,7 +170,7 @@ modTrackStats = function(input, output, session,
# 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]
loc.duptracks = loc.dt[, .(dup = (sum(duplicated(get(COLRT))) > 0)), by = COLID][dup == TRUE, COLID, with = FALSE]
if (nrow(loc.duptracks))
datatable(loc.duptracks,
......@@ -101,7 +188,7 @@ modTrackStats = function(input, output, session,
filename = 'hitStats'),
list(extend='pdf',
filename= 'hitStats')),
text = 'Download'))))
text = 'Download')))) %>% formatRound(3:6)
else
return(NULL)
})
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment