Commit ef30c0f0 authored by dmattek's avatar dmattek
Browse files

Added debounce delay to sliders for time trimming and normalisation. Code rearrangements.

parent 1232aa7a
...@@ -314,6 +314,7 @@ shinyServer(function(input, output, session) { ...@@ -314,6 +314,7 @@ shinyServer(function(input, output, session) {
}) })
# UI-side-panel-trim x-axis (time) ---- # UI-side-panel-trim x-axis (time) ----
output$uiSlTimeTrim = renderUI({ output$uiSlTimeTrim = renderUI({
if (DEB) if (DEB)
cat(file = stdout(), 'server:uiSlTimeTrim\n') cat(file = stdout(), 'server:uiSlTimeTrim\n')
...@@ -337,7 +338,13 @@ shinyServer(function(input, output, session) { ...@@ -337,7 +338,13 @@ shinyServer(function(input, output, session) {
) )
} }
}) })
# Return the value of slider for trimming time;
# output delayed by MILLIS
returnValSlTimeTrim = reactive({
return(input$slTimeTrim)
}) %>% debounce(MILLIS)
# UI-side-panel-normalization ---- # UI-side-panel-normalization ----
...@@ -389,6 +396,13 @@ shinyServer(function(input, output, session) { ...@@ -389,6 +396,13 @@ shinyServer(function(input, output, session) {
} }
}) })
# Return the value of slider for normalisation time;
# output delayed by MILLIS
returnValSlNormRtMinMax = reactive({
return(input$slNormRtMinMax)
}) %>% debounce(MILLIS)
# use robust stats (median instead of mean, mad instead of sd) # use robust stats (median instead of mean, mad instead of sd)
output$uiChBnormRobust = renderUI({ output$uiChBnormRobust = renderUI({
if (DEB) if (DEB)
...@@ -432,6 +446,7 @@ shinyServer(function(input, output, session) { ...@@ -432,6 +446,7 @@ shinyServer(function(input, output, session) {
# Processing-data ---- # Processing-data ----
# Obtain data either from an upload or by generating a synthetic dataset
dataInBoth <- reactive({ dataInBoth <- reactive({
# Without direct references to inDataGen1,2 and inFileLoad, inDataGen2 # Without direct references to inDataGen1,2 and inFileLoad, inDataGen2
# does not trigger running this reactive once inDataGen1 is used. # does not trigger running this reactive once inDataGen1 is used.
...@@ -535,20 +550,9 @@ shinyServer(function(input, output, session) { ...@@ -535,20 +550,9 @@ shinyServer(function(input, output, session) {
return(dm) return(dm)
}) })
# return column names of the main dt # Return a dt with mods depending on UI options::
getDataNucCols <- reactive({ # - an added column with unique track object label created from the existing track id and prepended with columns chosen in the UI
if (DEB) # - removed track IDs based on a separate file uploaded; the file should contain a single column with a header and unique track IDs
cat(file = stdout(), 'server:getDataNucCols: in\n')
loc.dt = dataInBoth()
if (is.null(loc.dt))
return(NULL)
else
return(colnames(loc.dt))
})
# return dt with an added column with unique track object label
dataMod <- reactive({ dataMod <- reactive({
if (DEB) if (DEB)
cat(file = stdout(), 'server:dataMod\n') cat(file = stdout(), 'server:dataMod\n')
...@@ -562,11 +566,10 @@ shinyServer(function(input, output, session) { ...@@ -562,11 +566,10 @@ shinyServer(function(input, output, session) {
# create unique track ID based on columns specified in input$inSelSite field and combine with input$inSelTrackLabel # create unique track ID based on columns specified in input$inSelSite field and combine with input$inSelTrackLabel
loc.dt[, (COLIDUNI) := do.call(paste, c(.SD, sep = "_")), .SDcols = c(input$inSelSite, input$inSelTrackLabel) ] loc.dt[, (COLIDUNI) := do.call(paste, c(.SD, sep = "_")), .SDcols = c(input$inSelSite, input$inSelTrackLabel) ]
} else { } else {
# stay with track ID provided in the loaded dataset; has to be unique # Leave track ID provided in the loaded dataset; has to be unique
loc.dt[, (COLIDUNI) := get(input$inSelTrackLabel)] loc.dt[, (COLIDUNI) := get(input$inSelTrackLabel)]
} }
# remove trajectories based on uploaded csv # remove trajectories based on uploaded csv
if (input$chBtrajRem) { if (input$chBtrajRem) {
if (DEB) if (DEB)
...@@ -576,44 +579,9 @@ shinyServer(function(input, output, session) { ...@@ -576,44 +579,9 @@ shinyServer(function(input, output, session) {
loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])] loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
} }
# check if NAs present
return(loc.dt) return(loc.dt)
}) })
# return all unique track object labels (created in dataMod)
# This will be used to display in UI for trajectory highlighting
getDataTrackObjLabUni <- reactive({
if (DEB)
cat(file = stdout(), 'server:getDataTrackObjLabUni\n')
loc.dt = dataMod()
if (is.null(loc.dt))
return(NULL)
else
return(unique(loc.dt$trackObjectsLabelUni))
})
# return all unique time points (real time)
# This will be used to display in UI for box-plot
# These timepoints are from the original dt and aren't affected by trimming of x-axis
getDataTpts <- reactive({
if (DEB)
cat(file = stdout(), 'server:getDataTpts\n')
loc.dt = dataMod()
if (is.null(loc.dt))
return(NULL)
else
return(unique(loc.dt[[input$inSelTime]]))
})
# prepare data for plotting time courses # prepare data for plotting time courses
# returns dt with these columns: # returns dt with these columns:
# realtime - selected from input # realtime - selected from input
...@@ -627,9 +595,9 @@ shinyServer(function(input, output, session) { ...@@ -627,9 +595,9 @@ shinyServer(function(input, output, session) {
# (column created if mid.in present in uploaded data or tracks are selected in the UI) # (column created if mid.in present in uploaded data or tracks are selected in the UI)
# obj.num - created if ObjectNumber column present in the input data # obj.num - created if ObjectNumber column present in the input data
# pos.x,y - created if columns with x and y positions present in the input data # pos.x,y - created if columns with x and y positions present in the input data
data4trajPlot <- reactive({ dataLong <- reactive({
if (DEB) if (DEB)
cat(file = stdout(), 'server:data4trajPlot\n') cat(file = stdout(), 'server:dataLong\n')
loc.dt = dataMod() loc.dt = dataMod()
if (is.null(loc.dt)) if (is.null(loc.dt))
...@@ -672,7 +640,7 @@ shinyServer(function(input, output, session) { ...@@ -672,7 +640,7 @@ shinyServer(function(input, output, session) {
loc.s.pos.y = names(loc.dt)[grep('(L|l)ocation.*Y|(P|p)os.y|(P|p)osy', names(loc.dt))[1]] loc.s.pos.y = names(loc.dt)[grep('(L|l)ocation.*Y|(P|p)os.y|(P|p)osy', names(loc.dt))[1]]
if (DEB) if (DEB)
cat('server:data4trajPlot:\n Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n') cat('server:dataLong:\n Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n')
if (!is.na(loc.s.pos.x) & !is.na(loc.s.pos.y)) if (!is.na(loc.s.pos.x) & !is.na(loc.s.pos.y))
locPos = TRUE locPos = TRUE
...@@ -684,7 +652,7 @@ shinyServer(function(input, output, session) { ...@@ -684,7 +652,7 @@ shinyServer(function(input, output, session) {
# This is different from TrackObject_Label and is handy to keep # This is different from TrackObject_Label and is handy to keep
# because labels on segmented images are typically ObjectNumber # because labels on segmented images are typically ObjectNumber
loc.s.objnum = names(loc.dt)[grep('(O|o)bject(N|n)umber', names(loc.dt))[1]] loc.s.objnum = names(loc.dt)[grep('(O|o)bject(N|n)umber', names(loc.dt))[1]]
#cat('data4trajPlot::loc.s.objnum ', loc.s.objnum, '\n') #cat('dataLong::loc.s.objnum ', loc.s.objnum, '\n')
if (is.na(loc.s.objnum)) { if (is.na(loc.s.objnum)) {
locObjNum = FALSE locObjNum = FALSE
} }
...@@ -756,7 +724,8 @@ shinyServer(function(input, output, session) { ...@@ -756,7 +724,8 @@ 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. # 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! # Therefore, we cannot rely on that info to get time frequency; user must provide this number!
# check if NA's present # Check for explicit NA's in the measurement columns
# Has to be here (and not in dataMod()) because we need to know the name of the measurement column (COLY)
if (sum(is.na(loc.out[[COLY]]))) if (sum(is.na(loc.out[[COLY]])))
createAlert(session, "alertAnchorSidePanelNAsPresent", "alertNAsPresent", title = "Warning", createAlert(session, "alertAnchorSidePanelNAsPresent", "alertNAsPresent", title = "Warning",
content = helpText.server[["alertNAsPresent"]], content = helpText.server[["alertNAsPresent"]],
...@@ -777,7 +746,7 @@ shinyServer(function(input, output, session) { ...@@ -777,7 +746,7 @@ shinyServer(function(input, output, session) {
# x-check: print all rows with NA's # x-check: print all rows with NA's
if (DEB) { if (DEB) {
cat(file = stdout(), 'server:data4trajPlot: Rows with NAs:\n') cat(file = stdout(), 'server:dataLong: Rows with NAs:\n')
print(loc.out[rowSums(is.na(loc.out)) > 0, ]) print(loc.out[rowSums(is.na(loc.out)) > 0, ])
} }
...@@ -817,7 +786,7 @@ shinyServer(function(input, output, session) { ...@@ -817,7 +786,7 @@ shinyServer(function(input, output, session) {
## Trim x-axis (time) ## Trim x-axis (time)
if(input$chBtimeTrim) { if(input$chBtimeTrim) {
loc.out = loc.out[get(COLRT) >= input$slTimeTrim[[1]] & get(COLRT) <= input$slTimeTrim[[2]] ] loc.out = loc.out[get(COLRT) >= returnValSlTimeTrim()[[1]] & get(COLRT) <= returnValSlTimeTrim()[[2]] ]
} }
## Normalization ## Normalization
...@@ -827,15 +796,15 @@ shinyServer(function(input, output, session) { ...@@ -827,15 +796,15 @@ shinyServer(function(input, output, session) {
in.dt = loc.out, in.dt = loc.out,
in.meas.col = COLY, in.meas.col = COLY,
in.rt.col = COLRT, in.rt.col = COLRT,
in.rt.min = input$slNormRtMinMax[1], in.rt.min = returnValSlNormRtMinMax()[1],
in.rt.max = input$slNormRtMinMax[2], in.rt.max = returnValSlNormRtMinMax()[2],
in.type = input$rBnormMeth, in.type = input$rBnormMeth,
in.robust = input$chBnormRobust, in.robust = input$chBnormRobust,
in.by.cols = if(input$chBnormGroup %in% 'none') NULL else input$chBnormGroup in.by.cols = if(input$chBnormGroup %in% 'none') NULL else input$chBnormGroup
) )
# Column with normalized data is renamed to the original name # Column with normalized data is renamed to the original name
# Further code assumes column name y produced by data4trajPlot # Further code assumes column name y produced by dataLong
loc.out[, c(COLY) := NULL] loc.out[, c(COLY) := NULL]
setnames(loc.out, 'y.norm', COLY) setnames(loc.out, 'y.norm', COLY)
...@@ -845,15 +814,15 @@ shinyServer(function(input, output, session) { ...@@ -845,15 +814,15 @@ shinyServer(function(input, output, session) {
}) })
# prepare data for clustering # Prepare data in wide format, ready for distance calculation in clustering
# convert from long to wide; return a matrix with: # Return a matrix with:
# cells as columns # - time series as rows
# time points as rows # - time points as columns
data4clust <- reactive({ dataWide <- reactive({
if (DEB) if (DEB)
cat(file = stdout(), 'server:data4clust\n') cat(file = stdout(), 'server:dataWide\n')
loc.dt = data4trajPlotNoOut() loc.dt = dataLongNoOut()
if (is.null(loc.dt)) if (is.null(loc.dt))
return(NULL) return(NULL)
...@@ -871,53 +840,99 @@ shinyServer(function(input, output, session) { ...@@ -871,53 +840,99 @@ shinyServer(function(input, output, session) {
# assign row names to the matrix # assign row names to the matrix
rownames(loc.m.out) = loc.rownames rownames(loc.m.out) = loc.rownames
# Check for missing time points
# Missing rows in the long format give rise to NAs during dcast
# Here, we are not checking for explicit NAs in COLY column
if ((sum(is.na(loc.dt[[COLY]])) == 0) & (sum(is.na(loc.dt.wide)) > 0)) {
createAlert(session, "alertAnchorSidePanelNAsPresent", "alertNAsPresentLong2WideConv", title = "Warning",
content = helpText.server[["alertNAsPresentLong2WideConv"]],
append = FALSE,
style = "warning")
} else {
closeAlert(session, "alertNAsPresentLong2WideConv")
}
return(loc.m.out) return(loc.m.out)
}) })
# prepare data with stimulation pattern # Prepare data with stimulation pattern
# this dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment # This dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment
data4stimPlot <- reactive({ dataStim <- reactive({
if (DEB) if (DEB)
cat(file = stdout(), 'server:data4stimPlot\n') cat(file = stdout(), 'server:dataStim\n')
if (input$chBstim) { if (input$chBstim) {
if (DEB) if (DEB)
cat(file = stdout(), 'server:data4stimPlot: stim not NULL\n') cat(file = stdout(), 'server:dataStim: stim not NULL\n')
loc.dt.stim = dataLoadStim() loc.dt.stim = dataLoadStim()
return(loc.dt.stim) return(loc.dt.stim)
} else { } else {
if (DEB) if (DEB)
cat(file = stdout(), 'server:data4stimPlot: stim is NULL\n') cat(file = stdout(), 'server:dataStim: stim is NULL\n')
return(NULL) return(NULL)
} }
}) })
# prepare y-axis label in time series plots, depending on UI setting # Return all unique track object labels (created in dataMod)
# Used to display track IDs in UI for trajectory highlighting
getDataTrackObjLabUni <- reactive({
if (DEB)
cat(file = stdout(), 'server:getDataTrackObjLabUni\n')
loc.dt = dataMod()
if (is.null(loc.dt))
return(NULL)
else
return(unique(loc.dt[[COLIDUNI]]))
})
createYaxisLabel = reactive({
locLabel = input$inSelMeas1 # Return all unique time points (real time)
# Used to set limits of sliders for trimming time and for normalisation
# These timepoints are from the original dt and aren't affected by trimming of x-axis
getDataTpts <- reactive({
if (DEB)
cat(file = stdout(), 'server:getDataTpts\n')
loc.dt = dataMod()
if (is.null(loc.dt))
return(NULL)
else
return(unique(loc.dt[[input$inSelTime]]))
})
# Return column names of the main dt
# Used to fill UI input fields with a choice of column names
getDataNucCols <- reactive({
if (DEB)
cat(file = stdout(), 'server:getDataNucCols: in\n')
return(locLabel) loc.dt = dataInBoth()
if (is.null(loc.dt))
return(NULL)
else
return(colnames(loc.dt))
}) })
# download data as prepared for plotting # Unfinished f-n!
# after all modification # prepare y-axis label in time series plots, depending on UI setting
output$downloadDataClean <- downloadHandler( createYaxisLabel = reactive({
filename = FCSVTCCLEAN, locLabel = input$inSelMeas1
content = function(file) {
write.csv(data4trajPlotNoOut(), file, row.names = FALSE) return(locLabel)
} })
)
# Plotting-trajectories ---- # Plotting-trajectories ----
# UI for selecting trajectories # UI for selecting trajectories
# The output data table of data4trajPlot is modified based on inSelHighlight field # The output data table of dataLong is modified based on inSelHighlight field
output$varSelHighlight = renderUI({ output$varSelHighlight = renderUI({
if (DEB) if (DEB)
cat(file = stdout(), 'server:varSelHighlight\n') cat(file = stdout(), 'server:varSelHighlight\n')
...@@ -938,44 +953,55 @@ shinyServer(function(input, output, session) { ...@@ -938,44 +953,55 @@ shinyServer(function(input, output, session) {
} }
}) })
# Modules within main window ----
# download data as prepared for plotting
# after all modification
output$downloadDataClean <- downloadHandler(
filename = FCSVTCCLEAN,
content = function(file) {
write.csv(dataLongNoOut(), file, row.names = FALSE)
}
)
# Taking out outliers # Taking out outliers
data4trajPlotNoOut = callModule(modSelOutliers, 'returnOutlierIDs', data4trajPlot) dataLongNoOut = callModule(modSelOutliers, 'returnOutlierIDs', dataLong)
# Trajectory plotting - ribbon # Trajectory plotting - ribbon
callModule(modTrajRibbonPlot, 'modTrajRibbon', callModule(modTrajRibbonPlot, 'modTrajRibbon',
in.data = data4trajPlotNoOut, in.data = dataLongNoOut,
in.data.stim = data4stimPlot, in.data.stim = dataStim,
in.fname = function() return(FPDFTCMEAN)) in.fname = function() return(FPDFTCMEAN))
# Trajectory plotting - individual # Trajectory plotting - individual
callModule(modTrajPlot, 'modTrajPlot', callModule(modTrajPlot, 'modTrajPlot',
in.data = data4trajPlotNoOut, in.data = dataLongNoOut,
in.data.stim = data4stimPlot, in.data.stim = dataStim,
in.fname = function() {return(FPDFTCSINGLE)}, in.fname = function() {return(FPDFTCSINGLE)},
in.ylab = createYaxisLabel) in.ylab = createYaxisLabel)
# Trajectory plotting - PSD # Trajectory plotting - PSD
callModule(modPSDPlot, 'modPSDPlot', callModule(modPSDPlot, 'modPSDPlot',
in.data = data4trajPlotNoOut, in.data = dataLongNoOut,
in.fname = function() {return(FPDFTCPSD)}) in.fname = function() {return(FPDFTCPSD)})
# Tabs ---- # Tabs ----
###### AUC calculation and plotting ###### AUC calculation and plotting
callModule(tabAUCplot, 'tabAUC', data4trajPlotNoOut, in.fname = function() return(FPDFBOXAUC)) callModule(tabAUCplot, 'tabAUC', dataLongNoOut, in.fname = function() return(FPDFBOXAUC))
###### Box-plot ###### Box-plot
callModule(tabDistPlot, 'tabDistPlot', data4trajPlotNoOut, in.fname = function() return(FPDFBOXTP)) callModule(tabDistPlot, 'tabDistPlot', dataLongNoOut, in.fname = function() return(FPDFBOXTP))
###### Scatter plot ###### Scatter plot
callModule(tabScatterPlot, 'tabScatter', data4trajPlotNoOut, in.fname = function() return(FPDFSCATTER)) callModule(tabScatterPlot, 'tabScatter', dataLongNoOut, in.fname = function() return(FPDFSCATTER))
##### Hierarchical estimation ##### Hierarchical validation
callModule(clustValid, 'tabClValid', data4clust) callModule(clustValid, 'tabClValid', dataWide)
##### Hierarchical clustering ##### Hierarchical clustering
callModule(clustHier, 'tabClHier', data4clust, data4trajPlotNoOut, data4stimPlot) callModule(clustHier, 'tabClHier', dataWide, dataLongNoOut, dataStim)
##### Sparse hierarchical clustering using sparcl ##### Sparse hierarchical clustering using sparcl
callModule(clustHierSpar, 'tabClHierSpar', data4clust, data4trajPlotNoOut, data4stimPlot) callModule(clustHierSpar, 'tabClHierSpar', dataWide, dataLongNoOut, dataStim)
}) })
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