Commit 082b907a authored by dmattek's avatar dmattek

Bug fixes

parent c167348d
...@@ -7,10 +7,11 @@ source('modules/dispTrackStats.R') ...@@ -7,10 +7,11 @@ source('modules/dispTrackStats.R')
source('modules/trajPlot.R') source('modules/trajPlot.R')
source('modules/trajRibbonPlot.R') source('modules/trajRibbonPlot.R')
source('modules/trajPsdPlot.R') source('modules/trajPsdPlot.R')
source('modules/boxPlot.R') source('modules/aucPlot.R')
source('modules/tabAUC.R') source('modules/distPlot.R')
source('modules/clDistPlot.R') source('modules/clDistPlot.R')
source('modules/tabScatter.R') source('modules/tabScatter.R')
source('modules/tabBoxPlot.R') source('modules/tabDist.R')
source('modules/tabAUC.R')
source('modules/tabClHier.R') source('modules/tabClHier.R')
source('modules/tabClHierSpar.R') source('modules/tabClHierSpar.R')
\ No newline at end of file
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
# Time Course Inspector: Shiny app for plotting time series data # Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski # 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: # Assumes in.data contains columns:
# realtime # realtime
# y # y
...@@ -10,44 +10,46 @@ ...@@ -10,44 +10,46 @@
# id # id
# UI ---- # UI ----
modBoxPlotUI = function(id, label = "Plot Box-plots") { modAUCplotUI = function(id, label = "Plot AUC distributions") {
ns <- NS(id) ns <- NS(id)
tagList( tagList(
fluidRow( fluidRow(
column( column(
4, 4,
checkboxGroupInput(ns('inPlotType'), 'Plot type:', list('Dot-plot' = 'dot', checkboxInput(ns("chBPlotTypeBox"), "Box-plot", value = T),
'Violin-plot' = 'viol', checkboxInput(ns("chBPlotTypeDot"), "Dot-plot", value = F),
'Box-plot' = 'box', checkboxInput(ns("chBPlotTypeViol"), "Violin-plot", value = F),
'Line-plot' = 'line'), selected = 'box'), checkboxInput(ns('chBPlotInt'), 'Interactive Plot'),
checkboxInput(ns('chBPlotBoxInt'), 'Interactive Plot'), actionButton(ns('butPlot'), 'Plot!')
actionButton(ns('butPlotBox'), 'Plot!') ),
column(
4,
uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotDotNbins')),
uiOutput(ns('uiPlotDotShade'))
), ),
column( column(
4, 4,
selectInput( selectInput(
ns('selPlotBoxLegendPos'), ns('selPlotLegendPos'),
label = 'Legend position', label = 'Legend position',
choices = list( choices = list(
"Top" = 'top', "Top" = 'top',
"Right" = 'right', "Right" = 'right',
"Bottom" = 'bottom' "Bottom" = 'bottom'
), ),
width = "120px",
selected = 'top' selected = 'top'
), ),
uiOutput(ns('uiPlotBoxNotches')), radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels",
uiOutput(ns('uiPlotBoxOutliers')), c("horizontal" = 0,
uiOutput(ns('uiPlotBoxDodge')), "45 deg" = 45,
#uiOutput(ns('uiPlotBoxWidth')), "90 deg" = 90)),
uiOutput(ns('uiPlotBoxAlpha')),
uiOutput(ns('uiPlotDotNbins'))
),
column(
4,
numericInput( numericInput(
ns('inPlotBoxWidth'), ns('inPlotBoxWidth'),
'Width [%]:', 'Width [%]',
value = PLOTWIDTH, value = PLOTWIDTH,
min = 10, min = 10,
width = '100px', width = '100px',
...@@ -55,16 +57,12 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") { ...@@ -55,16 +57,12 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
), ),
numericInput( numericInput(
ns('inPlotBoxHeight'), ns('inPlotBoxHeight'),
'Height [px]:', 'Height [px]',
value = PLOTBOXHEIGHT, value = PLOTBOXHEIGHT,
min = 100, min = 100,
width = '100px', width = '100px',
step = 50 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") { ...@@ -74,76 +72,63 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
} }
# SERVER ---- # SERVER ----
modBoxPlot = function(input, output, session, modAUCplot = function(input, output, session,
in.data, in.data, # input data table in long format
in.cols = list(meas.x = COLRT, in.cols = list(meas.x = COLRT, # column names
meas.y = COLY, meas.y = COLY,
group = COLGR, group = COLGR,
id = COLID), id = COLID),
in.fname) { in.labels = list(x = "", # plot labels
y = "",
legend = ""),
in.fname) { # file name for saving the plot
ns <- session$ns ns <- session$ns
# optional UI depending on the type of the plot chosen
output$uiPlotBoxNotches = renderUI({ output$uiPlotBoxNotches = renderUI({
cat(file = stderr(), 'UI uiPlotBoxNotches\n') cat(file = stderr(), 'aucPlot:uiPlotBoxNotches\n')
ns <- session$ns ns <- session$ns
if('box' %in% input$inPlotType) if(input$chBPlotTypeBox)
checkboxInput(ns('inPlotBoxNotches'), 'Box plot notches', FALSE) checkboxInput(ns('chBplotBoxNotches'), 'Notches in box-plot', FALSE)
}) })
output$uiPlotBoxOutliers = renderUI({ output$uiPlotBoxOutliers = renderUI({
cat(file = stderr(), 'UI uiPlotBoxNotches\n') cat(file = stderr(), 'aucPlot:uiPlotBoxNotches\n')
ns <- session$ns ns <- session$ns
if('box' %in% input$inPlotType) if(input$chBPlotTypeBox)
checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers', FALSE) 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({ output$uiPlotDotShade = renderUI({
cat(file = stderr(), 'UI uiPlotBoxWidth\n') cat(file = stderr(), 'aucPlot:uiPlotDotShade\n')
ns <- session$ns ns <- session$ns
if('box' %in% input$inPlotType) if(input$chBPlotTypeDot)
sliderInput(ns('inPlotBoxWidth'), 'Box plot width:', min = 0, max = 1, value = .2, step = 0.1) sliderInput(ns('slPlotDotShade'), "Shade of grey in dot-plot", min = 0, max = 1, value = 0.5, 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)
}) })
output$uiPlotDotNbins = renderUI({ output$uiPlotDotNbins = renderUI({
cat(file = stderr(), 'UI uiPlotDotNbins\n') cat(file = stderr(), 'aucPlot:uiPlotDotNbins\n')
ns <- session$ns ns <- session$ns
if('dot' %in% input$inPlotType) if(input$chBPlotTypeDot)
sliderInput(ns('inPlotDotNbins'), '#Bins for dot-plot:', min = 2, max = 50, value = 30, step = 1) sliderInput(ns('slPlotDotNbins'), 'Number of bins in dot-plot', min = 2, max = 50, value = 30, step = 1)
}) })
# Boxplot - display # Boxplot - display
output$outPlotBox = renderPlot({ output$outPlotBox = renderPlot({
locBut = input$butPlotBox locBut = input$butPlot
if (locBut == 0) { if (locBut == 0) {
cat(file = stderr(), 'plotBox: Go button not pressed\n') cat(file = stderr(), 'aucPlot:Go button not pressed\n')
return(NULL) return(NULL)
} }
...@@ -153,10 +138,10 @@ modBoxPlot = function(input, output, session, ...@@ -153,10 +138,10 @@ modBoxPlot = function(input, output, session,
output$outPlotBoxInt = renderPlotly({ output$outPlotBoxInt = renderPlotly({
locBut = input$butPlotBox locBut = input$butPlot
if (locBut == 0) { if (locBut == 0) {
cat(file = stderr(), 'plotBox: Go button not pressed\n') cat(file = stderr(), 'aucPlot:Go button not pressed\n')
return(NULL) return(NULL)
} }
...@@ -175,7 +160,7 @@ modBoxPlot = function(input, output, session, ...@@ -175,7 +160,7 @@ modBoxPlot = function(input, output, session,
output$uiPlotBox <- renderUI({ output$uiPlotBox <- renderUI({
ns <- session$ns ns <- session$ns
if (input$chBPlotBoxInt) if (input$chBPlotInt)
plotlyOutput(ns("outPlotBoxInt"), plotlyOutput(ns("outPlotBoxInt"),
width = paste0(input$inPlotBoxWidth, '%'), width = paste0(input$inPlotBoxWidth, '%'),
height = paste0(input$inPlotBoxHeight, 'px')) height = paste0(input$inPlotBoxHeight, 'px'))
...@@ -193,7 +178,7 @@ modBoxPlot = function(input, output, session, ...@@ -193,7 +178,7 @@ modBoxPlot = function(input, output, session,
# This function is used to plot and to downoad a pdf # This function is used to plot and to downoad a pdf
plotBox <- function() { plotBox <- function() {
cat(file = stderr(), 'plotBox\n') cat(file = stderr(), 'aucPlot:plotBox\n')
loc.dt = in.data() loc.dt = in.data()
...@@ -205,54 +190,56 @@ modBoxPlot = function(input, output, session, ...@@ -205,54 +190,56 @@ modBoxPlot = function(input, output, session,
cat(file = stderr(), 'plotBox:dt not NULL\n') 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),
p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x), y = in.cols$meas.y)) 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, color = NA,
binaxis = in.cols$meas.y, binaxis = "y",
stackdir = "center", stackdir = "center",
position = loc.par.dodge, binwidth = loc.binwidth,
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),
method = 'histodot') method = 'histodot')
}
if('viol' %in% input$inPlotType) if(input$chBPlotTypeViol)
p.out = p.out + geom_violin(aes_string(fill = in.cols[[COLGR]]),
position = loc.par.dodge,
width = 0.2)
if('line' %in% input$inPlotType)
p.out = p.out + p.out = p.out +
geom_path(aes_string(color = in.cols[[COLGR]], group = in.cols[[COLID]])) + geom_violin(fill = NA,
facet_wrap(as.formula(paste("~", in.cols[[COLGR]]))) color = "black",
width = 0.2)
if ('box' %in% input$inPlotType) if (input$chBPlotTypeBox)
p.out = p.out + geom_boxplot( p.out = p.out + geom_boxplot(
aes_string(fill = in.cols[[COLGR]]), fill = NA,
position = loc.par.dodge, color = "black",
#width = 0.2, #input$inPlotBoxWidth, notch = input$chBplotBoxNotches,
notch = input$inPlotBoxNotches, outlier.colour = if (input$chBplotBoxOutliers)
alpha = input$inPlotBoxAlpha,
outlier.colour = if (input$inPlotBoxOutliers)
'red' 'red'
else else
NA NA
) )
p.out = p.out + p.out = p.out +
scale_fill_discrete(name = '') + scale_fill_discrete(name = in.labels$legend) +
xlab('') + xlab(in.labels$x) +
ylab('') + ylab(in.labels$y) +
LOCggplotTheme(in.font.base = PLOTFONTBASE, LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT, in.font.axis.text = PLOTFONTAXISTEXT,
in.font.axis.title = PLOTFONTAXISTITLE, in.font.axis.title = PLOTFONTAXISTITLE,
in.font.strip = PLOTFONTFACETSTRIP, in.font.strip = PLOTFONTFACETSTRIP,
in.font.legend = PLOTFONTLEGEND) + in.font.legend = PLOTFONTLEGEND) +
theme(legend.position = input$selPlotBoxLegendPos, theme(legend.position = input$selPlotLegendPos,
axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate), axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate),
size = PLOTFONTAXISTEXT)) size = PLOTFONTAXISTEXT))
return(p.out) return(p.out)
} }
......
...@@ -129,16 +129,16 @@ l.col.pal.dend.2 = list( ...@@ -129,16 +129,16 @@ l.col.pal.dend.2 = list(
# Clustering algorithms ---- # Clustering algorithms ----
s.cl.linkage = c("average", s.cl.linkage = c("complete",
"complete", "average",
"single", "single",
"centroid", "centroid",
"ward.D", "ward.D",
"ward.D2", "ward.D2",
"mcquitty") "mcquitty")
s.cl.spar.linkage = c("average", s.cl.spar.linkage = c("complete",
"complete", "average",
"single", "single",
"centroid") "centroid")
...@@ -191,10 +191,9 @@ help.text.short = c( ...@@ -191,10 +191,9 @@ help.text.short = c(
'Normalise with respect to this time span.', #12 '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 '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 '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 '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 'A number of time points left & right of selected time points; use the mean of values from these time points for the scatterplot.' #17
'Operations to perform on values at time points selected in the field above.' #18
) )
# Functions for data processing ---- # Functions for data processing ----
...@@ -809,7 +808,7 @@ LOCggplotScat = function(dt.arg, ...@@ -809,7 +808,7 @@ LOCggplotScat = function(dt.arg,
trend.arg = T, trend.arg = T,
ci.arg = 0.95) { 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) geom_point(alpha = alpha.arg)
if (trend.arg) { if (trend.arg) {
......
...@@ -65,7 +65,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna ...@@ -65,7 +65,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
p.out = p.out + p.out = p.out +
scale_y_continuous(labels = percent) + scale_y_continuous(labels = percent) +
ylab("Percentage of time-series\n") + ylab("Percentage of time series\n") +
xlab("Groups") + xlab("Groups") +
LOCggplotTheme(in.font.base = PLOTFONTBASE, LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT, 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