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
loc.dt.cl = data.table(xx = 1:length(facet.color.arg), yy = loc.y.max)
setnames(loc.dt.cl, 'xx', facet.arg)
# adjust facet.color.arg to plot
p.tmp = p.tmp +
geom_hline(data = loc.dt.cl, colour = facet.color.arg, yintercept = loc.y.max, size = 4) +
scale_colour_manual(values = facet.color.arg,
......@@ -256,23 +258,23 @@ myNorm = function(in.dt,
if (is.null(in.by.cols)) {
if (in.robust)
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),
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),
meas.mad = mad(get(in.meas.col), na.rm = TRUE))]
else
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),
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),
meas.mad = sd(get(in.meas.col), na.rm = TRUE))]
loc.dt = cbind(loc.dt, loc.dt.pre.aggr)
} else {
if (in.robust)
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),
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),
meas.mad = mad(get(in.meas.col), na.rm = TRUE)), by = in.by.cols]
else
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),
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),
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)
......
......@@ -40,6 +40,8 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
),
uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotBoxDodge')),
#uiOutput(ns('uiPlotBoxWidth')),
uiOutput(ns('uiPlotBoxAlpha')),
uiOutput(ns('uiPlotDotNbins'))
),
......@@ -153,13 +155,31 @@ tabBoxPlot = function(input, output, session, in.data) {
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({
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.1)
sliderInput(ns('inPlotBoxAlpha'), 'Box plot transparency:', min = 0, max = 1, value = 1, step = 0.05)
})
output$uiPlotDotNbins = renderUI({
......@@ -308,11 +328,16 @@ tabBoxPlot = function(input, output, session, in.data) {
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))
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)
p.out = p.out + geom_violin(aes(fill = group),
......@@ -328,7 +353,7 @@ tabBoxPlot = function(input, output, session, in.data) {
p.out = p.out + geom_boxplot(
aes(fill = group),
position = loc.par.dodge,
width = 0.2,
#width = 0.2, #input$inPlotBoxWidth,
notch = input$inPlotBoxNotches,
alpha = input$inPlotBoxAlpha,
outlier.colour = if (input$inPlotBoxOutliers)
......
......@@ -138,6 +138,28 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
else
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(
dt.arg = loc.dt,
x.arg = 'realtime',
......@@ -145,7 +167,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
group.arg = "id",
facet.arg = in.facet,
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)',
line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL,
......
......@@ -285,7 +285,7 @@ shinyServer(function(input, output, session) {
label = 'Percentage of middle data',
min = 90,
max = 100,
value = 99,
value = 99.5,
step = 0.1
)
......@@ -1166,7 +1166,7 @@ shinyServer(function(input, output, session) {
callModule(downPlot, "downPlotHierSparHM", paste0('clust_hierchSparse_heatMap_',
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
......
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