Commit 1393d8a4 authored by dmattek's avatar dmattek
Browse files

Added: x-axis limits for plots

parent 93b1236d
...@@ -55,6 +55,7 @@ COLPOSX = 'pos.x' ...@@ -55,6 +55,7 @@ COLPOSX = 'pos.x'
COLPOSY = 'pos.y' COLPOSY = 'pos.y'
COLIDX = 'IDX' COLIDX = 'IDX'
COLIDXDIFF = 'IDXdiff' COLIDXDIFF = 'IDXdiff'
COLCL = 'cl'
# file names # file names
FCSVOUTLIERS = 'outliers.csv' FCSVOUTLIERS = 'outliers.csv'
...@@ -165,7 +166,8 @@ help.text.short = c( ...@@ -165,7 +166,8 @@ help.text.short = c(
'Select math operation to perform on a single or two columns,', 'Select math operation to perform on a single or two columns,',
'Select range of time for further processing.', 'Select range of time for further processing.',
'Normalise time series to a selected region.', 'Normalise time series to a selected region.',
'Download time series after modification in this section.' 'Download time series after modification in this section.',
'Long format: a row is a single data point. Wide format: a row contains entire time series with columns as time points.'
) )
# Functions for data processing ---- # Functions for data processing ----
...@@ -389,17 +391,18 @@ LOCnormTraj = function(in.dt, ...@@ -389,17 +391,18 @@ LOCnormTraj = function(in.dt,
getDataCl = function(in.dend, in.k) { getDataCl = function(in.dend, in.k) {
cat(file = stderr(), 'getDataCl \n') cat(file = stderr(), 'getDataCl \n')
loc.m = dendextend::cutree(in.dend, in.k, order_clusters_as_data = TRUE) loc.clAssign = dendextend::cutree(in.dend, in.k, order_clusters_as_data = TRUE, )
#print(loc.m) #print(loc.m)
# The result of cutree containes named vector with names being cell id's # The result of cutree containes named vector with names being cell id's
# THIS WON'T WORK with sparse hierarchical clustering because there, the dendrogram doesn't have original id's # THIS WON'T WORK with sparse hierarchical clustering because there, the dendrogram doesn't have original id's
loc.dt.cl = data.table(id = names(loc.m), loc.dt.clAssign = as.data.table(loc.clAssign, keep.rownames = T)
cl = loc.m) setnames(loc.dt.clAssign, c(COLID, COLCL))
#cat('===============\ndataCl:\n') #cat('===============\ndataCl:\n')
#print(loc.dt.cl) #print(loc.dt.cl)
return(loc.dt.cl) return(loc.dt.clAssign)
} }
...@@ -513,9 +516,10 @@ LOCplotTraj = function(dt.arg, # input data table ...@@ -513,9 +516,10 @@ LOCplotTraj = function(dt.arg, # input data table
dt.stim.arg = NULL, # plotting additional dataset; typically to indicate stimulations (not fully implemented yet, not tested!) 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 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 y.stim.arg = c('ystart', 'yend'), # column names in stimulation dt with y and yend parameters
tfreq.arg = 1, tfreq.arg = 1, # unused
ylim.arg = NULL, xlim.arg = NULL, # limits of x-axis; for visualisation only, not trimmimng data
stim.bar.width.arg = 0.5, ylim.arg = NULL, # limits of y-axis; for visualisation only, not trimmimng data
stim.bar.width.arg = 0.5, # width of the stimulation line; plotted under time series
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.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, aux.label2 = NULL,
aux.label3 = NULL, aux.label3 = NULL,
...@@ -571,7 +575,8 @@ LOCplotTraj = function(dt.arg, # input data table ...@@ -571,7 +575,8 @@ LOCplotTraj = function(dt.arg, # input data table
p.tmp = p.tmp + p.tmp = p.tmp +
stat_summary( stat_summary(
aes_string(y = y.arg, group = 1), aes_string(y = y.arg, group = 1),
fun.y = mean, fun.y = mean,
na.rm = T,
colour = 'red', colour = 'red',
linetype = 'solid', linetype = 'solid',
size = 1, size = 1,
...@@ -584,6 +589,7 @@ LOCplotTraj = function(dt.arg, # input data table ...@@ -584,6 +589,7 @@ LOCplotTraj = function(dt.arg, # input data table
stat_summary( stat_summary(
aes_string(y = y.arg, group = 1), aes_string(y = y.arg, group = 1),
fun.data = mean_cl_normal, fun.data = mean_cl_normal,
na.rm = T,
colour = 'red', colour = 'red',
alpha = 0.25, alpha = 0.25,
geom = "ribbon", geom = "ribbon",
...@@ -595,6 +601,7 @@ LOCplotTraj = function(dt.arg, # input data table ...@@ -595,6 +601,7 @@ LOCplotTraj = function(dt.arg, # input data table
stat_summary( stat_summary(
aes_string(y = y.arg, group = 1), aes_string(y = y.arg, group = 1),
fun.data = mean_se, fun.data = mean_se,
na.rm = T,
colour = 'red', colour = 'red',
alpha = 0.25, alpha = 0.25,
geom = "ribbon", geom = "ribbon",
...@@ -622,8 +629,7 @@ LOCplotTraj = function(dt.arg, # input data table ...@@ -622,8 +629,7 @@ LOCplotTraj = function(dt.arg, # input data table
size = stim.bar.width.arg) size = stim.bar.width.arg)
} }
if (!is.null(ylim.arg)) p.tmp = p.tmp + coord_cartesian(xlim = xlim.arg, ylim = ylim.arg)
p.tmp = p.tmp + coord_cartesian(ylim = ylim.arg)
p.tmp = p.tmp + p.tmp = p.tmp +
xlab(paste0(xlab.arg, "\n")) + xlab(paste0(xlab.arg, "\n")) +
...@@ -649,6 +655,8 @@ LOCplotTrajRibbon = function(dt.arg, # input data table ...@@ -649,6 +655,8 @@ LOCplotTrajRibbon = function(dt.arg, # input data table
x.stim.arg = c('tstart', 'tend'), # column names in stimulation dt with x and xend parameters 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 y.stim.arg = c('ystart', 'yend'), # column names in stimulation dt with y and yend parameters
stim.bar.width.arg = 0.5, stim.bar.width.arg = 0.5,
xlim.arg = NULL, # limits of x-axis; for visualisation only, not trimmimng data
ylim.arg = NULL, # limits of y-axis; for visualisation only, not trimmimng data
ribbon.lohi.arg = c('Lower', 'Upper'), ribbon.lohi.arg = c('Lower', 'Upper'),
ribbon.fill.arg = 'grey50', ribbon.fill.arg = 'grey50',
ribbon.alpha.arg = 0.5, ribbon.alpha.arg = 0.5,
...@@ -677,6 +685,7 @@ LOCplotTrajRibbon = function(dt.arg, # input data table ...@@ -677,6 +685,7 @@ LOCplotTrajRibbon = function(dt.arg, # input data table
group = 1) group = 1)
} }
p.tmp = p.tmp + coord_cartesian(xlim = xlim.arg, ylim = ylim.arg)
if (is.null(col.arg)) { if (is.null(col.arg)) {
p.tmp = p.tmp + p.tmp = p.tmp +
......
...@@ -90,7 +90,7 @@ modTrajPlot = function(input, output, session, ...@@ -90,7 +90,7 @@ modTrajPlot = function(input, output, session,
in.data, in.data,
in.data.stim, in.data.stim,
in.fname, in.fname,
in.facet = 'group', in.facet = COLGR,
in.facet.color = NULL) { in.facet.color = NULL) {
ns <- session$ns ns <- session$ns
...@@ -117,6 +117,11 @@ modTrajPlot = function(input, output, session, ...@@ -117,6 +117,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data() loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetXboundsLow: dt is NULL\n')
return(NULL)
}
numericInput( numericInput(
ns('inSetXboundsLow'), ns('inSetXboundsLow'),
label = 'Lower', label = 'Lower',
...@@ -134,6 +139,11 @@ modTrajPlot = function(input, output, session, ...@@ -134,6 +139,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data() loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetXboundsHigh: dt is NULL\n')
return(NULL)
}
numericInput( numericInput(
ns('inSetXboundsHigh'), ns('inSetXboundsHigh'),
label = 'Upper', label = 'Upper',
...@@ -152,6 +162,11 @@ modTrajPlot = function(input, output, session, ...@@ -152,6 +162,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data() loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetYboundsLow: dt is NULL\n')
return(NULL)
}
numericInput( numericInput(
ns('inSetYboundsLow'), ns('inSetYboundsLow'),
label = 'Lower', label = 'Lower',
...@@ -169,6 +184,11 @@ modTrajPlot = function(input, output, session, ...@@ -169,6 +184,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data() loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetYboundsHigh: dt is NULL\n')
return(NULL)
}
numericInput( numericInput(
ns('inSetYboundsHigh'), ns('inSetYboundsHigh'),
label = 'Upper', label = 'Upper',
...@@ -181,7 +201,8 @@ modTrajPlot = function(input, output, session, ...@@ -181,7 +201,8 @@ modTrajPlot = function(input, output, session,
# Plotting ==== # Plotting ====
callModule(modTrackStats, 'dispTrackStats', callModule(modTrackStats, 'dispTrackStats',
in.data = in.data) in.data = in.data,
in.bycols = in.facet)
output$outPlotTraj <- renderPlot({ output$outPlotTraj <- renderPlot({
...@@ -296,16 +317,16 @@ modTrajPlot = function(input, output, session, ...@@ -296,16 +317,16 @@ modTrajPlot = function(input, output, session,
} }
loc.ylim.arg = NULL
if(input$chBsetYbounds) {
loc.ylim.arg = c(input$inSetYboundsLow, input$inSetYboundsHigh)
}
loc.xlim.arg = NULL loc.xlim.arg = NULL
if(input$chBsetXbounds) { if(input$chBsetXbounds) {
loc.xlim.arg = c(input$inSetXboundsLow, input$inSetXboundsHigh) loc.xlim.arg = c(input$inSetXboundsLow, input$inSetXboundsHigh)
} }
loc.ylim.arg = NULL
if(input$chBsetYbounds) {
loc.ylim.arg = c(input$inSetYboundsLow, input$inSetYboundsHigh)
}
p.out = LOCplotTraj( p.out = LOCplotTraj(
dt.arg = loc.dt, dt.arg = loc.dt,
x.arg = 'realtime', x.arg = 'realtime',
......
...@@ -19,7 +19,25 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") { ...@@ -19,7 +19,25 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") {
), ),
column( column(
3, 3,
sliderInput(ns('sliPlotTrajSkip'), 'Plot every n-th point:', min = 1, max = 10, value = 1, step = 1) sliderInput(ns('sliPlotTrajSkip'), 'Plot every n-th point:', min = 1, max = 10, value = 1, step = 1),
checkboxInput(ns('chBsetXbounds'), 'Set bounds for x-axis', FALSE),
fluidRow(
column(6,
uiOutput(ns('uiSetXboundsLow'))
),
column(6,
uiOutput(ns('uiSetXboundsHigh'))
)),
checkboxInput(ns('chBsetYbounds'), 'Set bounds for y-axis', FALSE),
fluidRow(
column(6,
uiOutput(ns('uiSetYboundsLow'))
),
column(6,
uiOutput(ns('uiSetYboundsHigh'))
))
), ),
column( column(
2, 2,
...@@ -59,6 +77,98 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -59,6 +77,98 @@ modTrajRibbonPlot = function(input, output, session,
ns <- session$ns ns <- session$ns
# UI for bounding the x-axis ====
output$uiSetXboundsLow = renderUI({
ns <- session$ns
if(input$chBsetXbounds) {
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetXboundsLow: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetXboundsLow'),
label = 'Lower',
step = 0.1,
value = floor(min(loc.dt[[COLRT]], na.rm = T))
)
}
})
output$uiSetXboundsHigh = renderUI({
ns <- session$ns
if(input$chBsetXbounds) {
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetXboundsHigh: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetXboundsHigh'),
label = 'Upper',
step = 0.1,
value = ceil(max(loc.dt[[COLRT]], na.rm = T))
)
}
})
# UI for bounding the y-axis ====
output$uiSetYboundsLow = renderUI({
ns <- session$ns
if(input$chBsetYbounds) {
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetYboundsLow: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetYboundsLow'),
label = 'Lower',
step = 0.1,
value = floor(min(loc.dt[[COLY]], na.rm = T))
)
}
})
output$uiSetYboundsHigh = renderUI({
ns <- session$ns
if(input$chBsetYbounds) {
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetYboundsHigh: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetYboundsHigh'),
label = 'Upper',
step = 0.1,
value = ceil(max(loc.dt[[COLY]], na.rm = T))
)
}
})
# Plotting ====
output$uiPlotTraj = renderUI({ output$uiPlotTraj = renderUI({
if (input$chBplotTrajInt) if (input$chBplotTrajInt)
plotlyOutput( plotlyOutput(
...@@ -75,7 +185,8 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -75,7 +185,8 @@ modTrajRibbonPlot = function(input, output, session,
callModule(modTrackStats, 'dispTrackStats', callModule(modTrackStats, 'dispTrackStats',
in.data = in.data) in.data = in.data,
in.bycols = in.facet)
output$outPlotTraj <- renderPlot({ output$outPlotTraj <- renderPlot({
...@@ -204,6 +315,15 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -204,6 +315,15 @@ modTrajRibbonPlot = function(input, output, session,
in.type = 'normal') in.type = 'normal')
loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))] loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]
loc.xlim.arg = NULL
if(input$chBsetXbounds) {
loc.xlim.arg = c(input$inSetXboundsLow, input$inSetXboundsHigh)
}
loc.ylim.arg = NULL
if(input$chBsetYbounds) {
loc.ylim.arg = c(input$inSetYboundsLow, input$inSetYboundsHigh)
}
p.out = LOCplotTrajRibbon(dt.arg = loc.dt.aggr, p.out = LOCplotTrajRibbon(dt.arg = loc.dt.aggr,
x.arg = 'realtime', x.arg = 'realtime',
...@@ -213,6 +333,8 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -213,6 +333,8 @@ modTrajRibbonPlot = function(input, output, session,
dt.stim.arg = loc.dt.stim, dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'), x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'), y.stim.arg = c('ystart', 'yend'),
xlim.arg = loc.xlim.arg,
ylim.arg = loc.ylim.arg,
xlab.arg = 'Time', xlab.arg = 'Time',
ylab.arg = '') + ylab.arg = '') +
LOCggplotTheme(in.font.base = PLOTFONTBASE, LOCggplotTheme(in.font.base = PLOTFONTBASE,
......
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