Commit aa825c82 authored by dmattek's avatar dmattek

Refactoring: assignments of color palettes when plotting clusters. Make Color...

Refactoring: assignments of color palettes when plotting clusters. Make Color Blind palette a default.
parent af7403e9
...@@ -62,6 +62,7 @@ COLPOSY = 'pos.y' ...@@ -62,6 +62,7 @@ COLPOSY = 'pos.y'
COLIDX = 'IDX' COLIDX = 'IDX'
COLIDXDIFF = 'IDXdiff' COLIDXDIFF = 'IDXdiff'
COLCL = 'cl' COLCL = 'cl'
COLNTRAJ = "nCells"
# file names # file names
FCSVOUTLIERS = 'outliers.csv' FCSVOUTLIERS = 'outliers.csv'
...@@ -795,20 +796,25 @@ getDataClSpar = function(in.dend, in.k, in.id) { ...@@ -795,20 +796,25 @@ getDataClSpar = function(in.dend, in.k, in.id) {
# prepares a table with cluster numbers in 1st column and colour assignments in 2nd column # Returns a table with 2 columns:
# the number of rows is determined by dendrogram cut # - gr.no - group numbers, e.g. cluster,
getClCol <- function(in.dend, in.k) { # - gr.col - color assignments.
#
# The number of rows is determined by dendrogram cut, parameter in.k.
# Colours are obtained from the dendrogram, parameter in.dend, using dendextend::get_leaves_branches_col
LOCgetClCol <- function(in.dend, in.k) {
loc.col_labels <- dendextend::get_leaves_branches_col(in.dend) loc.col_labels <- dendextend::get_leaves_branches_col(in.dend)
loc.col_labels <- loc.col_labels[order(order.dendrogram(in.dend))] loc.col_labels <- loc.col_labels[order(order.dendrogram(in.dend))]
return(unique( return(unique(
data.table( data.table(
cl.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE), gr.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE),
cl.col = loc.col_labels gr.col = loc.col_labels
) )
)) ))
} }
# Custom plotting functions ---- # Custom plotting functions ----
...@@ -881,6 +887,36 @@ LOCrotatedAxisElementText = function(angle, ...@@ -881,6 +887,36 @@ LOCrotatedAxisElementText = function(angle,
) )
} }
#' Return recycled tableau palette
#'
#' Cycle through a tableau palette (e.g. "Color Blind") and return repeated
#' colours depending on the required number of colours
#'
#' @param inPalName Name of the tableau colour palette, e.g. "Color Blind"
#' @param inNcolors Number of required colours, default 10
#'
#' @return A vector with a requested number of colors
#' @export
#'
#' @examples
#' # The Color Blind palette has only 10 colors; here the 11th will be recycled
#' LOCreturnTableauPalette("Color Blind", 11)
LOCreturnTableauPalette = function(inPalName, inNcolors = 10) {
# get the max N of colours in the palette
loc.max.col = attr(ggthemes::tableau_color_pal(inPalName), "max_n")
# get all colours in the palette
loc.col = ggthemes::tableau_color_pal(inPalName)(n = loc.max.col)
# repeat the full palette for the required number of colours
loc.col = rep(loc.col, ((inNcolors-1) %/% loc.max.col) + 1)
# return only the required number of colurs
return(loc.col[1:inNcolors])
}
# Plot individual time series # Plot individual time series
LOCplotTraj = function(dt.arg, LOCplotTraj = function(dt.arg,
# input data table # input data table
...@@ -1062,35 +1098,50 @@ LOCplotTraj = function(dt.arg, ...@@ -1062,35 +1098,50 @@ LOCplotTraj = function(dt.arg,
return(p.tmp) return(p.tmp)
} }
# Plot average time series with CI together in one facet
#' Plot average time series with CI together in one facet
#'
#' @param dt.arg Data.table with aggregated time series in long format
#' @param x.arg String with column name for x-axis
#' @param y.arg String with column name for y-axis
#' @param group.arg String with column name for grouping time series (e.g. a column with grouping by condition)
#' @param col.arg Colour pallette for individual time series
#' @param dt.stim.arg Data.table with stimulation segments to plot under time series
#' @param x.stim.arg Column names in stimulation dt with x and xend parameters, default c('tstart', 'tend')
#' @param y.stim.arg Column names in stimulation dt with y and yend parameters, default c('ystart', 'yend')
#' @param stim.bar.width.arg Width of the stimulation segment, default 0.5
#' @param xlim.arg Limits of x-axis; for visualisation only, not trimmimng data
#' @param ylim.arg Limits of y-axis; for visualisation only, not trimmimng data
#' @param ribbon.lohi.arg Column names containing lower and upper bound for plotting the ribbon, e.g. for CI; default c('Lower', 'Upper'); set to NULL to avoid plotting the ribbon
#' @param ribbon.fill.arg Color to fill the ribbon, default 'grey50'
#' @param ribbon.alpha.arg Transparency of the ribbon, default 0.5
#' @param xlab.arg X-axis label
#' @param ylab.arg Y-axis label
#' @param plotlab.arg Plot label
#'
#' @return Ggplot object
#' @export
#'
#' @examples
LOCplotTrajRibbon = function(dt.arg, LOCplotTrajRibbon = function(dt.arg,
# input data table
x.arg, x.arg,
# string with column name for x-axis
y.arg, y.arg,
# string with column name for y-axis
group.arg = NULL, group.arg = NULL,
# string with column name for grouping time series (here, it's a column corresponding to grouping by condition)
col.arg = NULL, col.arg = NULL,
# colour pallette for individual time series
dt.stim.arg = NULL, dt.stim.arg = NULL,
# data table with stimulation pattern
x.stim.arg = c('tstart', 'tend'), x.stim.arg = c('tstart', 'tend'),
# column names in stimulation dt with x and xend parameters
y.stim.arg = c('ystart', 'yend'), y.stim.arg = c('ystart', 'yend'),
# column names in stimulation dt with y and yend parameters
stim.bar.width.arg = 0.5, stim.bar.width.arg = 0.5,
xlim.arg = NULL, xlim.arg = NULL,
# limits of x-axis; for visualisation only, not trimmimng data
ylim.arg = NULL, ylim.arg = NULL,
# limits of y-axis; for visualisation only, not trimmimng data
ribbon.lohi.arg = c('Lower', 'Upper'), ribbon.lohi.arg = c('Lower', 'Upper'),
# column names containing lower and upper bound for plotting the ribbon, e.g. for CI; set to NULL to avoid plotting the ribbon
ribbon.fill.arg = 'grey50', ribbon.fill.arg = 'grey50',
ribbon.alpha.arg = 0.5, ribbon.alpha.arg = 0.5,
xlab.arg = NULL, xlab.arg = NULL,
ylab.arg = NULL, ylab.arg = NULL,
plotlab.arg = NULL) { plotlab.arg = NULL) {
p.tmp = ggplot(dt.arg, aes_string(x = x.arg, group = group.arg)) p.tmp = ggplot(dt.arg, aes_string(x = x.arg, group = group.arg))
if (!is.null(ribbon.lohi.arg)) if (!is.null(ribbon.lohi.arg))
......
...@@ -26,10 +26,15 @@ modClDistPlotUI = function(id, label = "Plot distribution of clusters per group ...@@ -26,10 +26,15 @@ modClDistPlotUI = function(id, label = "Plot distribution of clusters per group
# Params: # Params:
# in.data - data prepared with data4clDistPlot f-n # in.data - data prepared with data4clDistPlot f-n
# in.cols - table with 1st column as cluster number, 2nd column colour assignments # in.colors - table with two columns:
# prepared with getClColHier # - gr.no - with group/cluster number,
# - gr.col - with colour assignments
# prepared with getClColHier
# in.fname - file name for plot download # in.fname - file name for plot download
modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fname = 'clDist.pdf') { modClDistPlot = function(input, output, session,
in.data,
in.colors = NULL,
in.fname = 'clDist.pdf') {
ns <- session$ns ns <- session$ns
...@@ -38,26 +43,23 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna ...@@ -38,26 +43,23 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
cat(file = stderr(), 'plotClDist: in\n') cat(file = stderr(), 'plotClDist: in\n')
loc.dt = in.data() loc.dt = in.data()
if (is.null(loc.dt)) { validate(
cat(file = stderr(), 'plotClDist: dt is NULL\n') need(!is.null(loc.dt), "Nothing to plot. Load data first!")
return(NULL) )
}
# Two statements: "position_fill(reverse = TRUE)" and "guide_legend(reverse = T)" # Two statements: "position_fill(reverse = TRUE)" and "guide_legend(reverse = T)"
# result in stacked bar plot with categories ordered from the bottom to top of the stacked bar # result in a stacked bar plot with categories ordered from the bottom to top of the stacked bar
p.out = ggplot(loc.dt[], aes(x = group, y = nCells)) + p.out = ggplot(loc.dt, aes_string(x = COLGR, y = COLNTRAJ)) +
geom_bar(aes(fill = as.factor(cl)), stat = 'identity', position = position_fill(reverse = TRUE)) + geom_bar(aes_string(fill = paste0("as.factor(", COLCL, ")")),
stat = 'identity',
position = position_fill(reverse = TRUE)) +
guides(fill = guide_legend(reverse = T)) guides(fill = guide_legend(reverse = T))
if(is.null(in.cols)) if(is.null(in.colors))
p.out = p.out + scale_fill_discrete(name = "Cluster no.") p.out = p.out + scale_fill_discrete(name = "Cluster no.")
else else
p.out = p.out + scale_fill_manual(name = "Cluster no.", p.out = p.out + scale_fill_manual(name = "Cluster no.",
values = in.cols()$cl.col) #, values = in.colors()[["gr.col"]])
#breaks = in.cols()$cl.no,
#labels = in.cols()$cl.no,
#limits = in.cols()$cl.no)
loc.rads = as.numeric(input$rBAxisLabelsRotate) * pi / 180 loc.rads = as.numeric(input$rBAxisLabelsRotate) * pi / 180
loc.hjust = 0.5*(1-sin(loc.rads)) loc.hjust = 0.5*(1-sin(loc.rads))
......
...@@ -274,15 +274,10 @@ modDistPlot = function(input, output, session, ...@@ -274,15 +274,10 @@ modDistPlot = function(input, output, session,
else else
NA NA
) )
# If more than max.col groups, cycle through the palette ("Color Blind" can return 10 colors at maximum) # Get a tableau "Color Blind" palette; recycle 10 available colours, if more groups
loc.pal = "Color Blind" loc.ngroups = uniqueN(loc.dt[, get(in.cols$group)])
max.col = attr(ggthemes::tableau_color_pal(loc.pal), "max_n") loc.col = LOCreturnTableauPalette("Color Blind", loc.ngroups)
loc.col = ggthemes::tableau_color_pal(loc.pal)(n = max.col)
ngroups = uniqueN(loc.dt[, get(in.cols$group)]) - 1
loc.col = rep(loc.col, (ngroups %/% max.col) + 1)
loc.col = loc.col[1:(ngroups+1)]
p.out = p.out + p.out = p.out +
xlab(in.labels$x) + xlab(in.labels$x) +
...@@ -295,7 +290,8 @@ modDistPlot = function(input, output, session, ...@@ -295,7 +290,8 @@ modDistPlot = function(input, output, session,
theme(legend.position = input$selPlotBoxLegendPos, theme(legend.position = input$selPlotBoxLegendPos,
axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate), axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate),
size = PLOTFONTAXISTEXT)) + size = PLOTFONTAXISTEXT)) +
scale_fill_manual(name = in.labels$legend, values = loc.col) scale_fill_manual(name = in.labels$legend,
values = loc.col)
return(p.out) return(p.out)
......
...@@ -169,11 +169,11 @@ clustHierUI <- function(id, label = "Hierarchical Clustering") { ...@@ -169,11 +169,11 @@ clustHierUI <- function(id, label = "Hierarchical Clustering") {
withSpinner(plotOutput(ns('outPlotHier'))) withSpinner(plotOutput(ns('outPlotHier')))
), ),
tabPanel('Averages', tabPanel('Cluster averages',
br(), br(),
modTrajRibbonPlotUI(ns('modPlotHierTrajRibbon'))), modTrajRibbonPlotUI(ns('modPlotHierTrajRibbon'))),
tabPanel('Time series', tabPanel('Time series in clusters',
br(), br(),
modTrajPlotUI(ns('modPlotHierTraj'))), modTrajPlotUI(ns('modPlotHierTraj'))),
...@@ -343,8 +343,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS ...@@ -343,8 +343,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
}) })
# returns table prepared with f-n getClCol # Returns a table prepared with f-n getClCol
# for hierarchical clustering # for hierarchical clustering.
# The table contains colours assigned to clusters.
# Colours are obtained from the dendrogram using dendextend::get_leaves_branches_col
getClColHier <- reactive({ getClColHier <- reactive({
cat(file = stderr(), 'getClColHier \n') cat(file = stderr(), 'getClColHier \n')
...@@ -352,15 +354,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS ...@@ -352,15 +354,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
if (is.null(loc.dend)) if (is.null(loc.dend))
return(NULL) return(NULL)
loc.dt = getClCol(loc.dend, returnNclust()) # obtain relations between cluster and colors from the dendrogram
loc.dt = LOCgetClCol(loc.dend, returnNclust())
# Display clusters specified in the inPlotHierClSel field # Display clusters specified in the inPlotHierClSel field
# Data is ordered according to the order of clusters specified in this field # Data is ordered according to the order of clusters specified in this field
if(input$chBPlotHierClSel) { if(input$chBPlotHierClSel) {
loc.dt = loc.dt[cl.no %in% input$inPlotHierClSel] # kepp only clusters specified in input$inPlotHierClSel
loc.dt[, cl.no := factor(cl.no, levels = input$inPlotHierClSel)] loc.dt = loc.dt[gr.no %in% input$inPlotHierClSel]
setkey(loc.dt, cl.no) loc.dt[, gr.no := factor(gr.no, levels = input$inPlotHierClSel)]
} }
# set the key to allow subsetting
setkey(loc.dt, gr.no)
return(loc.dt) return(loc.dt)
}) })
...@@ -465,6 +471,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS ...@@ -465,6 +471,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
# get cell id's with associated cluster numbers # get cell id's with associated cluster numbers
loc.dt.cl = getDataCl(loc.dend, returnNclust()) loc.dt.cl = getDataCl(loc.dend, returnNclust())
if (is.null(loc.dt.cl)) {
cat(file = stderr(), 'plotClDist: loc.dt.cl is NULL\n')
return(NULL)
}
# get cellIDs with condition name # get cellIDs with condition name
loc.dt.gr = getDataCond() loc.dt.gr = getDataCond()
...@@ -473,17 +483,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS ...@@ -473,17 +483,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
return(NULL) return(NULL)
} }
# add grouping to clusters+ids
loc.dt = merge(loc.dt.cl, loc.dt.gr, by = COLID) loc.dt = merge(loc.dt.cl, loc.dt.gr, by = COLID)
# count number of time series per group, per cluster
loc.dt.aggr = loc.dt[, .(nCells = .N), by = .(group, cl)] loc.dt.aggr = loc.dt[, .(xxx = .N), by = c(COLGR, COLCL)]
setnames(loc.dt.aggr, "xxx", COLNTRAJ)
# Display clusters specified in the inPlotHierClSel field # Display clusters specified in the inPlotHierClSel field
# Data is ordered according to the order of clusters specified in this field # Data is ordered according to the order of clusters specified in this field
if(input$chBPlotHierClSel) { if(input$chBPlotHierClSel) {
loc.dt.aggr = loc.dt.aggr[cl %in% input$inPlotHierClSel] loc.dt.aggr = loc.dt.aggr[cl %in% input$inPlotHierClSel]
loc.dt.aggr[, cl := factor(cl, levels = input$inPlotHierClSel)] loc.dt.aggr[, (COLCL) := factor(get(COLCL), levels = input$inPlotHierClSel)]
setkey(loc.dt.aggr, cl) setkeyv(loc.dt.aggr, COLCL)
} }
return(loc.dt.aggr) return(loc.dt.aggr)
...@@ -606,7 +618,7 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS ...@@ -606,7 +618,7 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
callModule(modTrajPlot, 'modPlotHierTraj', callModule(modTrajPlot, 'modPlotHierTraj',
in.data = data4trajPlotCl, in.data = data4trajPlotCl,
in.data.stim = data4stimPlotCl, in.data.stim = data4stimPlotCl,
in.facet = 'cl', in.facet = COLCL,
in.facet.color = getClColHier, in.facet.color = getClColHier,
in.fname = createFnameTrajPlot) in.fname = createFnameTrajPlot)
...@@ -614,21 +626,21 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS ...@@ -614,21 +626,21 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon', callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon',
in.data = data4trajPlotCl, in.data = data4trajPlotCl,
in.data.stim = data4stimPlotCl, in.data.stim = data4stimPlotCl,
in.facet = 'cl', in.group = COLCL,
in.facet.color = getClColHier, in.group.color = getClColHier,
in.fname = createFnameRibbonPlot) in.fname = createFnameRibbonPlot)
# plot cluster PSD # plot cluster PSD
callModule(modPSDPlot, 'modPlotHierPsd', callModule(modPSDPlot, 'modPlotHierPsd',
in.data = data4trajPlotCl, in.data = data4trajPlotCl,
in.facet = 'cl', in.facet = COLCL,
in.facet.color = getClColHier, in.facet.color = getClColHier,
in.fname = createFnamePsdPlot) in.fname = createFnamePsdPlot)
# plot distribution barplot # plot distribution barplot
callModule(modClDistPlot, 'hierClDistPlot', callModule(modClDistPlot, 'hierClDistPlot',
in.data = data4clDistPlot, in.data = data4clDistPlot,
in.cols = getClColHier, in.colors = getClColHier,
in.fname = createFnameDistPlot) in.fname = createFnameDistPlot)
......
...@@ -344,8 +344,10 @@ clustHierSpar <- function(input, output, session, ...@@ -344,8 +344,10 @@ clustHierSpar <- function(input, output, session,
return(dend) return(dend)
}) })
# returns table prepared with f-n getClCol # Returns a table prepared with f-n getClCol
# for sparse hierarchical clustering # for hierarchical clustering.
# The table contains colours assigned to clusters.
# Colours are obtained from the dendrogram using dendextend::get_leaves_branches_col
getClColHierSpar <- reactive({ getClColHierSpar <- reactive({
cat(file = stderr(), 'getClColHierSpar \n') cat(file = stderr(), 'getClColHierSpar \n')
...@@ -353,10 +355,13 @@ clustHierSpar <- function(input, output, session, ...@@ -353,10 +355,13 @@ clustHierSpar <- function(input, output, session,
if (is.null(loc.dend)) if (is.null(loc.dend))
return(NULL) return(NULL)
loc.cut = getClCol(loc.dend, input$inPlotHierSparNclust) # obtain relations between cluster and colors from the dendrogram
loc.dt = LOCgetClCol(loc.dend, input$inPlotHierSparNclust)
# set the key to allow subsetting
setkey(loc.dt, gr.no)
return(loc.cut) return(loc.dt)
}) })
...@@ -413,7 +418,7 @@ clustHierSpar <- function(input, output, session, ...@@ -413,7 +418,7 @@ clustHierSpar <- function(input, output, session,
## the following merge won't work... ## the following merge won't work...
## No idea how to solve it ## No idea how to solve it
loc.dt = merge(loc.dt, loc.dt.cl, by = 'id') loc.dt = merge(loc.dt, loc.dt.cl, by = COLID)
# display only selected clusters # display only selected clusters
if(input$chBPlotHierSparClSel) if(input$chBPlotHierSparClSel)
...@@ -513,7 +518,6 @@ clustHierSpar <- function(input, output, session, ...@@ -513,7 +518,6 @@ clustHierSpar <- function(input, output, session,
# when changing the number of clusters to highlight # when changing the number of clusters to highlight
loc.k = returnNclust() loc.k = returnNclust()
# create column labels according to importance weights # create column labels according to importance weights
loc.colnames = paste0(ifelse(loc.hc$ws == 0, "", loc.colnames = paste0(ifelse(loc.hc$ws == 0, "",
ifelse( ifelse(
...@@ -618,7 +622,7 @@ clustHierSpar <- function(input, output, session, ...@@ -618,7 +622,7 @@ clustHierSpar <- function(input, output, session,
callModule(modTrajPlot, 'modPlotHierSparTraj', callModule(modTrajPlot, 'modPlotHierSparTraj',
in.data = data4trajPlotClSpar, in.data = data4trajPlotClSpar,
in.data.stim = data4stimPlotClSpar, in.data.stim = data4stimPlotClSpar,
in.facet = 'cl', in.facet = COLCL,
in.facet.color = getClColHierSpar, in.facet.color = getClColHierSpar,
in.fname = createFnameTrajPlot) in.fname = createFnameTrajPlot)
...@@ -626,21 +630,21 @@ clustHierSpar <- function(input, output, session, ...@@ -626,21 +630,21 @@ clustHierSpar <- function(input, output, session,
callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon', callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon',
in.data = data4trajPlotClSpar, in.data = data4trajPlotClSpar,
in.data.stim = data4stimPlotClSpar, in.data.stim = data4stimPlotClSpar,
in.facet = 'cl', in.group = COLCL,
in.facet.color = getClColHierSpar, in.group.color = getClColHierSpar,
in.fname = createFnameRibbonPlot) in.fname = createFnameRibbonPlot)
# plot cluster PSD # plot cluster PSD
callModule(modPSDPlot, 'modPlotHierSparPsd', callModule(modPSDPlot, 'modPlotHierSparPsd',
in.data = data4trajPlotClSpar, in.data = data4trajPlotClSpar,
in.facet = 'cl', in.facet = COLCL,
in.facet.color = getClColHierSpar, in.facet.color = getClColHierSpar,
in.fname = createFnamePsdPlot) in.fname = createFnamePsdPlot)
# plot distribution barplot # plot distribution barplot
callModule(modClDistPlot, 'hierClSparDistPlot', callModule(modClDistPlot, 'hierClSparDistPlot',
in.data = data4clSparDistPlot, in.data = data4clSparDistPlot,
in.cols = getClColHierSpar, in.colors = getClColHierSpar,
in.fname = createFnameDistPlot) in.fname = createFnameDistPlot)
......
...@@ -318,6 +318,8 @@ clustValid <- function(input, output, session, in.dataWide) { ...@@ -318,6 +318,8 @@ clustValid <- function(input, output, session, in.dataWide) {
if (sum(is.na(loc.dm)) > 0) if (sum(is.na(loc.dm)) > 0)
return(NULL) return(NULL)
# Tha tableau "Color Blind" palette has only 10 colours;
# change to "Tableau 20" if more clusters requested
loc.pal = ifelse(returnNclust() <= 10, "Color Blind", "Tableau 20") loc.pal = ifelse(returnNclust() <= 10, "Color Blind", "Tableau 20")
loc.col = ggthemes::tableau_color_pal(loc.pal)(n = returnNclust()) loc.col = ggthemes::tableau_color_pal(loc.pal)(n = returnNclust())
......
...@@ -285,27 +285,17 @@ modTrajPlot = function(input, output, session, ...@@ -285,27 +285,17 @@ modTrajPlot = function(input, output, session,
else else
locObjNum = FALSE locObjNum = FALSE
# in.facet.color is typically used when plotting time series per clusters.
# The number of colours in the palette has to be equal to the number of groups.
# If in.facet.color present, # This might differ if the user selects manually groups (e.g. clusters) to display.
# make sure to include the same number of colours in the palette, if (is.null(in.facet.color)) {
# as the number of groups in dt. loc.facet.color = NULL
# in.facet.color is typically used when plotting time series within clusters. } else {
# Then, the number of colours in the palette has to be equal to the number of clusters (facetted according to in.facet variable). # get existing groups in dt;
# This might differ if the user selects manually clusters to display. loc.facets = unique(loc.dt[, ..in.facet])
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 # subset group-color assignments with existing groups
# the length is equal to the number of groups in the original dt. loc.facet.color = in.facet.color()[loc.facets][["gr.col"]]
# 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]
} }
...@@ -326,7 +316,7 @@ modTrajPlot = function(input, output, session, ...@@ -326,7 +316,7 @@ modTrajPlot = function(input, output, session,
group.arg = COLID, group.arg = COLID,
facet.arg = in.facet, facet.arg = in.facet,
facet.ncol.arg = input$inPlotTrajFacetNcol, facet.ncol.arg = input$inPlotTrajFacetNcol,
facet.color.arg = loc.facet.col, facet.color.arg = loc.facet.color,
dt.stim.arg = loc.dt.stim, dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'), x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'), y.stim.arg = c('ystart', 'yend'),
......
...@@ -74,12 +74,30 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") { ...@@ -74,12 +74,30 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") {
} }
#' Module for plotting an aggregated ribbon plot of time series
#'
#' @param input
#' @param output
#' @param session
#' @param in.data Data.table with individual (non-aggregated) times series in long format
#' @param in.data.stim Optional long-format data.table for plotting stimulation segments
#' @param in.group String with the name of a grouping column
#' @param in.group.color Data.table with assignments of colours to groups in in.data.
#' Contains two columns:
#' gr.no - group id,
#' gr.col - colour assignments
#' @param in.fname File name for saving the plot
#'
#' @return
#' @export
#'
#' @examples
modTrajRibbonPlot = function(input, output, session, modTrajRibbonPlot = function(input, output, session,
in.data, in.data,
in.data.stim, in.data.stim = NULL,
in.facet = 'group', in.group = 'group',
in.facet.color = NULL, in.group.color = NULL,
in.fname) { in.fname = "trajAverages.pdf") {
ns <- session$ns ns <- session$ns
...@@ -192,7 +210,7 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -192,7 +210,7 @@ modTrajRibbonPlot = function(input, output, session,
callModule(modTrackStats, 'dispTrackStats', callModule(modTrackStats, 'dispTrackStats',
in.data = in.data, in.data = in.data,
in.bycols = in.facet) in.bycols = in.group)
output$outPlotTraj <- renderPlot({ output$outPlotTraj <- renderPlot({
...@@ -222,12 +240,6 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -222,12 +240,6 @@ modTrajRibbonPlot = function(input, output, session,
}) })
# Trajectory plot - download pdf
callModule(downPlot, "downPlotTraj",
in.fname = in.fname,
plotTraj, TRUE)
plotTraj <- function() { plotTraj <- function() {
cat(file = stderr(), 'plotTrajRibbon: in\n') cat(file = stderr(), 'plotTrajRibbon: in\n')
locBut = input$butPlotTraj locBut = input$butPlotTraj
...@@ -249,7 +261,6 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -249,7 +261,6 @@ modTrajRibbonPlot = function(input, output, session,
cat(file = stderr(), 'plotTrajRibbon: stim is NULL\n') cat(file = stderr(), 'plotTrajRibbon: stim is NULL\n')
} else { } else {
cat(file = stderr(), 'plotTrajRibbon: stim not NULL\n') cat(file = stderr(), 'plotTrajRibbon: stim not NULL\n')
# choose only 1st group of stimulation pattern for ribbon plot # choose only 1st group of stimulation pattern for ribbon plot