Commit 082b907a authored by dmattek's avatar dmattek

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)
# Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
# This function is used to plot and to downoad a pdf
plotBox <- function() {
cat(file = stderr(), 'plotBox\n')
loc.dt = in.data()
cat(file = stderr(), "plotBox: on to plot\n\n")
if (is.null(loc.dt)) {
cat(file = stderr(), 'plotBox: dt is NULL\n')
return(NULL)
}
cat(file = stderr(), 'plotBox:dt not NULL\n')
if(!input$chBplotTypeLine) {
# Dodging series only for box-, dot-, and violin-plots
loc.par.dodge <- position_dodge(width = input$slPlotBoxDodge)
# Color fill for all oplots except line, in which groups are plotted per facet
p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x),
y = in.cols$meas.y,