Commit 3f2d3136 authored by dmattek's avatar dmattek

Bug fixes

parent f78cdc1a
...@@ -45,7 +45,7 @@ PLOTWIDTH = 85 # in percent ...@@ -45,7 +45,7 @@ PLOTWIDTH = 85 # in percent
PLOTNFACETDEFAULT = 3 PLOTNFACETDEFAULT = 3
# internal column names # internal column names
COLRT = 'realtime' COLRT = 'time'
COLY = 'y' COLY = 'y'
COLID = 'id' COLID = 'id'
COLIDUNI = 'trackObjectsLabelUni' COLIDUNI = 'trackObjectsLabelUni'
...@@ -96,13 +96,14 @@ md_cols <- c( ...@@ -96,13 +96,14 @@ md_cols <- c(
# list of palettes for the heatmap # list of palettes for the heatmap
l.col.pal = list( l.col.pal = list(
"White-Orange-Red" = 'OrRd', "Spectral" = 'Spectral',
"Yellow-Orange-Red" = 'YlOrRd', "Red-Yellow-Green" = 'RdYlGn',
"Red-Yellow-Blue" = 'RdYlBu',
"Greys" = "Greys",
"Reds" = "Reds", "Reds" = "Reds",
"Oranges" = "Oranges", "Oranges" = "Oranges",
"Greens" = "Greens", "Greens" = "Greens",
"Blues" = "Blues", "Blues" = "Blues"
"Spectral" = 'Spectral'
) )
# list of palettes for the dendrogram # list of palettes for the dendrogram
...@@ -115,23 +116,40 @@ l.col.pal.dend = list( ...@@ -115,23 +116,40 @@ l.col.pal.dend = list(
"Diverge HSV" = 'diverge_hsv' "Diverge HSV" = 'diverge_hsv'
) )
# list of palettes for the dendrogram
l.col.pal.dend.2 = list(
"Colorblind 10" = 'Color Blind',
"Tableau 10" = 'Tableau 10',
"Tableau 20" = 'Tableau 20',
"Classic 10" = "Classic 10",
"Classic 20" = "Classic 20",
"Traffic 9" = 'Traffic',
"Seattle Grays 5" = 'Seattle Grays'
)
# Clustering algorithms ---- # Clustering algorithms ----
s.cl.linkage = c("ward.D", s.cl.linkage = c("average",
"ward.D2",
"single",
"complete", "complete",
"average", "single",
"mcquitty", "centroid",
"centroid") "ward.D",
"ward.D2",
"mcquitty")
s.cl.spar.linkage = c("average", s.cl.spar.linkage = c("average",
"complete", "complete",
"single", "single",
"centroid") "centroid")
s.cl.diss = c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", "DTW") s.cl.diss = c("euclidean",
s.cl.spar.diss = c("squared.distance","absolute.value") "maximum",
"manhattan",
"canberra",
"DTW")
s.cl.spar.diss = c("squared.distance",
"absolute.value")
# Help text ---- # Help text ----
...@@ -159,20 +177,24 @@ helpPopup <- function(title, content, ...@@ -159,20 +177,24 @@ helpPopup <- function(title, content,
} }
help.text.short = c( help.text.short = c(
'Load CSV file with a column of track IDs for removal. IDs should correspond to those used for plotting.', 'Load CSV file with a column of track IDs for removal. IDs should correspond to those used for plotting.', #1
'If the track ID is unique only within a group, make it unique globally by combining with the grouping column.', 'If the track ID is unique only within a group, make it unique globally by combining with the grouping column.', #2
'Interpolate missing time points and pre-existing NAs. The interval of the time column must be provided!', 'Interpolate missing time points and pre-existing NAs. The interval of the time column must be provided!', #3
'Load CSV file with 5 columns: grouping, start and end tpts of stimulation, start and end of y-position, dummy column with ID.', 'Load CSV file with 5 columns: grouping, start and end tpts of stimulation, start and end of y-position, dummy column with ID.', #4
'Select columns to group data according to treatment, condition, etc.', 'Select columns to group data according to treatment, condition, etc.', #5
'Select math operation to perform on a single or two columns,', 'Select math operation to perform on a single or two columns,', #6
'Select range of time for further processing.', 'Select range of time for further processing.', #7
'Divide measurments by the mean/median or calculate z-score with respect to selected time span.', 'Divide measurments by the mean/median or calculate z-score with respect to selected time span.', #8
'Download time series after modification in this section.', 'Download time series after modification in this section.', #9
'Long format: a row is a single data point. Wide format: a row is a time series with columns as time points.', 'Long format: a row is a single data point. Wide format: a row is a time series with columns as time points.', #10
'Fold-change or z-score with respect to selected time span.', 'Fold-change or z-score with respect to selected time span.', #11
'Normalise with respect to this time span.', 'Normalise with respect to this time span.', #12
'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.', 'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.', #13
'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.' 'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.', #14
'Instead of the value at a selected time point, y-axis can display a difference between values at time points on y- and x-axis.',#15
'Add a line with linear regression and regions of 95% confidence interval.', #16
'A number of time points left & right of selected time points; use the mean/min/max of values from these time points for the scatterplot.', #17
'Operations to perform on values at time points selected in the field above.' #18
) )
# Functions for data processing ---- # Functions for data processing ----
...@@ -765,60 +787,41 @@ LOCplotPSD <- function(dt.arg, # input data table ...@@ -765,60 +787,41 @@ LOCplotPSD <- function(dt.arg, # input data table
return(p.tmp) return(p.tmp)
} }
# Plots a scatter plot with marginal histograms #' Plot a scatter plot with an optional linear regression
# Points are connected by a line (grouping by cellID) #'
# #' @param dt.arg input of data.table with 2 columns with x and y coordinates
# Assumes an input of data.table with #' @param facet.arg
# x, y - columns with x and y coordinates #' @param facet.ncol.arg
# id - a unique point identifier (here corresponds to cellID) #' @param xlab.arg
# mid - a (0,1) column by which points are coloured (here corresponds to whether cells are within bounds) #' @param ylab.arg
#' @param plotlab.arg
LOCggplotScat = function(dt.arg, #' @param alpha.arg
band.arg = NULL, #' @param trend.arg
#' @param ci.arg
LOCggplotScat = function(dt.arg,
facet.arg = NULL, facet.arg = NULL,
facet.ncol.arg = 2, facet.ncol.arg = 2,
xlab.arg = NULL, xlab.arg = NULL,
ylab.arg = NULL, ylab.arg = NULL,
plotlab.arg = NULL, plotlab.arg = NULL,
alpha.arg = 1, alpha.arg = 1,
group.col.arg = NULL) { trend.arg = T,
p.tmp = ggplot(dt.arg, aes(x = x, y = y)) ci.arg = 0.95) {
if (is.null(group.col.arg)) { p.tmp = ggplot(dt.arg, aes(x = x, y = y)) +
p.tmp = p.tmp + geom_point(alpha = alpha.arg)
geom_point(alpha = alpha.arg, aes(group = id))
} else { if (trend.arg) {
p.tmp = p.tmp +
geom_point(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
geom_path(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
scale_color_manual(name = group.col.arg, values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green'))
}
if (is.null(band.arg))
p.tmp = p.tmp + p.tmp = p.tmp +
stat_smooth( stat_smooth(
# method = function(formula, data, weights = weight)
# rlm(formula, data, weights = weight, method = 'MM'),
method = "lm", method = "lm",
fullrange = FALSE, fullrange = FALSE,
level = 0.95, level = ci.arg,
colour = 'blue' colour = 'blue'
) )
else {
p.tmp = p.tmp +
geom_abline(slope = band.arg$a, intercept = band.arg$b) +
geom_abline(
slope = band.arg$a,
intercept = band.arg$b + abs(band.arg$b)*band.arg$width,
linetype = 'dashed'
) +
geom_abline(
slope = band.arg$a,
intercept = band.arg$b - abs(band.arg$b)*band.arg$width,
linetype = 'dashed'
)
} }
if (!is.null(facet.arg)) { if (!is.null(facet.arg)) {
p.tmp = p.tmp + p.tmp = p.tmp +
facet_wrap(as.formula(paste("~", facet.arg)), facet_wrap(as.formula(paste("~", facet.arg)),
...@@ -826,7 +829,6 @@ LOCggplotScat = function(dt.arg, ...@@ -826,7 +829,6 @@ LOCggplotScat = function(dt.arg,
} }
if (!is.null(xlab.arg)) if (!is.null(xlab.arg))
p.tmp = p.tmp + p.tmp = p.tmp +
xlab(paste0(xlab.arg, "\n")) xlab(paste0(xlab.arg, "\n"))
...@@ -839,8 +841,6 @@ LOCggplotScat = function(dt.arg, ...@@ -839,8 +841,6 @@ LOCggplotScat = function(dt.arg,
p.tmp = p.tmp + p.tmp = p.tmp +
ggtitle(paste0(plotlab.arg, "\n")) ggtitle(paste0(plotlab.arg, "\n"))
p.tmp = p.tmp + p.tmp = p.tmp +
LOCggplotTheme(in.font.base = PLOTFONTBASE, LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT, in.font.axis.text = PLOTFONTAXISTEXT,
...@@ -849,10 +849,6 @@ LOCggplotScat = function(dt.arg, ...@@ -849,10 +849,6 @@ LOCggplotScat = function(dt.arg,
in.font.legend = PLOTFONTLEGEND) + in.font.legend = PLOTFONTLEGEND) +
theme(legend.position = "none") theme(legend.position = "none")
# Marginal distributions don;t work with plotly...
# if (is.null(facet.arg))
# ggExtra::ggMarginal(p.scat, type = "histogram", bins = 100)
# else
return(p.tmp) return(p.tmp)
} }
......
...@@ -28,7 +28,7 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") { ...@@ -28,7 +28,7 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
4, 4,
selectInput( selectInput(
ns('selPlotBoxLegendPos'), ns('selPlotBoxLegendPos'),
label = 'Select legend position', label = 'Legend position',
choices = list( choices = list(
"Top" = 'top', "Top" = 'top',
"Right" = 'right', "Right" = 'right',
...@@ -76,10 +76,10 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") { ...@@ -76,10 +76,10 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
# SERVER ---- # SERVER ----
modBoxPlot = function(input, output, session, modBoxPlot = function(input, output, session,
in.data, in.data,
in.cols = list(meas.x = 'realtime', in.cols = list(meas.x = COLRT,
meas.y = 'y', meas.y = COLY,
group = 'group', group = COLGR,
id = 'id'), id = COLID),
in.fname) { in.fname) {
ns <- session$ns ns <- session$ns
...@@ -108,7 +108,7 @@ modBoxPlot = function(input, output, session, ...@@ -108,7 +108,7 @@ modBoxPlot = function(input, output, session,
ns <- session$ns ns <- session$ns
if(!( 'line' %in% input$inPlotType )) if(!( 'line' %in% input$inPlotType ))
sliderInput(ns('inPlotBoxDodge'), 'Dodge series:', min = 0, max = 1, value = .4, step = 0.05) sliderInput(ns('inPlotBoxDodge'), 'Space between groups:', min = 0, max = 1, value = .4, step = 0.05)
}) })
output$uiPlotBoxWidth = renderUI({ output$uiPlotBoxWidth = renderUI({
...@@ -135,7 +135,7 @@ modBoxPlot = function(input, output, session, ...@@ -135,7 +135,7 @@ modBoxPlot = function(input, output, session,
ns <- session$ns ns <- session$ns
if('dot' %in% input$inPlotType) if('dot' %in% input$inPlotType)
sliderInput(ns('inPlotDotNbins'), 'Dot-plot bin size (10^x):', min = -4, max = 4, value = -1.5, step = 0.1) sliderInput(ns('inPlotDotNbins'), '#Bins for dot-plot:', min = 2, max = 50, value = 30, step = 1)
}) })
# Boxplot - display # Boxplot - display
...@@ -206,30 +206,30 @@ modBoxPlot = function(input, output, session, ...@@ -206,30 +206,30 @@ modBoxPlot = function(input, output, session,
cat(file = stderr(), 'plotBox:dt not NULL\n') cat(file = stderr(), 'plotBox:dt not NULL\n')
loc.par.dodge <- position_dodge(width = input$inPlotBoxDodge) loc.par.dodge <- position_dodge(width = input$inPlotBoxDodge)
p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols[['meas.x']]), y = in.cols[['meas.y']])) p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x), y = in.cols$meas.y))
if('dot' %in% input$inPlotType) if('dot' %in% input$inPlotType)
p.out = p.out + geom_dotplot(aes_string(fill = in.cols[['group']]), p.out = p.out + geom_dotplot(aes_string(fill = in.cols[[COLGR]]),
color = NA, color = NA,
binaxis = "y", binaxis = in.cols$meas.y,
stackdir = "center", stackdir = "center",
position = loc.par.dodge, position = loc.par.dodge,
binwidth = 10^(input$inPlotDotNbins), binwidth = abs(max(loc.dt[[ in.cols$meas.y ]], na.rm = T) - min(loc.dt[[ in.cols$meas.y ]], na.rm = T)) / (input$inPlotDotNbins - 1),
method = 'histodot') method = 'histodot')
if('viol' %in% input$inPlotType) if('viol' %in% input$inPlotType)
p.out = p.out + geom_violin(aes_string(fill = in.cols[['group']]), p.out = p.out + geom_violin(aes_string(fill = in.cols[[COLGR]]),
position = loc.par.dodge, position = loc.par.dodge,
width = 0.2) width = 0.2)
if('line' %in% input$inPlotType) if('line' %in% input$inPlotType)
p.out = p.out + p.out = p.out +
geom_path(aes_string(color = in.cols[['group']], group = in.cols[['id']])) + geom_path(aes_string(color = in.cols[[COLGR]], group = in.cols[[COLID]])) +
facet_wrap(as.formula(paste("~", in.cols[['group']]))) facet_wrap(as.formula(paste("~", in.cols[[COLGR]])))
if ('box' %in% input$inPlotType) if ('box' %in% input$inPlotType)
p.out = p.out + geom_boxplot( p.out = p.out + geom_boxplot(
aes_string(fill = in.cols[['group']]), aes_string(fill = in.cols[[COLGR]]),
position = loc.par.dodge, position = loc.par.dodge,
#width = 0.2, #input$inPlotBoxWidth, #width = 0.2, #input$inPlotBoxWidth,
notch = input$inPlotBoxNotches, notch = input$inPlotBoxNotches,
......
...@@ -6,14 +6,14 @@ ...@@ -6,14 +6,14 @@
# #
# UI ---- # UI ----
modClDistPlotUI = function(id, label = "Plot Fractions Within Clusters") { modClDistPlotUI = function(id, label = "Plot distribution of clusters per groupd") {
ns <- NS(id) ns <- NS(id)
tagList( tagList(
radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels:", radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels:",
c("horizontal" = 0, c("horizontal" = 0,
"45 deg" = 45, "45 deg" = 45,
"90 deg" = 90)), "90 deg" = 90), inline = T),
actionButton(ns('butPlotClDist'), 'Plot!'), actionButton(ns('butPlotClDist'), 'Plot!'),
plotOutput(ns('outPlotClDist'), height = PLOTBOXHEIGHT, width = 'auto'), plotOutput(ns('outPlotClDist'), height = PLOTBOXHEIGHT, width = 'auto'),
downPlotUI(ns('downPlotClDist'), "Download PDF") downPlotUI(ns('downPlotClDist'), "Download PDF")
...@@ -66,7 +66,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna ...@@ -66,7 +66,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
p.out = p.out + p.out = p.out +
scale_y_continuous(labels = percent) + scale_y_continuous(labels = percent) +
ylab("Percentage of time-series\n") + ylab("Percentage of time-series\n") +
xlab("") + xlab("Groups") +
LOCggplotTheme(in.font.base = PLOTFONTBASE, LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT, in.font.axis.text = PLOTFONTAXISTEXT,
in.font.axis.title = PLOTFONTAXISTITLE, in.font.axis.title = PLOTFONTAXISTITLE,
......
...@@ -10,7 +10,7 @@ modStatsUI = function(id, label = "Comparing t-points") { ...@@ -10,7 +10,7 @@ modStatsUI = function(id, label = "Comparing t-points") {
ns <- NS(id) ns <- NS(id)
tagList( tagList(
checkboxInput(ns('chbTabStats'), 'Show stats', FALSE), checkboxInput(ns('chbTabStats'), 'Show statistics', FALSE),
uiOutput(ns('uiTabStats')), uiOutput(ns('uiTabStats')),
uiOutput(ns('uiDownSingleCellData')) uiOutput(ns('uiDownSingleCellData'))
) )
...@@ -25,6 +25,8 @@ modStats = function(input, output, session, ...@@ -25,6 +25,8 @@ modStats = function(input, output, session,
ns <- session$ns ns <- session$ns
output$uiTabStats = renderUI({ output$uiTabStats = renderUI({
cat(file = stderr(), 'modStats:uiTabStats\n') cat(file = stderr(), 'modStats:uiTabStats\n')
ns <- session$ns ns <- session$ns
...@@ -34,12 +36,13 @@ modStats = function(input, output, session, ...@@ -34,12 +36,13 @@ modStats = function(input, output, session,
} }
}) })
output$uiDownSingleCellData = renderUI({ output$uiDownSingleCellData = renderUI({
cat(file = stderr(), 'modStats:uiDownSingleCellData\n') cat(file = stderr(), 'modStats:uiDownSingleCellData\n')
ns <- session$ns ns <- session$ns
if(input$chbTabStats) { if(input$chbTabStats) {
downloadButton(ns('downloadData4BoxPlot'), 'Download single-cell data') downloadButton(ns('downloadData4BoxPlot'), 'Download stats for individual time series')
} }
}) })
...@@ -56,10 +59,9 @@ modStats = function(input, output, session, ...@@ -56,10 +59,9 @@ modStats = function(input, output, session,
'Mean' = mean(x), 'Mean' = mean(x),
'CV' = sd(x)/mean(x), 'CV' = sd(x)/mean(x),
'Median' = median(x), 'Median' = median(x),
'rCV (IQR)' = IQR(x)/median(x), 'rCV' = IQR(x)/median(x))), .SDcols = in.meascol, by = in.bycols]
'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')) setnames(loc.dt.aggr, c(in.bycols, 'nPoints', 'Mean', 'CV', 'Median', 'rCV'))
return(loc.dt.aggr) return(loc.dt.aggr)
}) })
......
...@@ -74,7 +74,7 @@ modTrackStats = function(input, output, session, ...@@ -74,7 +74,7 @@ modTrackStats = function(input, output, session,
'measMean' = mean(x, na.rm = T), 'measMean' = mean(x, na.rm = T),
'measSD' = sd(x, na.rm = T), 'measSD' = sd(x, na.rm = T),
'measCV' = sd(x, na.rm = T)/mean(x, na.rm = T), 'measCV' = sd(x, na.rm = T)/mean(x, na.rm = T),
'measMedian' = median(x, na.rm = T), 'measMedian' = median(as.double(x), na.rm = T),
'measIQR' = IQR(x, na.rm = T), '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)] 'meas_rCV_IQR' = IQR(x, na.rm = T)/median(x, na.rm = T))), .SDcols = COLY, by = c(in.bycols)]
...@@ -96,10 +96,10 @@ modTrackStats = function(input, output, session, ...@@ -96,10 +96,10 @@ modTrackStats = function(input, output, session,
by = c(in.bycols, COLID)][, .(tracksN = .N, by = c(in.bycols, COLID)][, .(tracksN = .N,
tracksLenMean = mean(nTpts), tracksLenMean = mean(nTpts),
tracksLenSD = sd(nTpts), tracksLenSD = sd(nTpts),
tracksLenMedian = median(nTpts), tracksLenMedian = median(as.double(nTpts)),
tracksLenIQR = IQR(nTpts)), by = c(in.bycols)] tracksLenIQR = IQR(nTpts)), by = c(in.bycols)]
setnames(loc.dt.aggr, c(in.bycols, '#Tracks', 'Mean', 'SD', 'Median', 'IQR')) setnames(loc.dt.aggr, c(in.bycols, 'nTracks', 'Mean', 'SD', 'Median', 'IQR'))
return(loc.dt.aggr) return(loc.dt.aggr)
}) })
......
...@@ -39,7 +39,7 @@ modAUCplot = function(input, output, session, in.data, in.fname) { ...@@ -39,7 +39,7 @@ modAUCplot = function(input, output, session, in.data, in.fname) {
if (is.null(loc.dt)) if (is.null(loc.dt))
return(NULL) return(NULL)
else else
return(unique(loc.dt[['realtime']])) return(unique(loc.dt[[COLRT]]))
}) })
# UI for trimming x-axis (time) # UI for trimming x-axis (time)
...@@ -72,7 +72,7 @@ modAUCplot = function(input, output, session, in.data, in.fname) { ...@@ -72,7 +72,7 @@ modAUCplot = function(input, output, session, in.data, in.fname) {
if (is.null(loc.dt)) if (is.null(loc.dt))
return(NULL) return(NULL)
else { else {
loc.res = loc.dt[realtime >= input$slTimeTrim[1] & realtime <= input$slTimeTrim[2], .(AUC = trapz(realtime, y)), by = .(group, id)] loc.res = loc.dt[get(COLRT) >= input$slTimeTrim[1] & get(COLRT) <= input$slTimeTrim[2], .(AUC = trapz(get(COLRT), get(COLY))), by = c(COLGR, COLID)]
return(loc.res) return(loc.res)
} }
}) })
...@@ -80,15 +80,15 @@ modAUCplot = function(input, output, session, in.data, in.fname) { ...@@ -80,15 +80,15 @@ modAUCplot = function(input, output, session, in.data, in.fname) {
callModule(modStats, 'dispStats', callModule(modStats, 'dispStats',
in.data = AUCcells, in.data = AUCcells,
in.meascol = 'AUC', in.meascol = 'AUC',
in.bycols = c('group'), in.bycols = COLGR,
in.fname = 'data4boxplotAUC.csv') in.fname = 'data4boxplotAUC.csv')
callModule(modBoxPlot, 'boxPlot', callModule(modBoxPlot, 'boxPlot',
in.data = AUCcells, in.data = AUCcells,
in.cols = list(meas.x = 'group', in.cols = list(meas.x = COLGR,
meas.y = 'AUC', meas.y = 'AUC',
group = 'group', group = COLGR,
id = 'id'), id = COLID),
in.fname = in.fname) in.fname = in.fname)
......
...@@ -6,19 +6,22 @@ ...@@ -6,19 +6,22 @@
# #
# UI ---- # UI ----
tabBoxPlotUI = function(id, label = "Comparing t-points") { tabBoxPlotUI = function(id, label = "Snapshots at time points") {
ns <- NS(id) ns <- NS(id)
tagList( tagList(
h4( h4(
"Box-/dot-/violin plot at selected t-points" "Box-/dot-/violin plots at selected time points"
), ),
br(), br(),
uiOutput(ns('varSelTpts')), uiOutput(ns('varSelTpts')),
checkboxInput(ns('chBfoldCh'), 'Fold change w.r.t. t-point:'), # This is an experimental feature to re-normalise data points with respect to a selected time point
uiOutput(ns('uiSlFoldChTp')), # Current implementation is limited; in the future slider should be replaced by an input field or a choice list.
# currenlty, if the selected time point is larger than the smallest time point for snapshot plotting, error appears.
#checkboxInput(ns('chBfoldCh'), 'Fold change w.r.t. t-point:'),
#uiOutput(ns('uiSlFoldChTp')),
modStatsUI(ns('dispStats')), modStatsUI(ns('dispStats')),
br(), br(),
...@@ -33,14 +36,14 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) { ...@@ -33,14 +36,14 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
callModule(modStats, 'dispStats', callModule(modStats, 'dispStats',
in.data = data4boxPlot, in.data = data4boxPlot,
in.meascol = 'y', in.meascol = 'y',
in.bycols = c('realtime', 'group'), in.bycols = c(COLRT, COLGR),
in.fname = 'data4boxplotTP.csv') in.fname = 'data4boxplotTP.csv')
callModule(modBoxPlot, 'boxPlot', callModule(modBoxPlot, 'boxPlot',
in.data = data4boxPlot, in.data = data4boxPlot,
in.cols = list(meas.x = 'realtime', in.cols = list(meas.x = COLRT,
meas.y = 'y', meas.y = COLY,
group = 'group', group = COLGR,
id = 'id'), id = 'id'),
in.fname = in.fname) in.fname = in.fname)
...@@ -54,7 +57,7 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) { ...@@ -54,7 +57,7 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
if (is.null(loc.dt))