In order to mitigate against the brute force attacks against Gitlab accounts, we are moving to all edu-ID Logins. We would like to remind you to link your account with your edu-id. Login will be possible only by edu-ID after November 30, 2021. Here you can find the instructions for linking your account.

If you don't have a SWITCH edu-ID, you can create one with this guide here

kind regards

This Server has been upgraded to GitLab release 14.2.6

Commit 082b907a authored by dmattek's avatar dmattek
Browse files

Bug fixes

parent c167348d
......@@ -7,10 +7,11 @@ source('modules/dispTrackStats.R')
source('modules/trajPlot.R')
source('modules/trajRibbonPlot.R')
source('modules/trajPsdPlot.R')
source('modules/boxPlot.R')
source('modules/tabAUC.R')
source('modules/aucPlot.R')
source('modules/distPlot.R')
source('modules/clDistPlot.R')
source('modules/tabScatter.R')
source('modules/tabBoxPlot.R')
source('modules/tabDist.R')
source('modules/tabAUC.R')
source('modules/tabClHier.R')
source('modules/tabClHierSpar.R')
\ No newline at end of file
......@@ -2,7 +2,7 @@
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for plotting a choice of box/violin/dot-plots
# This module is for plotting AUC as a choice of box/violin/dot-plots
# Assumes in.data contains columns:
# realtime
# y
......@@ -10,44 +10,46 @@
# id
# UI ----
modBoxPlotUI = function(id, label = "Plot Box-plots") {
modAUCplotUI = function(id, label = "Plot AUC distributions") {
ns <- NS(id)
tagList(
fluidRow(
column(
4,
checkboxGroupInput(ns('inPlotType'), 'Plot type:', list('Dot-plot' = 'dot',
'Violin-plot' = 'viol',
'Box-plot' = 'box',
'Line-plot' = 'line'), selected = 'box'),
checkboxInput(ns('chBPlotBoxInt'), 'Interactive Plot'),
actionButton(ns('butPlotBox'), 'Plot!')
checkboxInput(ns("chBPlotTypeBox"), "Box-plot", value = T),
checkboxInput(ns("chBPlotTypeDot"), "Dot-plot", value = F),
checkboxInput(ns("chBPlotTypeViol"), "Violin-plot", value = F),
checkboxInput(ns('chBPlotInt'), 'Interactive Plot'),
actionButton(ns('butPlot'), 'Plot!')
),
column(
4,
uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotDotNbins')),
uiOutput(ns('uiPlotDotShade'))
),
column(
4,
selectInput(
ns('selPlotBoxLegendPos'),
ns('selPlotLegendPos'),
label = 'Legend position',
choices = list(
"Top" = 'top',
"Right" = 'right',
"Bottom" = 'bottom'
),
),
width = "120px",
selected = 'top'
),
uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotBoxDodge')),
#uiOutput(ns('uiPlotBoxWidth')),
uiOutput(ns('uiPlotBoxAlpha')),
uiOutput(ns('uiPlotDotNbins'))
),
column(
4,
radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels",
c("horizontal" = 0,
"45 deg" = 45,
"90 deg" = 90)),
numericInput(
ns('inPlotBoxWidth'),
'Width [%]:',
'Width [%]',
value = PLOTWIDTH,
min = 10,
width = '100px',
......@@ -55,16 +57,12 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
),
numericInput(
ns('inPlotBoxHeight'),
'Height [px]:',
'Height [px]',
value = PLOTBOXHEIGHT,
min = 100,
width = '100px',
step = 50
),
radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels:",
c("horizontal" = 0,
"45 deg" = 45,
"90 deg" = 90))
)
)
),
......@@ -74,76 +72,63 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
}
# SERVER ----
modBoxPlot = function(input, output, session,
in.data,
in.cols = list(meas.x = COLRT,
modAUCplot = function(input, output, session,
in.data, # input data table in long format
in.cols = list(meas.x = COLRT, # column names
meas.y = COLY,
group = COLGR,
id = COLID),
in.fname) {
in.labels = list(x = "", # plot labels
y = "",
legend = ""),
in.fname) { # file name for saving the plot
ns <- session$ns
# optional UI depending on the type of the plot chosen
output$uiPlotBoxNotches = renderUI({
cat(file = stderr(), 'UI uiPlotBoxNotches\n')
cat(file = stderr(), 'aucPlot:uiPlotBoxNotches\n')
ns <- session$ns
if('box' %in% input$inPlotType)
checkboxInput(ns('inPlotBoxNotches'), 'Box plot notches', FALSE)
if(input$chBPlotTypeBox)
checkboxInput(ns('chBplotBoxNotches'), 'Notches in box-plot', FALSE)
})
output$uiPlotBoxOutliers = renderUI({
cat(file = stderr(), 'UI uiPlotBoxNotches\n')
cat(file = stderr(), 'aucPlot:uiPlotBoxNotches\n')
ns <- session$ns
if('box' %in% input$inPlotType)
checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers', FALSE)
if(input$chBPlotTypeBox)
checkboxInput(ns('chBplotBoxOutliers'), 'Outliers in box-plot', FALSE)
})
output$uiPlotBoxDodge = renderUI({
cat(file = stderr(), 'UI uiPlotBoxDodge\n')
ns <- session$ns
if(!( 'line' %in% input$inPlotType ))
sliderInput(ns('inPlotBoxDodge'), 'Space between groups:', min = 0, max = 1, value = .4, step = 0.05)
})
output$uiPlotBoxWidth = renderUI({
cat(file = stderr(), 'UI uiPlotBoxWidth\n')
output$uiPlotDotShade = renderUI({
cat(file = stderr(), 'aucPlot:uiPlotDotShade\n')
ns <- session$ns
if('box' %in% input$inPlotType)
sliderInput(ns('inPlotBoxWidth'), 'Box plot width:', min = 0, max = 1, value = .2, step = 0.1)
})
output$uiPlotBoxAlpha = renderUI({
cat(file = stderr(), 'UI uiPlotBoxAlpha\n')
ns <- session$ns
if('box' %in% input$inPlotType)
sliderInput(ns('inPlotBoxAlpha'), 'Box plot transparency:', min = 0, max = 1, value = 1, step = 0.05)
if(input$chBPlotTypeDot)
sliderInput(ns('slPlotDotShade'), "Shade of grey in dot-plot", min = 0, max = 1, value = 0.5, step = 0.1)
})
output$uiPlotDotNbins = renderUI({
cat(file = stderr(), 'UI uiPlotDotNbins\n')
cat(file = stderr(), 'aucPlot:uiPlotDotNbins\n')
ns <- session$ns
if('dot' %in% input$inPlotType)
sliderInput(ns('inPlotDotNbins'), '#Bins for dot-plot:', min = 2, max = 50, value = 30, step = 1)
if(input$chBPlotTypeDot)
sliderInput(ns('slPlotDotNbins'), 'Number of bins in dot-plot', min = 2, max = 50, value = 30, step = 1)
})
# Boxplot - display
output$outPlotBox = renderPlot({
locBut = input$butPlotBox
locBut = input$butPlot
if (locBut == 0) {
cat(file = stderr(), 'plotBox: Go button not pressed\n')
cat(file = stderr(), 'aucPlot:Go button not pressed\n')
return(NULL)
}
......@@ -153,10 +138,10 @@ modBoxPlot = function(input, output, session,
output$outPlotBoxInt = renderPlotly({
locBut = input$butPlotBox
locBut = input$butPlot
if (locBut == 0) {
cat(file = stderr(), 'plotBox: Go button not pressed\n')
cat(file = stderr(), 'aucPlot:Go button not pressed\n')
return(NULL)
}
......@@ -175,7 +160,7 @@ modBoxPlot = function(input, output, session,
output$uiPlotBox <- renderUI({
ns <- session$ns
if (input$chBPlotBoxInt)
if (input$chBPlotInt)
plotlyOutput(ns("outPlotBoxInt"),
width = paste0(input$inPlotBoxWidth, '%'),
height = paste0(input$inPlotBoxHeight, 'px'))
......@@ -193,7 +178,7 @@ modBoxPlot = function(input, output, session,
# This function is used to plot and to downoad a pdf
plotBox <- function() {
cat(file = stderr(), 'plotBox\n')
cat(file = stderr(), 'aucPlot:plotBox\n')
loc.dt = in.data()
......@@ -205,54 +190,56 @@ modBoxPlot = function(input, output, session,
cat(file = stderr(), 'plotBox:dt not NULL\n')
loc.par.dodge <- position_dodge(width = input$inPlotBoxDodge)
p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x), y = in.cols$meas.y))
p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x),
y = in.cols$meas.y))
if('dot' %in% input$inPlotType)
p.out = p.out + geom_dotplot(aes_string(fill = in.cols[[COLGR]]),
if(input$chBPlotTypeDot) {
# calculate bin width for dot-plot based on nBins provided in the UI
loc.binwidth = abs(max(loc.dt[[ in.cols$meas.y ]],
na.rm = T) -
min(loc.dt[[ in.cols$meas.y ]],
na.rm = T)) / (input$slPlotDotNbins - 1)
p.out = p.out + geom_dotplot(fill = grey(input$slPlotDotShade),
color = NA,
binaxis = in.cols$meas.y,
binaxis = "y",
stackdir = "center",
position = loc.par.dodge,
binwidth = abs(max(loc.dt[[ in.cols$meas.y ]], na.rm = T) - min(loc.dt[[ in.cols$meas.y ]], na.rm = T)) / (input$inPlotDotNbins - 1),
binwidth = loc.binwidth,
method = 'histodot')
}
if('viol' %in% input$inPlotType)
p.out = p.out + geom_violin(aes_string(fill = in.cols[[COLGR]]),
position = loc.par.dodge,
width = 0.2)
if('line' %in% input$inPlotType)
if(input$chBPlotTypeViol)
p.out = p.out +
geom_path(aes_string(color = in.cols[[COLGR]], group = in.cols[[COLID]])) +
facet_wrap(as.formula(paste("~", in.cols[[COLGR]])))
geom_violin(fill = NA,
color = "black",
width = 0.2)
if ('box' %in% input$inPlotType)
if (input$chBPlotTypeBox)
p.out = p.out + geom_boxplot(
aes_string(fill = in.cols[[COLGR]]),
position = loc.par.dodge,
#width = 0.2, #input$inPlotBoxWidth,
notch = input$inPlotBoxNotches,
alpha = input$inPlotBoxAlpha,
outlier.colour = if (input$inPlotBoxOutliers)
fill = NA,
color = "black",
notch = input$chBplotBoxNotches,
outlier.colour = if (input$chBplotBoxOutliers)
'red'
else
NA
)
p.out = p.out +
scale_fill_discrete(name = '') +
xlab('') +
ylab('') +
scale_fill_discrete(name = in.labels$legend) +
xlab(in.labels$x) +
ylab(in.labels$y) +
LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT,
in.font.axis.title = PLOTFONTAXISTITLE,
in.font.strip = PLOTFONTFACETSTRIP,
in.font.legend = PLOTFONTLEGEND) +
theme(legend.position = input$selPlotBoxLegendPos,
theme(legend.position = input$selPlotLegendPos,
axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate),
size = PLOTFONTAXISTEXT))
return(p.out)
}
......
......@@ -129,16 +129,16 @@ l.col.pal.dend.2 = list(
# Clustering algorithms ----
s.cl.linkage = c("average",
"complete",
s.cl.linkage = c("complete",
"average",
"single",
"centroid",
"ward.D",
"ward.D2",
"mcquitty")
s.cl.spar.linkage = c("average",
"complete",
s.cl.spar.linkage = c("complete",
"average",
"single",
"centroid")
......@@ -191,10 +191,9 @@ help.text.short = c(
'Normalise with respect to this time span.', #12
'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.', #13
'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.', #14
'Instead of the value at a selected time point, y-axis can display a difference between values at time points on y- and x-axis.',#15
'Instead of the value at a selected time point, y-axis can display a difference between values at two selected time points.', #15
'Add a line with linear regression and regions of 95% confidence interval.', #16
'A number of time points left & right of selected time points; use the mean/min/max of values from these time points for the scatterplot.', #17
'Operations to perform on values at time points selected in the field above.' #18
'A number of time points left & right of selected time points; use the mean of values from these time points for the scatterplot.' #17
)
# Functions for data processing ----
......@@ -809,7 +808,7 @@ LOCggplotScat = function(dt.arg,
trend.arg = T,
ci.arg = 0.95) {
p.tmp = ggplot(dt.arg, aes(x = x, y = y)) +
p.tmp = ggplot(dt.arg, aes(x = x, y = y, label = id)) +
geom_point(alpha = alpha.arg)
if (trend.arg) {
......
......@@ -65,7 +65,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
p.out = p.out +
scale_y_continuous(labels = percent) +
ylab("Percentage of time-series\n") +
ylab("Percentage of time series\n") +
xlab("Groups") +
LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT,
......
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for plotting distrubutions at selected time points as a choice of box/violin/dot-plots
# Assumes in.data contains columns:
# realtime
# y
# group
# id
# UI ----
modDistPlotUI = function(id, label = "Plot distributions") {
ns <- NS(id)
tagList(
fluidRow(
column(
4,
checkboxInput(ns("chBplotTypeBox"), "Box-plot", value = T),
checkboxInput(ns("chBplotTypeDot"), "Dot-plot", value = F),
checkboxInput(ns("chBplotTypeViol"), "Violin-plot", value = F),
checkboxInput(ns("chBplotTypeLine"), "Line-plot", value = F),
checkboxInput(ns('chBplotInt'), 'Interactive Plot'),
actionButton(ns('butPlot'), 'Plot!')
),
column(
4,
uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotBoxDodge')),
uiOutput(ns('uiPlotBoxAlpha')),
uiOutput(ns('uiPlotDotNbins')),
uiOutput(ns('uiPlotDotAlpha')),
uiOutput(ns('uiPlotViolAlpha')),
uiOutput(ns('uiPlotLineAlpha'))
),
column(
4,
selectInput(
ns('selPlotBoxLegendPos'),
label = 'Legend position',
choices = list(
"Top" = 'top',
"Right" = 'right',
"Bottom" = 'bottom'
),
width = "120px",
selected = 'top'
),
radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels",
c("horizontal" = 0,
"45 deg" = 45,
"90 deg" = 90)),
numericInput(
ns('inPlotBoxWidth'),
'Width [%]',
value = PLOTWIDTH,
min = 10,
width = '100px',
step = 10
),
numericInput(
ns('inPlotBoxHeight'),
'Height [px]',
value = PLOTBOXHEIGHT,
min = 100,
width = '100px',
step = 50
)
)
),
uiOutput(ns('uiPlotBox')),
downPlotUI(ns('downPlotBox'), "Download PDF")
)
}
# SERVER ----
modDistPlot = function(input, output, session,
in.data, # input data table in long format
in.cols = list(meas.x = COLRT, # column names
meas.y = COLY,
group = COLGR,
id = COLID),
in.labels = list(x = "", # plot labels
y = "",
legend = ""),
in.fname) { # file name for saving the plot
ns <- session$ns
output$uiPlotBoxNotches = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxNotches\n')
ns <- session$ns
if(input$chBplotTypeBox)
checkboxInput(ns('chBplotBoxNotches'), 'Notches in box-plot ', FALSE)
})
output$uiPlotBoxOutliers = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxOutliers\n')
ns <- session$ns
if(input$chBplotTypeBox)
checkboxInput(ns('chBplotBoxOutliers'), 'Outliers in box-plot', FALSE)
})
output$uiPlotBoxDodge = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxDodge\n')
ns <- session$ns
# Adjust spacing between box-, violin-, dot-plots.
# Valid only when plotting multiple groups at a time point.
# For line plot, each group is drawn separately per facet, thus no need for dodging..
if(!input$chBplotTypeLine)
sliderInput(ns('slPlotBoxDodge'), 'Space between groups', min = 0, max = 1, value = .4, step = 0.05)
})
output$uiPlotBoxAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxAlpha\n')
ns <- session$ns
if(input$chBplotTypeBox)
sliderInput(ns('slPlotBoxAlpha'), 'Box-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotViolAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotViolAlpha\n')
ns <- session$ns
if(input$chBplotTypeViol)
sliderInput(ns('slPlotViolAlpha'), 'Violin-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotDotAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotDotAlpha\n')
ns <- session$ns
if(input$chBplotTypeDot)
sliderInput(ns('slPlotDotAlpha'), 'Dot-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotLineAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotLineAlpha\n')
ns <- session$ns
if(input$chBplotTypeLine)
sliderInput(ns('slPlotLineAlpha'), 'Line-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotDotNbins = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotDotNbins\n')
ns <- session$ns
if(input$chBplotTypeDot)
sliderInput(ns('slPlotDotNbins'), 'Number of bins in dot-plot', min = 2, max = 50, value = 30, step = 1)
})
# Boxplot - display
output$outPlotBox = renderPlot({
locBut = input$butPlot
if (locBut == 0) {
cat(file = stderr(), 'boxPlot:Go button not pressed\n')
return(NULL)
}
plotBox()
})
output$outPlotBoxInt = renderPlotly({
locBut = input$butPlot
if (locBut == 0) {
cat(file = stderr(), 'boxPlot:Go button not pressed\n')
return(NULL)
}
# This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
# https://github.com/ropensci/plotly/issues/494
if (names(dev.cur()) != "null device") dev.off()
pdf(NULL)
return( ggplotly(plotBox()) %>% layout(boxmode = 'group', width = '100%', height = '100%'))
})
output$uiPlotBox <- renderUI({
ns <- session$ns
if (input$chBplotInt)
plotlyOutput(ns("outPlotBoxInt"),
width = paste0(input$inPlotBoxWidth, '%'),
height = paste0(input$inPlotBoxHeight, 'px'))
else
plotOutput(ns('outPlotBox'),
width = paste0(input$inPlotBoxWidth, '%'),
height = paste0(input$inPlotBoxHeight, 'px'))
})
# Boxplot - download pdf
callModule(downPlot, "downPlotBox", in.fname, plotBox, TRUE)