From b70dcf1a8fa7f85d22c9297d0508974f274c96f5 Mon Sep 17 00:00:00 2001 From: dmattek Date: Sat, 2 Sep 2017 17:03:13 +0200 Subject: [PATCH] Fixed: - trajPlot.R; cluster colours displayed properly when manually selecting clusters to display --- modules/auxfunc.R | 18 ++++++++++-------- modules/tabBoxPlot.R | 33 +++++++++++++++++++++++++++++---- modules/trajPlot.R | 24 +++++++++++++++++++++++- server.R | 4 ++-- 4 files changed, 64 insertions(+), 15 deletions(-) diff --git a/modules/auxfunc.R b/modules/auxfunc.R index 918dd4f..bc3740a 100644 --- a/modules/auxfunc.R +++ b/modules/auxfunc.R @@ -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) diff --git a/modules/tabBoxPlot.R b/modules/tabBoxPlot.R index ab9c26e..065013f 100644 --- a/modules/tabBoxPlot.R +++ b/modules/tabBoxPlot.R @@ -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) diff --git a/modules/trajPlot.R b/modules/trajPlot.R index bd54878..e83f790 100644 --- a/modules/trajPlot.R +++ b/modules/trajPlot.R @@ -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, diff --git a/server.R b/server.R index 036a8ff..6c91cde 100644 --- a/server.R +++ b/server.R @@ -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 -- GitLab