Skip to content

GitLab

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

Bug fixes

parent 7f1ffe11
Hide whitespace changes
Inline Side-by-side
Showing with 120 additions and 58 deletions
modules/auxfunc.R
View file @ 4db73d9b
......@@ -182,7 +182,7 @@ helpText.server = c(
'Generate 60 random synthetic time series distributed evenly among 6 groups. Every time series has 60 time points.', #3
'Load CSV file with a column of track IDs for removal. IDs should correspond to those used for plotting.', #4
'Load CSV file with 5 columns: grouping, start and end tpts of stimulation, start and end of y-position, dummy column with ID.', #5
'Interpolate missing time points and pre-existing NAs. The interval of the time column must be provided!', #6
chBtrajInter = 'Interpolate missing time points and pre-existing NAs. Missing time points are rows entirely missing from the dataset. To interpolate, the interval of the time column must be provided.', #6
'If the track ID is unique only within a group, make it unique globally by combining with grouping columns.', #7
'Select columns to group data according to treatment, condition, etc.', #8
'Select math operation to perform on a single or two columns,', #9
......@@ -192,7 +192,8 @@ helpText.server = c(
'Normalise with respect to this time span.', #13
'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.', #14
'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.', #15
'Download time series after modification in this section.' #16
'Download time series after modification in this section.', #16
alertNAsPresent = "NAs present in the measurement column. Consider interpolation."
)
# Functions for data processing ----
......
modules/selOutliers.R
View file @ 4db73d9b
......@@ -5,12 +5,22 @@
# This is a module of a Shiny web application.
# Outlier identification, selection
helpText.selOutliers = c(chbRemoveOut = "Remove outlier time points. Gaps created by removing outliers can be interpolated or you can choose to remove entire trajectories that contain outlier time points.",
numOutliersPerc = 'Percentage of data points to remove from pooled data from all time points.',
chBtrajInter = 'Linearly interpolate gaps created after removing outlier time points.',
rbOutliersType = 'Choose whether to remove outliers from the top, bottom, or both ends of the pooled data distribution.',
slOutliersGapLen = 'Duration of a maximum allowed gap created by removing outlier time points. Time series with gaps longer than the set threshold will be removed entirely. ',
chBplotDist = 'Visualise a distribution of pooled data points. Red regions indicate the percentage of data set for removal.'
)
# UI-remove-outliers ----
modSelOutliersUI = function(id, label = "Outlier Selection") {
ns <- NS(id)
tagList(
checkboxInput(ns('chbRemoveOut'), 'Remove outliers', value = F),
bsTooltip(ns('chbRemoveOut'), helpText.selOutliers[["chbRemoveOut"]], placement = "top", trigger = "hover", options = NULL),
uiOutput(ns('uiSelOutliers'))
)
}
......@@ -45,20 +55,25 @@ modSelOutliers = function(input, output, session, in.data) {
max = 100,
value = 0,
step = 0.05, width = '100px'),
checkboxInput(ns('chBtrajInter'), 'Interpolate gaps', value = F)
bsTooltip(ns('numOutliersPerc'), helpText.selOutliers[["numOutliersPerc"]], placement = "top", trigger = "hover", options = NULL),
checkboxInput(ns('chBtrajInter'), 'Interpolate gaps', value = F),
bsTooltip(ns('chBtrajInter'), helpText.selOutliers[["chBtrajInter"]], placement = "top", trigger = "hover", options = NULL)
),
column(2,
radioButtons(ns('rbOutliersType'),
label = 'From',
choices = c('top' = 'top', 'top & bottom' = 'mid', 'bottom' = 'bot'))
choices = c('top' = 'top', 'top & bottom' = 'mid', 'bottom' = 'bot')),
bsTooltip(ns('rbOutliersType'), helpText.selOutliers[["rbOutliersType"]], placement = "top", trigger = "hover", options = NULL)
),
column(3,
sliderInput(ns('slOutliersGapLen'),
label = 'Remove tracks with gaps equal to or longer than',
min = 1,
label = 'Max allowed gap duration',
min = 0,
max = 10,
value = 1,
step = 1)
value = 0,
step = 1),
bsTooltip(ns('slOutliersGapLen'), helpText.selOutliers[["slOutliersGapLen"]], placement = "top", trigger = "hover", options = NULL)
),
column(3,
downloadButton(ns('downOutlierCSV'), label = 'CSV with outlier IDs'),
......@@ -66,6 +81,8 @@ modSelOutliers = function(input, output, session, in.data) {
)
),
checkboxInput(ns('chBplotDist'), 'Plot data distribution', value = F),
bsTooltip(ns('chBplotDist'), helpText.selOutliers[["chBplotDist"]], placement = "top", trigger = "hover", options = NULL),
uiOutput(ns('uiDistPlot'))
)
}
......@@ -245,8 +262,8 @@ modSelOutliers = function(input, output, session, in.data) {
print(loc.outpts)
}
if (input$slOutliersGapLen > 1) {
# remove tracks with gaps longer than the value set in slOutliersGapLen
if (input$slOutliersGapLen > 0) {
# remove tracks with gaps equal to or longer than the value set in slOutliersGapLen
# shorter gaps are interpolated linearly
# add index column per trajecory
......@@ -260,8 +277,8 @@ modSelOutliers = function(input, output, session, in.data) {
# the value of that column corresponds to the gap length (hence the "-1")
loc.out[, (COLIDXDIFF) := c(1, diff(get(COLIDX))) - 1, by = c(COLID)]
# get track ids where the max gap is equal to or longer than the threshold
loc.idgaps = loc.out[, max(get(COLIDXDIFF)), by = c(COLID)][V1 >= input$slOutliersGapLen, get(COLID)]
# get track ids where the max gap is longer than the threshold
loc.idgaps = loc.out[, max(get(COLIDXDIFF)), by = c(COLID)][V1 > input$slOutliersGapLen, get(COLID)]
if (DEB) {
cat(file = stdout(), '\nmodSelOutliers:dtReturn: Track IDs with max gap >= threshold:\n')
......@@ -303,7 +320,7 @@ modSelOutliers = function(input, output, session, in.data) {
# This is to ensure that interpolated columns are of porper type.
data.table::set(loc.out, j = col, value = as.numeric(loc.out[[col]]))
loc.out[, (col) := na.interpolation(get(col)), by = c(COLID)]
loc.out[, (col) := na_interpolation(get(col)), by = c(COLID)]
}
}
} else {
......
modules/tabClHier.R
View file @ 4db73d9b
......@@ -4,6 +4,18 @@
#
# This module is a tab for hierarchical clustering (base R hclust + dist)
helpText.clHier = c(alertNAsPresentDTW = paste0("NAs present. DTW cannot calculate the distance. ",
"NAs and missing data can be interpolated by activating the option in the left panel. ",
"If outlier points were removed, activate \"Interpolate gaps\" or ",
"decrease the threshold for maximum allowed gap length. ",
"The latter will result in entire trajectories with outliers being removed."),
alertNAsPresent = paste0("NAs present. The selected distance measure will work with missing data, ",
"however caution is recommended. NAs and missing data can be interpolated by activating the option in the left panel. ",
"If outlier points were removed, activate \"Interpolate gaps\" or ",
"decrease the threshold for maximum allowed gap length. ",
"The latter will result in entire trajectories with outliers being removed."))
# UI ----
clustHierUI <- function(id, label = "Hierarchical CLustering") {
ns <- NS(id)
......@@ -23,6 +35,7 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
"DTW" = 5),
selected = 1
),
bsAlert("alertAnchorClHierNAsPresent"),
selectInput(
ns("selectPlotHierLinkage"),
label = ("Select linkage method:"),
......@@ -149,9 +162,9 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
)
),
withSpinner(plotOutput(ns('outPlotHier'))),
actionButton(ns('butPlotHierHeatMap'), 'Plot!'),
downPlotUI(ns('downPlotHier'), "Download PNG")
downPlotUI(ns('downPlotHier'), "Download PNG"),
withSpinner(plotOutput(ns('outPlotHier')))
),
tabPanel('Averages',
......@@ -448,6 +461,26 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
if (is.null(loc.dm))
return(NULL)
print(sum(is.na(loc.dm)))
if(sum(is.na(loc.dm)) > 0) {
if (input$selectPlotHierDiss == 5) {
createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresentDTW", title = "Error",
content = helpText.clHier[["alertNAsPresentDTW"]],
append = FALSE,
style = "danger")
return(NULL)
} else {
createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresent", title = "Warning",
content = helpText.clHier[["alertNAsPresent"]],
append = FALSE,
style = "warning")
closeAlert(session, 'alertNAsPresentDTW')
}
} else {
closeAlert(session, 'alertNAsPresentDTW')
closeAlert(session, 'alertNAsPresent')
}
loc.dend <- userFitDendHier()
if (is.null(loc.dend))
return(NULL)
......
modules/tabScatter.R
View file @ 4db73d9b
......@@ -14,12 +14,12 @@
# callModule(clustHier, 'TabClustHier', dataMod)
# where dataMod is the output from a reactive function that returns dataset ready for clustering
helpText.tabScatter = c("Display measurement values from two different time points as a scatter plot.",
'Y-axis can display a value at a selected time point or a difference between values at two selected time points.', #1
'Add a line with linear regression and regions of 95% confidence interval.', #2
'A number of time points left & right of selected time points; use the mean of values from these time points for the scatterplot.', #3
'Height in pixels of the displayed plot', #4
'Number of facets in a row. Each facet displayes a scatter plot for a single group.' #5
helpText.tabScatter = c(alScatter = "Display measurement values from two different time points as a scatter plot.",
rBfoldChange = 'Y-axis can display a value at a selected time point or a difference between values at two selected time points.', #1
chBregression = 'Add a line with linear regression and regions of 95% confidence interval.', #2
inNeighTpts = 'A number of time points left & right of selected time points; use the mean of values from these time points for the scatterplot.', #3
inPlotHeight = 'Height in pixels of the displayed plot', #4
inPlotNcolFacet = 'Number of facets in a row. Each facet displayes a scatter plot for a single group.' #5
)
# UI ----
......@@ -38,20 +38,18 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
4,
uiOutput(ns('uiSelTptX')),
uiOutput(ns('uiSelTptY')),
bsAlert("alert2differentTpts"),
checkboxInput(ns('chBregression'), 'Linear regression with 95% CI'),
bsTooltip(ns('chBregression'), helpText.tabScatter[3], placement = "bottom", trigger = "hover", options = NULL)
bsAlert("alertAnchor2differentTpts"),
radioButtons(ns('rBfoldChange'), 'Y-axis',
choices = c("Y" = "y", "Y-X" = "diff"),
width = "100px", inline = T),
bsTooltip(ns('rBfoldChange'), helpText.tabScatter[["rBfoldChange"]], placement = "top", trigger = "hover", options = NULL)
),
column(
4,
numericInput(ns('inNeighTpts'), 'Smoothing', value = 0, step = 1, min = 0, width = "120px"),
bsTooltip(ns('inNeighTpts'), helpText.tabScatter[4], placement = "bottom", trigger = "hover", options = NULL),
radioButtons(ns('rBfoldChange'), 'Y-axis',
choices = c("Y" = "y", "Y-X" = "diff"),
width = "100px", inline = T),
bsTooltip(ns('rBfoldChange'), helpText.tabScatter[2], placement = "bottom", trigger = "hover", options = NULL)
bsTooltip(ns('inNeighTpts'), helpText.tabScatter[["inNeighTpts"]], placement = "top", trigger = "hover", options = NULL),
checkboxInput(ns('chBregression'), 'Linear regression with 95% CI'),
bsTooltip(ns('chBregression'), helpText.tabScatter[["chBregression"]], placement = "top", trigger = "hover", options = NULL)
),
column(
4,
......@@ -63,7 +61,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
step = 100,
width = "100px"
),
bsTooltip(ns('inPlotHeight'), helpText.tabScatter[5], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip(ns('inPlotHeight'), helpText.tabScatter[["inPlotHeight"]], placement = "top", trigger = "hover", options = NULL),
numericInput(
ns('inPlotNcolFacet'),
......@@ -73,7 +71,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
step = 1,
width = "100px"
),
bsTooltip(ns('inPlotNcolFacet'), helpText.tabScatter[6], placement = "bottom", trigger = "hover", options = NULL)
bsTooltip(ns('inPlotNcolFacet'), helpText.tabScatter[["inPlotNcolFacet"]], placement = "top", trigger = "hover", options = NULL)
)
),
......@@ -171,12 +169,14 @@ data4scatterPlot <- reactive({
loc.tpts.y = as.integer(input$inSelTptY)
if (loc.tpts.x == loc.tpts.y) {
createAlert(session, "alert2differentTpts", "exampleAlert", title = "",
content = "Select two different time points.", append = FALSE)
createAlert(session, "alertAnchor2differentTpts", "alert2differentTpts", title = "Error",
content = "Select two different time points.",
append = FALSE,
style = "danger")
return(NULL)
} else {
closeAlert(session, "exampleAlert")
closeAlert(session, "alert2differentTpts")
}
# if neigbbouring points selected, obtain time points for which the aggregation will be calculated
......@@ -309,7 +309,7 @@ output$outPlotScatterInt <- renderPlotly({
addPopover(session,
id = ns("alScatter"),
title = "Scatter plot",
content = helpText.tabScatter[1],
content = helpText.tabScatter[["alScatter"]],
trigger = "click")
......
server.R
View file @ 4db73d9b
......@@ -349,7 +349,7 @@ shinyServer(function(input, output, session) {
choices = list('fold-change' = 'mean', 'z-score' = 'z.score'),
width = "40%"
),
bsTooltip('rBnormMeth', helpText.server[12], placement = "bottom", trigger = "hover", options = NULL)
bsTooltip('rBnormMeth', helpText.server[12], placement = "top", trigger = "hover", options = NULL)
)
}
})
......@@ -377,7 +377,7 @@ shinyServer(function(input, output, session) {
value = c(locRTmin, 0.1 * locRTmax),
step = 1
),
bsTooltip('slNormRtMinMax', helpText.server[13], placement = "bottom", trigger = "hover", options = NULL)
bsTooltip('slNormRtMinMax', helpText.server[13], placement = "top", trigger = "hover", options = NULL)
)
}
})
......@@ -393,7 +393,7 @@ shinyServer(function(input, output, session) {
label = 'Robust stats',
FALSE,
width = "40%"),
bsTooltip('chBnormRobust', helpText.server[14], placement = "bottom", trigger = "hover", options = NULL)
bsTooltip('chBnormRobust', helpText.server[14], placement = "top", trigger = "hover", options = NULL)
)
}
})
......@@ -409,7 +409,7 @@ shinyServer(function(input, output, session) {
label = 'Normalisation grouping',
choices = list('Entire dataset' = 'none', 'Per group' = 'group', 'Per trajectory' = 'id'),
width = "40%"),
bsTooltip('chBnormGroup', helpText.server[15], placement = "bottom", trigger = "hover", options = NULL)
bsTooltip('chBnormGroup', helpText.server[15], placement = "top", trigger = "hover", options = NULL)
)
}
})
......@@ -513,7 +513,6 @@ shinyServer(function(input, output, session) {
# remove trajectories based on uploaded csv
if (input$chBtrajRem) {
if (DEB)
cat(file = stdout(), 'server:dataMod: trajRem not NULL\n')
......@@ -522,6 +521,9 @@ shinyServer(function(input, output, session) {
loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
}
# check if NAs present
return(loc.dt)
})
......@@ -699,6 +701,15 @@ shinyServer(function(input, output, session) {
# or the frame number metadata can be missing, as is the case for tCourseSelected files that already have realtime column.
# Therefore, we cannot rely on that info to get time frequency; user must provide this number!
# check if NA's present
if (sum(is.na(loc.out[[COLY]])))
createAlert(session, "alertAnchorSidePanelNAsPresent", "alertNAsPresent", title = "Warning",
content = helpText.server[["alertNAsPresent"]],
append = FALSE,
style = "warning")
else
closeAlert(session, "alertNAsPresent")
setkeyv(loc.out, c(COLGR, COLID, COLRT))
if (input$chBtrajInter) {
......@@ -726,7 +737,7 @@ shinyServer(function(input, output, session) {
#loc.out[, (col) := as.numeric(get(col))]
data.table::set(loc.out, j = col, value = as.numeric(loc.out[[col]]))
loc.out[, (col) := na.interpolation(get(col)), by = c(COLID)]
loc.out[, (col) := na_interpolation(get(col)), by = c(COLID)]
}
# loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = c(COLID), .SDcols = s.cols]
......@@ -776,7 +787,7 @@ shinyServer(function(input, output, session) {
# prepare data for clustering
# return a matrix with:
# convert from long to wide; return a matrix with:
# cells as columns
# time points as rows
data4clust <- reactive({
......
ui.R
View file @ 4db73d9b
......@@ -26,39 +26,39 @@ shinyUI(fluidPage(
'Select data file and click "Load Data"',
accept = c('text/csv', 'text/comma-separated-values,text/plain')
),
bsTooltip('inFileLoadNuc', helpText.server[1], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('inFileLoadNuc', helpText.server[1], placement = "top", trigger = "hover", options = NULL),
radioButtons("inRbutLongWide", "Data format:", c("Long" = 0, "Wide" = 1), width = "40%"),
bsTooltip('inRbutLongWide', helpText.server[2], placement = "bottom", trigger = "hover", options = NULL),
radioButtons("inRbutLongWide", "Data format:", c("Long" = 0, "Wide" = 1), inline = T),
bsTooltip('inRbutLongWide', helpText.server[2], placement = "top", trigger = "hover", options = NULL),
actionButton("inButLoadNuc", "Load Data"),
actionButton("butReset", "Reset file input"),
actionButton('inDataGen1', 'Synthetic data'),
bsTooltip('inDataGen1', helpText.server[3], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('inDataGen1', helpText.server[3], placement = "top", trigger = "hover", options = NULL),
tags$hr(),
checkboxInput('chBtrajRem', 'Upload tracks to remove'),
bsTooltip('chBtrajRem', helpText.server[4], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('chBtrajRem', helpText.server[4], placement = "top", trigger = "hover", options = NULL),
uiOutput('uiFileLoadTrajRem'),
uiOutput('uiButLoadTrajRem'),
#tags$hr(),
checkboxInput('chBstim', 'Upload stimulation pattern'),
bsTooltip('chBstim', helpText.server[5], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('chBstim', helpText.server[5], placement = "top", trigger = "hover", options = NULL),
uiOutput('uiFileLoadStim'),
uiOutput('uiButLoadStim'),
#tags$hr(),
checkboxInput('chBtrajInter', 'Interpolate NAs and missing data', value = F),
bsTooltip('chBtrajInter', helpText.server[6], placement = "bottom", trigger = "hover", options = NULL),
bsAlert("alertAnchorSidePanelNAsPresent"),
bsTooltip('chBtrajInter', helpText.server[["chBtrajInter"]], placement = "top", trigger = "hover", options = NULL),
uiOutput('varSelTimeFreq'),
checkboxInput('chBtrackUni', 'Create unique track ID', F),
bsTooltip('chBtrackUni', helpText.server[7], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('chBtrackUni', helpText.server[7], placement = "top", trigger = "hover", options = NULL),
uiOutput('varSelSite'),
tags$hr(),
......@@ -66,7 +66,7 @@ shinyUI(fluidPage(
uiOutput('varSelTrackLabel'),
checkboxInput('chBgroup', 'Columns for plot grouping', F),
bsTooltip('chBgroup', helpText.server[8], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('chBgroup', helpText.server[8], placement = "top", trigger = "hover", options = NULL),
uiOutput('varSelGroup'),
uiOutput('varSelTime'),
......@@ -83,17 +83,17 @@ shinyUI(fluidPage(
'1 / X' = '1 / '
)
),
bsTooltip('inSelMath', helpText.server[9], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('inSelMath', helpText.server[9], placement = "top", trigger = "hover", options = NULL),
uiOutput('varSelMeas2'),
tags$hr(),
checkboxInput('chBtimeTrim', 'Trim x-axis', FALSE),
bsTooltip('chBtimeTrim', helpText.server[10], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('chBtimeTrim', helpText.server[10], placement = "top", trigger = "hover", options = NULL),
uiOutput('uiSlTimeTrim'),
checkboxInput('chBnorm', 'Normalization', FALSE),
bsTooltip('chBnorm', helpText.server[11], placement = "bottom", trigger = "hover", options = NULL),
bsTooltip('chBnorm', helpText.server[11], placement = "top", trigger = "hover", options = NULL),
uiOutput('uiChBnorm'),
uiOutput('uiSlNorm'),
uiOutput('uiChBnormRobust'),
......@@ -101,7 +101,7 @@ shinyUI(fluidPage(
tags$hr(),
downloadButton('downloadDataClean', 'Download mod\'d data'),
bsTooltip('downloadDataClean', helpText.server[16], placement = "bottom", trigger = "hover", options = NULL)
bsTooltip('downloadDataClean', helpText.server[16], placement = "top", trigger = "hover", options = NULL)
),
mainPanel(
......
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