Commit b70dcf1a authored by dmattek's avatar dmattek

Fixed:

- trajPlot.R; cluster colours displayed properly when manually selecting clusters to display
parent 01800774
...@@ -111,6 +111,8 @@ myGgplotTraj = function(dt.arg, # data table ...@@ -111,6 +111,8 @@ myGgplotTraj = function(dt.arg, # data table
loc.dt.cl = data.table(xx = 1:length(facet.color.arg), yy = loc.y.max) loc.dt.cl = data.table(xx = 1:length(facet.color.arg), yy = loc.y.max)
setnames(loc.dt.cl, 'xx', facet.arg) setnames(loc.dt.cl, 'xx', facet.arg)
# adjust facet.color.arg to plot
p.tmp = p.tmp + p.tmp = p.tmp +
geom_hline(data = loc.dt.cl, colour = facet.color.arg, yintercept = loc.y.max, size = 4) + geom_hline(data = loc.dt.cl, colour = facet.color.arg, yintercept = loc.y.max, size = 4) +
scale_colour_manual(values = facet.color.arg, scale_colour_manual(values = facet.color.arg,
...@@ -256,23 +258,23 @@ myNorm = function(in.dt, ...@@ -256,23 +258,23 @@ myNorm = function(in.dt,
if (is.null(in.by.cols)) { if (is.null(in.by.cols)) {
if (in.robust) if (in.robust)
loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min & loc.dt.pre.aggr = loc.dt[get(in.rt.col) >= in.rt.min &
get(in.rt.col) < in.rt.max, .(meas.md = median(get(in.meas.col), na.rm = TRUE), get(in.rt.col) <= in.rt.max, .(meas.md = median(get(in.meas.col), na.rm = TRUE),
meas.mad = mad(get(in.meas.col), na.rm = TRUE))] meas.mad = mad(get(in.meas.col), na.rm = TRUE))]
else else
loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min & loc.dt.pre.aggr = loc.dt[get(in.rt.col) >= in.rt.min &
get(in.rt.col) < in.rt.max, .(meas.md = mean(get(in.meas.col), na.rm = TRUE), get(in.rt.col) <= in.rt.max, .(meas.md = mean(get(in.meas.col), na.rm = TRUE),
meas.mad = sd(get(in.meas.col), na.rm = TRUE))] meas.mad = sd(get(in.meas.col), na.rm = TRUE))]
loc.dt = cbind(loc.dt, loc.dt.pre.aggr) loc.dt = cbind(loc.dt, loc.dt.pre.aggr)
} else { } else {
if (in.robust) if (in.robust)
loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min & loc.dt.pre.aggr = loc.dt[get(in.rt.col) >= in.rt.min &
get(in.rt.col) < in.rt.max, .(meas.md = median(get(in.meas.col), na.rm = TRUE), get(in.rt.col) <= in.rt.max, .(meas.md = median(get(in.meas.col), na.rm = TRUE),
meas.mad = mad(get(in.meas.col), na.rm = TRUE)), by = in.by.cols] meas.mad = mad(get(in.meas.col), na.rm = TRUE)), by = in.by.cols]
else else
loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min & loc.dt.pre.aggr = loc.dt[get(in.rt.col) >= in.rt.min &
get(in.rt.col) < in.rt.max, .(meas.md = mean(get(in.meas.col), na.rm = TRUE), get(in.rt.col) <= in.rt.max, .(meas.md = mean(get(in.meas.col), na.rm = TRUE),
meas.mad = sd(get(in.meas.col), na.rm = TRUE)), by = in.by.cols] meas.mad = sd(get(in.meas.col), na.rm = TRUE)), by = in.by.cols]
loc.dt = merge(loc.dt, loc.dt.pre.aggr, by = in.by.cols) loc.dt = merge(loc.dt, loc.dt.pre.aggr, by = in.by.cols)
......
...@@ -40,6 +40,8 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") { ...@@ -40,6 +40,8 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
), ),
uiOutput(ns('uiPlotBoxNotches')), uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')), uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotBoxDodge')),
#uiOutput(ns('uiPlotBoxWidth')),
uiOutput(ns('uiPlotBoxAlpha')), uiOutput(ns('uiPlotBoxAlpha')),
uiOutput(ns('uiPlotDotNbins')) uiOutput(ns('uiPlotDotNbins'))
), ),
...@@ -153,13 +155,31 @@ tabBoxPlot = function(input, output, session, in.data) { ...@@ -153,13 +155,31 @@ tabBoxPlot = function(input, output, session, in.data) {
checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers?', FALSE) checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers?', FALSE)
}) })
output$uiPlotBoxDodge = renderUI({
cat(file = stderr(), 'UI uiPlotBoxDodge\n')
ns <- session$ns
if(!( input$inPlotType %in% 'line' ))
sliderInput(ns('inPlotBoxDodge'), 'Dodge series:', min = 0, max = 1, value = .4, step = 0.05)
})
output$uiPlotBoxWidth = renderUI({
cat(file = stderr(), 'UI uiPlotBoxWidth\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({ output$uiPlotBoxAlpha = renderUI({
cat(file = stderr(), 'UI uiPlotBoxAlpha\n') cat(file = stderr(), 'UI uiPlotBoxAlpha\n')
ns <- session$ns ns <- session$ns
if('box' %in% input$inPlotType) if('box' %in% input$inPlotType)
sliderInput(ns('inPlotBoxAlpha'), 'Box plot transparency:', min = 0, max = 1, value = 1, step = 0.1) sliderInput(ns('inPlotBoxAlpha'), 'Box plot transparency:', min = 0, max = 1, value = 1, step = 0.05)
}) })
output$uiPlotDotNbins = renderUI({ output$uiPlotDotNbins = renderUI({
...@@ -308,11 +328,16 @@ tabBoxPlot = function(input, output, session, in.data) { ...@@ -308,11 +328,16 @@ tabBoxPlot = function(input, output, session, in.data) {
cat(file = stderr(), 'plotBox:dt not NULL\n') cat(file = stderr(), 'plotBox:dt not NULL\n')
loc.par.dodge <- position_dodge(width = 0.4) loc.par.dodge <- position_dodge(width = input$inPlotBoxDodge)
p.out = ggplot(loc.dt, aes(x = as.factor(realtime), y = y)) p.out = ggplot(loc.dt, aes(x = as.factor(realtime), y = y))
if('dot' %in% input$inPlotType) if('dot' %in% input$inPlotType)
p.out = p.out + geom_dotplot(aes(fill = group), binaxis = "y", stackdir = "center", position = loc.par.dodge, binwidth = 10^(input$inPlotDotNbins), method = 'histodot') p.out = p.out + geom_dotplot(aes(fill = group),
binaxis = "y",
stackdir = "center",
position = loc.par.dodge,
binwidth = 10^(input$inPlotDotNbins),
method = 'histodot')
if('viol' %in% input$inPlotType) if('viol' %in% input$inPlotType)
p.out = p.out + geom_violin(aes(fill = group), p.out = p.out + geom_violin(aes(fill = group),
...@@ -328,7 +353,7 @@ tabBoxPlot = function(input, output, session, in.data) { ...@@ -328,7 +353,7 @@ tabBoxPlot = function(input, output, session, in.data) {
p.out = p.out + geom_boxplot( p.out = p.out + geom_boxplot(
aes(fill = group), aes(fill = group),
position = loc.par.dodge, position = loc.par.dodge,
width = 0.2, #width = 0.2, #input$inPlotBoxWidth,
notch = input$inPlotBoxNotches, notch = input$inPlotBoxNotches,
alpha = input$inPlotBoxAlpha, alpha = input$inPlotBoxAlpha,
outlier.colour = if (input$inPlotBoxOutliers) outlier.colour = if (input$inPlotBoxOutliers)
......
...@@ -138,6 +138,28 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f ...@@ -138,6 +138,28 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
else else
locPos = FALSE locPos = FALSE
# If in.facet.color present,
# make sure to include the same number of colours in the palette,
# as the number of groups in dt.
# in.facet.color is typically used when plotting time series within clusters.
# Then, the number of colours in the palette has to be equal to the number of clusters (facetted according to in.facet variable).
# This might differ if the user selects manually clusters to display.
if (is.null(in.facet.color))
loc.facet.col = NULL
else {
# get group numbers in dt;
# loc.dt[, c(in.facet), with = FALSE] returns a data table with a single column
# [[1]] at the end extracts the first column and returns as a vector
loc.groups = unique(loc.dt[, c(in.facet), with = FALSE][[1]])
# get colour palette
# the length is equal to the number of groups in the original dt.
# When plotting time series within clusters, the length equals the number of clusters.
loc.facet.col = in.facet.color()$cl.col
loc.facet.col = loc.facet.col[loc.groups]
}
p.out = myGgplotTraj( p.out = myGgplotTraj(
dt.arg = loc.dt, dt.arg = loc.dt,
x.arg = 'realtime', x.arg = 'realtime',
...@@ -145,7 +167,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f ...@@ -145,7 +167,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
group.arg = "id", group.arg = "id",
facet.arg = in.facet, facet.arg = in.facet,
facet.ncol.arg = input$inPlotTrajFacetNcol, facet.ncol.arg = input$inPlotTrajFacetNcol,
facet.color.arg = if (is.null(in.facet.color)) NULL else in.facet.color()$cl.col, facet.color.arg = loc.facet.col,
xlab.arg = 'Time (min)', xlab.arg = 'Time (min)',
line.col.arg = loc.line.col.arg, line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL, aux.label1 = if (locPos) 'pos.x' else NULL,
......
...@@ -285,7 +285,7 @@ shinyServer(function(input, output, session) { ...@@ -285,7 +285,7 @@ shinyServer(function(input, output, session) {
label = 'Percentage of middle data', label = 'Percentage of middle data',
min = 90, min = 90,
max = 100, max = 100,
value = 99, value = 99.5,
step = 0.1 step = 0.1
) )
...@@ -1166,7 +1166,7 @@ shinyServer(function(input, output, session) { ...@@ -1166,7 +1166,7 @@ shinyServer(function(input, output, session) {
callModule(downPlot, "downPlotHierSparHM", paste0('clust_hierchSparse_heatMap_', callModule(downPlot, "downPlotHierSparHM", paste0('clust_hierchSparse_heatMap_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'), plotHierSpar) s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.png'), plotHierSpar)
# Sparse Hierarchical clustering (sparcl) interactive version # Sparse Hierarchical clustering (sparcl) interactive version
......
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