Skip to content

GitLab

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

Added: option to upload and display stimulation pattern

parent 9d1f5677
Hide whitespace changes
Inline Side-by-side
Showing with 241 additions and 43 deletions
modules/auxfunc.R
View file @ 04739dba
......@@ -97,7 +97,8 @@ help.text = c(
'Plotting and data processing requires a unique cell ID across entire dataset. A typical dataset from CellProfiler assigns unique cell ID (TrackLabel) within each field of view (Metadata_Site).
Therefore, a unique ID is created by concatenating these two columns. If the dataset already contains a unique ID, UNcheck this box and select a single column only.',
'This option allows to interpolate NAs or missing data. Some rows in the input file might be missing because a particular time point might not had been acquired.
This option, interpolates such missing points as well as points with NAs in the measurement column. When this option is checked, the interval of time column must be provided!'
This option, interpolates such missing points as well as points with NAs in the measurement column. When this option is checked, the interval of time column must be provided!',
'Accepts CSV file with two columns: grouping, time points of stimulation.'
)
......@@ -186,6 +187,7 @@ rotatedAxisElementText = function(angle, position='x', size = 12){
element_text(size = 12, angle = angle, vjust = vjust, hjust = hjust)
}
# default ggplot theme used in the app
myGgplotTheme =
theme_bw(base_size = 8, base_family = "Helvetica") +
theme(
......@@ -206,7 +208,9 @@ myGgplotTheme =
legend.position = "top"
)
myGgplotTraj = function(dt.arg, # data table
# Plot individual time series
LOCplotTraj = function(dt.arg, # input data table
x.arg, # string with column name for x-axis
y.arg, # string with column name for y-axis
group.arg, # string with column name for grouping time series (typicaly cell ID)
......@@ -218,9 +222,10 @@ myGgplotTraj = function(dt.arg, # data table
ylab.arg = NULL, # string with y-axis label
plotlab.arg = NULL, # string with plot label
dt.stim.arg = NULL, # plotting additional dataset; typically to indicate stimulations (not fully implemented yet, not tested!)
x.stim.arg = c('tstart', 'tend'), # column names in stimulation dt with x and xend parameters
y.stim.arg = c('ystart', 'yend'), # column names in stimulation dt with y and yend parameters
tfreq.arg = 1,
ylim.arg = NULL,
stim.bar.height.arg = 0.1,
stim.bar.width.arg = 0.5,
aux.label1 = NULL, # 1st point label; used for interactive plotting; displayed in the tooltip; typically used to display values of column holding x & y coordinates
aux.label2 = NULL,
......@@ -313,16 +318,19 @@ myGgplotTraj = function(dt.arg, # data table
facet_wrap(as.formula(paste("~", facet.arg)),
ncol = facet.ncol.arg,
scales = "free_x")
# plot stimulation bars underneath time series
# dt.stim.arg is read separately and should contain 4 columns with
# xy positions of beginning and end of the bar
if(!is.null(dt.stim.arg)) {
p.tmp = p.tmp + geom_segment(data = dt.stim.arg,
aes(x = Stimulation_time - tfreq.arg,
xend = Stimulation_time - tfreq.arg,
y = ylim.arg[1],
yend = ylim.arg[1] + abs(ylim.arg[2] - ylim.arg[1]) * stim.bar.height.arg),
aes_string(x = x.stim.arg[1],
xend = x.stim.arg[2],
y = y.stim.arg[1],
yend = y.stim.arg[2],
group = 'group'),
colour = rhg_cols[[3]],
size = stim.bar.width.arg,
group = 1)
size = stim.bar.width.arg)
}
if (!is.null(ylim.arg))
......@@ -338,14 +346,65 @@ myGgplotTraj = function(dt.arg, # data table
return(p.tmp)
}
# Plot average time series with CI together in one facet
LOCplotTrajRibbon = function(dt.arg, # input data table
x.arg, # string with column name for x-axis
y.arg, # string with column name for y-axis
group.arg = NULL, # string with column name for grouping time series (here, it's a column corresponding to grouping by condition)
col.arg = NULL, # colour pallette for individual time series
dt.stim.arg = NULL, # data table with stimulation pattern
x.stim.arg = c('tstart', 'tend'), # column names in stimulation dt with x and xend parameters
y.stim.arg = c('ystart', 'yend'), # column names in stimulation dt with y and yend parameters
stim.bar.width.arg = 0.5,
ribbon.lohi.arg = c('Lower', 'Upper'),
ribbon.fill.arg = 'grey50',
ribbon.alpha.arg = 0.5,
xlab.arg = NULL,
ylab.arg = NULL,
plotlab.arg = NULL) {
p.tmp = ggplot(dt.arg, aes_string(x = x.arg, group = group.arg)) +
geom_ribbon(aes_string(ymin = ribbon.lohi.arg[1], ymax = ribbon.lohi.arg[2]),
fill = ribbon.fill.arg,
alpha = ribbon.alpha.arg) +
geom_line(aes_string(y = y.arg, colour = group.arg))
# plot stimulation bars underneath time series
# dt.stim.arg is read separately and should contain 4 columns with
# xy positions of beginning and end of the bar
if(!is.null(dt.stim.arg)) {
p.tmp = p.tmp + geom_segment(data = dt.stim.arg,
aes_string(x = x.stim.arg[1],
xend = x.stim.arg[2],
y = y.stim.arg[1],
yend = y.stim.arg[2]),
colour = rhg_cols[[3]],
size = stim.bar.width.arg,
group = 1)
}
# Fast DTW computation
fastDTW <-function (x)
{
return(dtw(x, window.type = 'sakoechiba', distance.only = T)$normalizedDistance)
if (is.null(col.arg)) {
p.tmp = p.tmp +
scale_color_discrete(name = '')
} else {
p.tmp = p.tmp +
scale_colour_manual(values = col.arg, name = '')
}
if (!is.null(plotlab.arg))
p.tmp = p.tmp + ggtitle(plotlab.arg)
p.tmp = p.tmp +
xlab(xlab.arg) +
ylab(ylab.arg)
return(p.tmp)
}
# Plots a scatter plot with marginal histograms
# Points are connected by a line (grouping by cellID)
#
......
modules/tabClHier.R
View file @ 04739dba
......@@ -172,7 +172,7 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
}
# SERVER
clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, in.data4stimPlot) {
output$uiPlotHierClSel = renderUI({
ns <- session$ns
......@@ -337,6 +337,20 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
return(loc.dt)
})
data4stimPlotCl <- reactive({
cat(file = stderr(), 'data4stimPlotCl: in\n')
loc.dt = in.data4stimPlot()
if (is.null(loc.dt)) {
cat(file = stderr(), 'data4stimPlotCl: dt is NULL\n')
return(NULL)
}
cat(file = stderr(), 'data4stimPlotCl: dt not NULL\n')
return(loc.dt)
})
# download a list of cellIDs with cluster assignments
output$downCellCl <- downloadHandler(
filename = function() {
......@@ -495,19 +509,24 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
# Hierarchical - Heat Map - download pdf
callModule(downPlot, "downPlotHier", createFnameHeatMap, plotHier)
# plot individual trajectories withina cluster
callModule(modTrajPlot, 'modPlotHierTraj',
in.data = data4trajPlotCl,
in.data.stim = data4stimPlotCl,
in.facet = 'cl',
in.facet.color = getClColHier,
in.fname = createFnameTrajPlot)
# plot cluster means
callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon',
in.data = data4trajPlotCl,
in.data.stim = data4stimPlotCl,
in.facet = 'cl',
in.facet.color = getClColHier,
in.fname = createFnameRibbonPlot)
# plot distribution barplot
callModule(modClDistPlot, 'hierClDistPlot',
in.data = data4clDistPlot,
in.cols = getClColHier,
......
modules/tabClHierSpar.R
View file @ 04739dba
......@@ -184,7 +184,7 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
}
# SERVER
clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlot) {
clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlot, in.data4stimPlot) {
# UI for advanced options
output$uiPlotHierSparNperms = renderUI({
......@@ -391,6 +391,20 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
return(loc.dt)
})
data4stimPlotClSpar <- reactive({
cat(file = stderr(), 'data4stimPlotClSpar: in\n')
loc.dt = in.data4stimPlot()
if (is.null(loc.dt)) {
cat(file = stderr(), 'data4stimPlotClSpar: dt is NULL\n')
return(NULL)
}
cat(file = stderr(), 'data4stimPlotClSpar: dt not NULL\n')
return(loc.dt)
})
# download a list of cellIDs with cluster assignments
output$downCellClSpar <- downloadHandler(
......@@ -541,22 +555,23 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
# Sparse Hierarchical - Heat Map - download pdf
callModule(downPlot, "downPlotHierSparHM", createFnameHeatMap, plotHierSpar)
# plot individual trajectories withina cluster
callModule(modTrajPlot, 'modPlotHierSparTraj',
in.data = data4trajPlotClSpar,
in.data.stim = data4stimPlotClSpar,
in.facet = 'cl',
in.facet.color = getClColHierSpar,
in.fname = createFnameTrajPlot)
# plot cluster means
callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon',
in.data = data4trajPlotClSpar,
in.data.stim = data4stimPlotClSpar,
in.facet = 'cl',
in.facet.color = getClColHierSpar,
in.fname = createFnameRibbonPlot)
# plot distribution barplot
callModule(modClDistPlot, 'hierClSparDistPlot',
in.data = data4clSparDistPlot,
in.cols = getClColHierSpar,
......
modules/trajPlot.R
View file @ 04739dba
......@@ -69,6 +69,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
modTrajPlot = function(input, output, session,
in.data,
in.data.stim,
in.fname,
in.facet = 'group',
in.facet.color = NULL) {
......@@ -189,6 +190,7 @@ modTrajPlot = function(input, output, session,
return(NULL)
}
# check main data exists
loc.dt = isolate(in.data())
cat("plotTraj: on to plot\n\n")
......@@ -198,6 +200,17 @@ modTrajPlot = function(input, output, session,
}
cat(file = stderr(), 'plotTraj: dt not NULL\n')
# check if stim data exists
loc.dt.stim = isolate(in.data.stim())
if (is.null(loc.dt.stim)) {
cat(file = stderr(), 'plotTraj: dt.stim is NULL\n')
} else {
cat(file = stderr(), 'plotTraj: dt.stim not NULL\n')
}
# Future: change such that a column with colouring status is chosen by the user
......@@ -247,14 +260,17 @@ modTrajPlot = function(input, output, session,
}
p.out = myGgplotTraj(
p.out = LOCplotTraj(
dt.arg = loc.dt,
x.arg = 'realtime',
y.arg = 'y',
group.arg = "id",
facet.arg = in.facet,
facet.ncol.arg = input$inPlotTrajFacetNcol,
facet.color.arg = loc.facet.col,
facet.color.arg = loc.facet.col,
dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'),
xlab.arg = 'Time (min)',
line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL,
......
modules/trajRibbonPlot.R
View file @ 04739dba
......@@ -48,6 +48,7 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") {
modTrajRibbonPlot = function(input, output, session,
in.data,
in.data.stim,
in.facet = 'group',
in.facet.color = NULL,
in.fname) {
......@@ -107,24 +108,44 @@ modTrajRibbonPlot = function(input, output, session,
plotTraj, TRUE)
plotTraj <- function() {
cat(file = stderr(), 'plotTraj: in\n')
cat(file = stderr(), 'plotTrajRibbon: in\n')
locBut = input$butPlotTraj
if (locBut == 0) {
cat(file = stderr(), 'plotTraj: Go button not pressed\n')
cat(file = stderr(), 'plotTrajRibbon: Go button not pressed\n')
return(NULL)
}
# check if main data exists
loc.dt = isolate(in.data())
cat("plotTraj: on to plot\n\n")
cat("plotTrajRibbon: on to plot\n\n")
if (is.null(loc.dt)) {
cat(file = stderr(), 'plotTraj: dt is NULL\n')
cat(file = stderr(), 'plotTrajRibbon: dt is NULL\n')
return(NULL)
}
cat(file = stderr(), 'plotTraj: dt not NULL\n')
cat(file = stderr(), 'plotTrajRibbon: dt not NULL\n')
# check if stim data exists
loc.dt.stim = isolate(in.data.stim())
if (is.null(loc.dt.stim)) {
cat(file = stderr(), 'plotTrajRibbon: stim is NULL\n')
} else {
cat(file = stderr(), 'plotTrajRibbon: stim not NULL\n')
# choose only 1st group of stimulation pattern for ribbon plot
loc.groups = unique(loc.dt.stim[['group']])
if(length(loc.groups) > 1) {
cat(file = stderr(), 'plotTrajRibbon: more than 1 group in stim; choosing 1st\n')
loc.dt.stim = loc.dt.stim[group == loc.groups[1]]
}
}
# Future: change such that a column with colouring status is chosen by the user
......@@ -180,11 +201,14 @@ modTrajRibbonPlot = function(input, output, session,
loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]
p.out = tca::plotTrajRibbon(dt.arg = loc.dt.aggr,
p.out = LOCplotTrajRibbon(dt.arg = loc.dt.aggr,
x.arg = 'realtime',
y.arg = 'Mean',
col.arg = loc.facet.col,
group.arg = in.facet,
dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'),
xlab.arg = 'Time (min)',
ylab.arg = '') +
ggplotTheme() +
......
server.R
View file @ 04739dba
......@@ -37,8 +37,8 @@ shinyServer(function(input, output, session) {
# The value of inDataGen1,2 actionButton is the number of times they were pressed
dataGen1 = isolate(input$inDataGen1),
dataLoadNuc = isolate(input$inButLoadNuc),
dataLoadTrajRem = isolate(input$inButLoadTrajRem)
#dataLoadStim = isolate(input$inButLoadStim)
dataLoadTrajRem = isolate(input$inButLoadTrajRem),
dataLoadStim = isolate(input$inButLoadStim)
)
####
......@@ -78,7 +78,36 @@ shinyServer(function(input, output, session) {
# reset("inFileStimLoad") # reset is a shinyjs function
})
# load data with trajectories to remove
dataLoadTrajRem <- eventReactive(input$inButLoadTrajRem, {
cat(file = stderr(), "dataLoadTrajRem\n")
locFilePath = input$inFileLoadTrajRem$datapath
counter$dataLoadTrajRem <- input$inButLoadTrajRem - 1
if (is.null(locFilePath) || locFilePath == '')
return(NULL)
else {
return(fread(locFilePath))
}
})
# load data with stimulation pattern
dataLoadStim <- eventReactive(input$inButLoadStim, {
cat(file = stderr(), "dataLoadStim\n")
locFilePath = input$inFileLoadStim$datapath
counter$dataLoadStim <- input$inButLoadStim - 1
if (is.null(locFilePath) || locFilePath == '')
return(NULL)
else {
return(fread(locFilePath))
}
})
# UI for loading csv with cell IDs for trajectory removal
output$uiFileLoadTrajRem = renderUI({
cat(file = stderr(), 'UI uiFileLoadTrajRem\n')
......@@ -98,20 +127,26 @@ shinyServer(function(input, output, session) {
actionButton("inButLoadTrajRem", "Load Data")
})
# load main data file
dataLoadTrajRem <- eventReactive(input$inButLoadTrajRem, {
cat(file = stderr(), "dataLoadTrajRem\n")
locFilePath = input$inFileLoadTrajRem$datapath
# UI for loading csv with stimulation pattern
output$uiFileLoadStim = renderUI({
cat(file = stderr(), 'UI uiFileLoadStim\n')
counter$dataLoadTrajRem <- input$inButLoadTrajRem - 1
if(input$chBstim)
fileInput(
'inFileLoadStim',
'Select data file (e.g. stim.csv) and press "Load Data"',
accept = c('text/csv', 'text/comma-separated-values,text/plain')
)
})
output$uiButLoadStim = renderUI({
cat(file = stderr(), 'UI uiButLoadStim\n')
if (is.null(locFilePath) || locFilePath == '')
return(NULL)
else {
return(fread(locFilePath))
}
if(input$chBstim)
actionButton("inButLoadStim", "Load Data")
})
# COLUMN SELECTION
output$varSelTrackLabel = renderUI({
......@@ -739,6 +774,22 @@ shinyServer(function(input, output, session) {
})
# prepare data with stimulation pattern
# this dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment
data4stimPlot <- reactive({
cat(file = stderr(), 'data4stimPlot\n')
if (input$chBstim) {
cat(file = stderr(), 'data4stimPlot: stim not NULL\n')
loc.dt.stim = dataLoadStim()
return(loc.dt.stim)
} else {
cat(file = stderr(), 'data4stimPlot: stim is NULL\n')
return(NULL)
}
})
# download data as prepared for plotting
# after all modification
output$downloadDataClean <- downloadHandler(
......@@ -751,11 +802,13 @@ shinyServer(function(input, output, session) {
###### Trajectory plotting
callModule(modTrajRibbonPlot, 'modTrajRibbon',
in.data = data4trajPlot,
in.data.stim = data4stimPlot,
in.fname = function() return( "tCoursesMeans.pdf"))
###### Trajectory plotting
callModule(modTrajPlot, 'modTrajPlot',
in.data = data4trajPlot,
in.data.stim = data4stimPlot,
in.fname = function() {return( "tCourses.pdf")})
## UI for selecting trajectories
......@@ -789,10 +842,10 @@ shinyServer(function(input, output, session) {
callModule(tabScatterPlot, 'tabScatter', data4trajPlot, in.fname = function() return('scatter.pdf'))
##### Hierarchical clustering
callModule(clustHier, 'tabClHier', data4clust, data4trajPlot)
callModule(clustHier, 'tabClHier', data4clust, data4trajPlot, data4stimPlot)
##### Sparse hierarchical clustering using sparcl
callModule(clustHierSpar, 'tabClHierSpar', data4clust, data4trajPlot)
callModule(clustHierSpar, 'tabClHierSpar', data4clust, data4trajPlot, data4stimPlot)
})
ui.R
View file @ 04739dba
......@@ -41,6 +41,18 @@ shinyUI(fluidPage(
uiOutput('uiFileLoadTrajRem'),
uiOutput('uiButLoadTrajRem'),
tags$hr(),
checkboxInput('chBstim', 'Upload stimulation pattern'),
helpPopup(
title = 'Upload stimulations',
content = help.text[4],
placement = 'right',
trigger = 'hover'
),
uiOutput('uiFileLoadStim'),
uiOutput('uiButLoadStim'),
tags$hr(),
checkboxInput('chBtrajInter', 'Interpolate NAs and missing data?', value = T),
helpPopup(
......
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