Commit 1393d8a4 authored by dmattek's avatar dmattek

Added: x-axis limits for plots

parent 93b1236d
......@@ -55,6 +55,7 @@ COLPOSX = 'pos.x'
COLPOSY = 'pos.y'
COLIDX = 'IDX'
COLIDXDIFF = 'IDXdiff'
COLCL = 'cl'
# file names
FCSVOUTLIERS = 'outliers.csv'
......@@ -165,7 +166,8 @@ help.text.short = c(
'Select math operation to perform on a single or two columns,',
'Select range of time for further processing.',
'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 ----
......@@ -389,17 +391,18 @@ LOCnormTraj = function(in.dt,
getDataCl = function(in.dend, in.k) {
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)
# 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
loc.dt.cl = data.table(id = names(loc.m),
cl = loc.m)
loc.dt.clAssign = as.data.table(loc.clAssign, keep.rownames = T)
setnames(loc.dt.clAssign, c(COLID, COLCL))
#cat('===============\ndataCl:\n')
#print(loc.dt.cl)
return(loc.dt.cl)
return(loc.dt.clAssign)
}
......@@ -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!)
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.width.arg = 0.5,
tfreq.arg = 1, # unused
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
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.label2 = NULL,
aux.label3 = NULL,
......@@ -571,7 +575,8 @@ LOCplotTraj = function(dt.arg, # input data table
p.tmp = p.tmp +
stat_summary(
aes_string(y = y.arg, group = 1),
fun.y = mean,
fun.y = mean,
na.rm = T,
colour = 'red',
linetype = 'solid',
size = 1,
......@@ -584,6 +589,7 @@ LOCplotTraj = function(dt.arg, # input data table
stat_summary(
aes_string(y = y.arg, group = 1),
fun.data = mean_cl_normal,
na.rm = T,
colour = 'red',
alpha = 0.25,
geom = "ribbon",
......@@ -595,6 +601,7 @@ LOCplotTraj = function(dt.arg, # input data table
stat_summary(
aes_string(y = y.arg, group = 1),
fun.data = mean_se,
na.rm = T,
colour = 'red',
alpha = 0.25,
geom = "ribbon",
......@@ -622,8 +629,7 @@ LOCplotTraj = function(dt.arg, # input data table
size = stim.bar.width.arg)
}
if (!is.null(ylim.arg))
p.tmp = p.tmp + coord_cartesian(ylim = ylim.arg)
p.tmp = p.tmp + coord_cartesian(xlim = xlim.arg, ylim = ylim.arg)
p.tmp = p.tmp +
xlab(paste0(xlab.arg, "\n")) +
......@@ -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
y.stim.arg = c('ystart', 'yend'), # column names in stimulation dt with y and yend parameters
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.fill.arg = 'grey50',
ribbon.alpha.arg = 0.5,
......@@ -677,6 +685,7 @@ LOCplotTrajRibbon = function(dt.arg, # input data table
group = 1)
}
p.tmp = p.tmp + coord_cartesian(xlim = xlim.arg, ylim = ylim.arg)
if (is.null(col.arg)) {
p.tmp = p.tmp +
......
......@@ -90,7 +90,7 @@ modTrajPlot = function(input, output, session,
in.data,
in.data.stim,
in.fname,
in.facet = 'group',
in.facet = COLGR,
in.facet.color = NULL) {
ns <- session$ns
......@@ -117,6 +117,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetXboundsLow: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetXboundsLow'),
label = 'Lower',
......@@ -134,6 +139,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetXboundsHigh: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetXboundsHigh'),
label = 'Upper',
......@@ -152,6 +162,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetYboundsLow: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetYboundsLow'),
label = 'Lower',
......@@ -169,6 +184,11 @@ modTrajPlot = function(input, output, session,
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'uiSetYboundsHigh: dt is NULL\n')
return(NULL)
}
numericInput(
ns('inSetYboundsHigh'),
label = 'Upper',
......@@ -181,7 +201,8 @@ modTrajPlot = function(input, output, session,
# Plotting ====
callModule(modTrackStats, 'dispTrackStats',
in.data = in.data)
in.data = in.data,
in.bycols = in.facet)
output$outPlotTraj <- renderPlot({
......@@ -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
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 = LOCplotTraj(
dt.arg = loc.dt,
x.arg = 'realtime',
......
......@@ -19,7 +19,25 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") {
),
column(
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(
2,
......@@ -59,6 +77,98 @@ modTrajRibbonPlot = function(input, output, session,
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({
if (input$chBplotTrajInt)
plotlyOutput(
......@@ -75,7 +185,8 @@ modTrajRibbonPlot = function(input, output, session,
callModule(modTrackStats, 'dispTrackStats',
in.data = in.data)
in.data = in.data,
in.bycols = in.facet)
output$outPlotTraj <- renderPlot({
......@@ -204,6 +315,15 @@ modTrajRibbonPlot = function(input, output, session,
in.type = 'normal')
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,
x.arg = 'realtime',
......@@ -213,6 +333,8 @@ modTrajRibbonPlot = function(input, output, session,
dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'),
xlim.arg = loc.xlim.arg,
ylim.arg = loc.ylim.arg,
xlab.arg = 'Time',
ylab.arg = '') +
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