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

Refactoring: assignments of color palettes when plotting clusters. Make Color Blind palette a default.

modules/auxfunc.R

@@ -62,6 +62,7 @@ COLPOSY = 'pos.y'
 COLIDX = 'IDX'
 COLIDXDIFF = 'IDXdiff'
 COLCL = 'cl'
+COLNTRAJ = "nCells"
 
 # file names
 FCSVOUTLIERS = 'outliers.csv'
@@ -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
-# the number of rows is determined by dendrogram cut
-getClCol <- function(in.dend, in.k) {
+# Returns a table with 2 columns:
+# - gr.no - group numbers, e.g. cluster,
+# - 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 <- loc.col_labels[order(order.dendrogram(in.dend))]
   
   return(unique(
     data.table(
-      cl.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE),
-      cl.col = loc.col_labels
+      gr.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE),
+      gr.col = loc.col_labels
     )
   ))
 }
 
+
 # Custom plotting functions ----
 
 
@@ -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
 LOCplotTraj = function(dt.arg,
                        # input data table
@@ -1062,35 +1098,50 @@ LOCplotTraj = function(dt.arg,
   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,
-                             # input data table
                              x.arg,
-                             # string with column name for x-axis
                              y.arg,
-                             # string with column name for y-axis
                              group.arg = NULL,
-                             # string with column name for grouping time series (here, it's a column corresponding to grouping by condition)
                              col.arg = NULL,
-                             # colour pallette for individual time series
                              dt.stim.arg = NULL,
-                             # data table with stimulation pattern
                              x.stim.arg = c('tstart', 'tend'),
-                             # column names in stimulation dt with x and xend parameters
                              y.stim.arg = c('ystart', 'yend'),
-                             # column names in stimulation dt with y and yend parameters
                              stim.bar.width.arg = 0.5,
                              xlim.arg = NULL,
-                             # limits of x-axis; for visualisation only, not trimmimng data
                              ylim.arg = NULL,
-                             # limits of y-axis; for visualisation only, not trimmimng data
                              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.alpha.arg = 0.5,
                              xlab.arg = NULL,
                              ylab.arg = NULL,
                              plotlab.arg = NULL) {
+  
   p.tmp = ggplot(dt.arg, aes_string(x = x.arg, group = group.arg))
   
   if (!is.null(ribbon.lohi.arg))

modules/clDistPlot.R

@@ -26,10 +26,15 @@ modClDistPlotUI =  function(id, label = "Plot distribution of clusters per group
 
 # Params:
 # in.data - data prepared with data4clDistPlot f-n
-# in.cols - table with 1st column as cluster number, 2nd column colour assignments
-#           prepared with getClColHier
+# in.colors - table with two columns:
+#             - gr.no - with group/cluster number, 
+#             - gr.col - with colour assignments
+#             prepared with getClColHier
 # 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
  
@@ -38,26 +43,23 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
     cat(file = stderr(), 'plotClDist: in\n')
     
     loc.dt = in.data()
-    if (is.null(loc.dt)) {
-      cat(file = stderr(), 'plotClDist: dt is NULL\n')
-      return(NULL)
-    }
+    validate(
+      need(!is.null(loc.dt), "Nothing to plot. Load data first!")
+    )
     
     # 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
-    p.out = ggplot(loc.dt[], aes(x = group, y = nCells)) +
-      geom_bar(aes(fill = as.factor(cl)), stat = 'identity', position = position_fill(reverse = TRUE)) +
+    # result in a stacked bar plot with categories ordered from the bottom to top of the stacked bar
+    p.out = ggplot(loc.dt, aes_string(x = COLGR, y = COLNTRAJ)) +
+      geom_bar(aes_string(fill = paste0("as.factor(", COLCL, ")")), 
+               stat = 'identity', 
+               position = position_fill(reverse = TRUE)) +
       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.")
     else
       p.out = p.out + scale_fill_manual(name = "Cluster no.", 
-                                        values = in.cols()$cl.col) #,
-                                        #breaks = in.cols()$cl.no,
-                                        #labels = in.cols()$cl.no,
-                                        #limits = in.cols()$cl.no)
-    
+                                        values = in.colors()[["gr.col"]])
     
     loc.rads = as.numeric(input$rBAxisLabelsRotate) * pi / 180
     loc.hjust = 0.5*(1-sin(loc.rads))

modules/distPlot.R

@@ -274,15 +274,10 @@ modDistPlot = function(input, output, session,
         else
           NA
       ) 
-
     
-    # If more than max.col groups, cycle through the palette ("Color Blind" can return 10 colors at maximum)
-    loc.pal = "Color Blind"
-    max.col = attr(ggthemes::tableau_color_pal(loc.pal), "max_n")
-    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)]
+    # Get a tableau "Color Blind" palette; recycle 10 available colours, if more groups
+    loc.ngroups = uniqueN(loc.dt[, get(in.cols$group)])
+    loc.col = LOCreturnTableauPalette("Color Blind", loc.ngroups)
     
     p.out = p.out +
       xlab(in.labels$x) +
@@ -295,7 +290,8 @@ modDistPlot = function(input, output, session,
       theme(legend.position = input$selPlotBoxLegendPos,
             axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate), 
                                                     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)

modules/tabClHier.R

@@ -169,11 +169,11 @@ clustHierUI <- function(id, label = "Hierarchical Clustering") {
                withSpinner(plotOutput(ns('outPlotHier')))
       ),
       
-      tabPanel('Averages',
+      tabPanel('Cluster averages',
                br(),
                modTrajRibbonPlotUI(ns('modPlotHierTrajRibbon'))),
       
-      tabPanel('Time series',
+      tabPanel('Time series in clusters',
                br(),
                modTrajPlotUI(ns('modPlotHierTraj'))),
       
@@ -343,8 +343,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
   }) 
   
   
-  # returns table prepared with f-n getClCol
-  # for hierarchical clustering
+  # Returns a table prepared with f-n getClCol
+  # for hierarchical clustering.
+  # The table contains colours assigned to clusters.
+  # Colours are obtained from the dendrogram using dendextend::get_leaves_branches_col
   getClColHier <- reactive({
     cat(file = stderr(), 'getClColHier \n')
     
@@ -352,15 +354,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
     if (is.null(loc.dend))
       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
     # Data is ordered according to the order of clusters specified in this field
     if(input$chBPlotHierClSel) {
-      loc.dt = loc.dt[cl.no %in% input$inPlotHierClSel]
-      loc.dt[, cl.no := factor(cl.no, levels = input$inPlotHierClSel)]
-      setkey(loc.dt, cl.no)
+      # kepp only clusters specified in input$inPlotHierClSel
+      loc.dt = loc.dt[gr.no %in% input$inPlotHierClSel]
+      loc.dt[, gr.no := factor(gr.no, levels = input$inPlotHierClSel)]
     }
+
+    # set the key to allow subsetting
+    setkey(loc.dt, gr.no)
     
     return(loc.dt)
   })
@@ -465,6 +471,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
     
     # get cell id's with associated cluster numbers
     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
     loc.dt.gr = getDataCond()
@@ -473,17 +483,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
       return(NULL)
     }
     
+    # add grouping to clusters+ids
     loc.dt = merge(loc.dt.cl, loc.dt.gr, by = COLID)
     
-    
-    loc.dt.aggr = loc.dt[, .(nCells = .N), by = .(group, cl)]
+    # count number of time series per group, per cluster
+    loc.dt.aggr = loc.dt[, .(xxx = .N), by = c(COLGR, COLCL)]
+    setnames(loc.dt.aggr, "xxx", COLNTRAJ)
     
     # Display clusters specified in the inPlotHierClSel field
     # Data is ordered according to the order of clusters specified in this field
     if(input$chBPlotHierClSel) {
       loc.dt.aggr = loc.dt.aggr[cl %in% input$inPlotHierClSel]
-      loc.dt.aggr[, cl := factor(cl, levels = input$inPlotHierClSel)]
-      setkey(loc.dt.aggr, cl)
+      loc.dt.aggr[, (COLCL) := factor(get(COLCL), levels = input$inPlotHierClSel)]
+      setkeyv(loc.dt.aggr, COLCL)
     }
     return(loc.dt.aggr)
     
@@ -606,7 +618,7 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
   callModule(modTrajPlot, 'modPlotHierTraj', 
              in.data = data4trajPlotCl, 
              in.data.stim = data4stimPlotCl,
-             in.facet = 'cl',  
+             in.facet = COLCL,  
              in.facet.color = getClColHier,
              in.fname = createFnameTrajPlot)
   
@@ -614,21 +626,21 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
   callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon', 
              in.data = data4trajPlotCl, 
              in.data.stim = data4stimPlotCl,
-             in.facet = 'cl',  
-             in.facet.color = getClColHier,
+             in.group = COLCL,  
+             in.group.color = getClColHier,
              in.fname = createFnameRibbonPlot)
   
   # plot cluster PSD
   callModule(modPSDPlot, 'modPlotHierPsd',
              in.data = data4trajPlotCl,
-             in.facet = 'cl',
+             in.facet = COLCL,
              in.facet.color = getClColHier,
              in.fname = createFnamePsdPlot)
   
   # plot distribution barplot
   callModule(modClDistPlot, 'hierClDistPlot', 
              in.data = data4clDistPlot,
-             in.cols = getClColHier,
+             in.colors = getClColHier,
              in.fname = createFnameDistPlot)
   
   

modules/tabClHierSpar.R

@@ -344,8 +344,10 @@ clustHierSpar <- function(input, output, session,
     return(dend)
   })
   
-  # returns table prepared with f-n getClCol
-  # for sparse hierarchical clustering
+  # Returns a table prepared with f-n getClCol
+  # for hierarchical clustering.
+  # The table contains colours assigned to clusters.
+  # Colours are obtained from the dendrogram using dendextend::get_leaves_branches_col
   getClColHierSpar <- reactive({
     cat(file = stderr(), 'getClColHierSpar \n')
     
@@ -353,10 +355,13 @@ clustHierSpar <- function(input, output, session,
     if (is.null(loc.dend))
       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,
     ## the following merge won't work...
     ## 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
     if(input$chBPlotHierSparClSel)
@@ -513,7 +518,6 @@ clustHierSpar <- function(input, output, session,
     # when changing the number of clusters to highlight
     loc.k = returnNclust()
     
-    
     # create column labels according to importance weights
     loc.colnames = paste0(ifelse(loc.hc$ws == 0, "",
                                  ifelse(
@@ -618,7 +622,7 @@ clustHierSpar <- function(input, output, session,
   callModule(modTrajPlot, 'modPlotHierSparTraj', 
              in.data = data4trajPlotClSpar, 
              in.data.stim = data4stimPlotClSpar,
-             in.facet = 'cl', 
+             in.facet = COLCL, 
              in.facet.color = getClColHierSpar,
              in.fname = createFnameTrajPlot)
   
@@ -626,21 +630,21 @@ clustHierSpar <- function(input, output, session,
   callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon', 
              in.data = data4trajPlotClSpar, 
              in.data.stim = data4stimPlotClSpar,
-             in.facet = 'cl',  
-             in.facet.color = getClColHierSpar,
+             in.group = COLCL,  
+             in.group.color = getClColHierSpar,
              in.fname = createFnameRibbonPlot)
   
   # plot cluster PSD
   callModule(modPSDPlot, 'modPlotHierSparPsd',
              in.data = data4trajPlotClSpar,
-             in.facet = 'cl',
+             in.facet = COLCL,
              in.facet.color = getClColHierSpar,
              in.fname = createFnamePsdPlot)
   
   # plot distribution barplot
   callModule(modClDistPlot, 'hierClSparDistPlot', 
              in.data = data4clSparDistPlot,
-             in.cols = getClColHierSpar,
+             in.colors = getClColHierSpar,
              in.fname = createFnameDistPlot)
   
   

modules/tabClValid.R

@@ -318,6 +318,8 @@ clustValid <- function(input, output, session, in.dataWide) {
     if (sum(is.na(loc.dm)) > 0)
       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.col = ggthemes::tableau_color_pal(loc.pal)(n = returnNclust())
     

modules/trajPlot.R

@@ -285,27 +285,17 @@ modTrajPlot = function(input, output, session,
     else
       locObjNum = 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]])
+    # 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.
+    # This might differ if the user selects manually groups (e.g. clusters) to display.
+    if (is.null(in.facet.color)) {
+      loc.facet.color = NULL
+    } else {
+      # get existing groups in dt;
+      loc.facets = unique(loc.dt[, ..in.facet])
       
-      # 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]
+      # subset group-color assignments with existing groups
+      loc.facet.color = in.facet.color()[loc.facets][["gr.col"]]
     }
     
     
@@ -326,7 +316,7 @@ modTrajPlot = function(input, output, session,
       group.arg = COLID,
       facet.arg = in.facet,
       facet.ncol.arg = input$inPlotTrajFacetNcol,
-      facet.color.arg = loc.facet.col, 
+      facet.color.arg = loc.facet.color, 
       dt.stim.arg = loc.dt.stim, 
       x.stim.arg = c('tstart', 'tend'),
       y.stim.arg = c('ystart', 'yend'), 

modules/trajRibbonPlot.R

@@ -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, 
                              in.data, 
-                             in.data.stim,
-                             in.facet = 'group', 
-                             in.facet.color = NULL, 
-                             in.fname) {
+                             in.data.stim = NULL,
+                             in.group = 'group', 
+                             in.group.color = NULL, 
+                             in.fname = "trajAverages.pdf") {
   
   ns <- session$ns
   
@@ -192,7 +210,7 @@ modTrajRibbonPlot = function(input, output, session,
   
   callModule(modTrackStats, 'dispTrackStats',
              in.data = in.data,
-             in.bycols = in.facet)
+             in.bycols = in.group)
   
   
   output$outPlotTraj <- renderPlot({
@@ -222,12 +240,6 @@ modTrajRibbonPlot = function(input, output, session,
   })
   
   
-  
-  # Trajectory plot - download pdf
-  callModule(downPlot, "downPlotTraj", 
-             in.fname = in.fname, 
-             plotTraj, TRUE)
-  
   plotTraj <- function() {
     cat(file = stderr(), 'plotTrajRibbon: in\n')
     locBut = input$butPlotTraj
@@ -249,7 +261,6 @@ modTrajRibbonPlot = function(input, output, session,
       cat(file = stderr(), 'plotTrajRibbon: stim is NULL\n')
     } else {
       cat(file = stderr(), 'plotTrajRibbon: stim not NULL\n')
-      
       # choose only 1st group of stimulation pattern for ribbon plot
       
       loc.groups = unique(loc.dt.stim[['group']])
@@ -259,8 +270,6 @@ modTrajRibbonPlot = function(input, output, session,
       }
     }
     
-    
-    
     # Future: change such that a column with colouring status is chosen by the user
     # colour trajectories, if dataset contains mid.in column
     # with filtering status of trajectory
@@ -284,42 +293,34 @@ modTrajRibbonPlot = function(input, output, session,
     else
       locObjNum = FALSE
     
+    # in.group.color is typically used when plotting time series within clusters.
+    # The number of colours in the palette has to be equal to the number of groups.
+    # This might differ if the user selects manually groups (e.g. clusters) to display.
     
+    # Get existing groups in dt for subsetting externally provided group-color table
+    loc.groups = unique(loc.dt[, ..in.group])
     
-    # 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]
+    if (is.null(in.group.color)) {
+      # Assign ColorBlind palette from Tableau
+      loc.group.color = LOCreturnTableauPalette("Color Blind", nrow(loc.groups))
+    } else {
+      # Use externally provided translation between groups/clusters and colors
+      # Subset group-color assignments with existing groups
+      loc.group.color = in.group.color()[loc.groups][["gr.col"]]
     }
     
-    
     # aggregate data; calculate Mean, CI or SE
     loc.ribbon.lohi = NULL
     
     if(input$rBPlotTrajStat == "Mean") {
       # calculate the mean
-      loc.dt.aggr = loc.dt[, .(Mean = mean(get(COLY), na.rm = T)), by = c(in.facet, COLRT)]
+      loc.dt.aggr = loc.dt[, .(Mean = mean(get(COLY), na.rm = T)), by = c(in.group, COLRT)]
       
     } else if(input$rBPlotTrajStat == "CI") {
       # calculate the mean and the confidence intervals
       loc.dt.aggr = LOCcalcTrajCI(in.dt = loc.dt, 
                                   in.col.meas = COLY, 
-                                  in.col.by = c(in.facet, COLRT), 
+                                  in.col.by = c(in.group, COLRT), 
                                   in.type = 'normal')
       
       loc.ribbon.lohi = c('Lower', 'Upper')
@@ -329,7 +330,7 @@ modTrajRibbonPlot = function(input, output, session,
       loc.dt.aggr = loc.dt[, .(Mean = mean(get(COLY), na.rm = T),
                                Lower = mean(get(COLY), na.rm = T) - LOCstderr(get(COLY), na.rm = T),
                                Upper = mean(get(COLY), na.rm = T) + LOCstderr(get(COLY), na.rm = T)), 
-                           by = c(in.facet, COLRT)]
+                           by = c(in.group, COLRT)]
       
       loc.ribbon.lohi = c('Lower', 'Upper')
     }
@@ -337,7 +338,7 @@ modTrajRibbonPlot = function(input, output, session,
     
     
     # set the grouing column to a factor (for plotting)
-    loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]
+    loc.dt.aggr[, (in.group) := as.factor(get(in.group))]
 
     # setting bounds for displaying of x and y axes
     loc.xlim.arg = NULL
@@ -350,19 +351,11 @@ modTrajRibbonPlot = function(input, output, session,
       loc.ylim.arg = c(input$inSetYboundsLow, input$inSetYboundsHigh)
     } 
     
-    # If more than max.col groups, cycle through the palette ("Color Blind" can return 10 colors at maximum)
-    loc.pal = "Color Blind"
-    max.col = attr(ggthemes::tableau_color_pal(loc.pal), "max_n")
-    loc.col = ggthemes::tableau_color_pal(loc.pal)(n = max.col)
-    ngroups = uniqueN(loc.dt.aggr[, ..in.facet]) - 1
-    loc.col = rep(loc.col, (ngroups %/% max.col) + 1)
-    loc.col = loc.col[1:(ngroups+1)]
-    
     p.out = LOCplotTrajRibbon(dt.arg = loc.dt.aggr, 
                            x.arg = COLRT, 
                            y.arg = 'Mean',
-                           col.arg = loc.facet.col,
-                           group.arg = in.facet,
+                           col.arg = loc.group.color,
+                           group.arg = in.group,
                            dt.stim.arg = loc.dt.stim,
                            x.stim.arg = c('tstart', 'tend'),
                            y.stim.arg = c('ystart', 'yend'), 
@@ -376,9 +369,14 @@ modTrajRibbonPlot = function(input, output, session,
                      in.font.axis.title = PLOTFONTAXISTITLE, 
                      in.font.strip = PLOTFONTFACETSTRIP, 
                      in.font.legend = PLOTFONTLEGEND) + 
-      theme(legend.position = input$rBlegendPos) +
-      scale_colour_manual(values = loc.col)
+      theme(legend.position = input$rBlegendPos) 
     
     return(p.out)
   }
+  
+  # Trajectory plot - download pdf
+  callModule(downPlot, "downPlotTraj", 
+             in.fname = in.fname, 
+             plotTraj, TRUE)
+  
 }
\ No newline at end of file

server.R

@@ -971,6 +971,8 @@ shinyServer(function(input, output, session) {
   callModule(modTrajRibbonPlot, 'modTrajRibbon', 
              in.data = dataLongNoOut,
              in.data.stim = dataStim,
+             in.group = COLGR,
+             in.group.color = NULL,
              in.fname = function() return(FPDFTCMEAN))
   
   # Trajectory plotting - individual
@@ -988,13 +990,19 @@ shinyServer(function(input, output, session) {
   
   <