Mod:

- colours from dendrogram cut match those in the bard plot and in trajectory plot

modules/auxfunc.R

 ## Custom plotting
 require(ggplot2)
+require(RColorBrewer)
+require(gplots) # for heatmap.2
+require(grid) # for modifying grob
 
 rhg_cols <- c(
   "#771C19",
@@ -53,22 +56,23 @@ l.col.pal = list(
 )
 
 
-myGgplotTraj = function(dt.arg,
-                        x.arg,
-                        y.arg,
-                        group.arg,
-                        facet.arg,
-                        facet.ncol.arg = 2,
-                        line.col.arg = NULL,
-                        xlab.arg = NULL,
-                        ylab.arg = NULL,
-                        plotlab.arg = NULL,
-                        dt.stim.arg = NULL,
+myGgplotTraj = function(dt.arg, # data table
+                        x.arg,  # string with column name for x-axis
+                        y.arg, # string with column name for y-axis
+                        group.arg, # string with column name for grouping time series (typicaly cell ID)
+                        facet.arg, # string with column name for facetting
+                        facet.ncol.arg = 2, # default number of facet columns
+                        facet.color.arg = NULL, # vector with list of colours for adding colours to facet names (currently a horizontal line on top of the facet is drawn)
+                        line.col.arg = NULL, # string with column name for colouring time series (typically when individual time series are selected in UI)
+                        xlab.arg = NULL, # string with x-axis label
+                        ylab.arg = NULL, # string with y-axis label
+                        plotlab.arg = NULL, # string with plot label
+                        dt.stim.arg = NULL, # plotting additional dataset; typically to indicate stimulations (not fully implemented yet, not tested!)
                         tfreq.arg = 1,
                         ylim.arg = NULL,
                         stim.bar.height.arg = 0.1,
                         stim.bar.width.arg = 0.5,
-                        aux.label1 = NULL,
+                        aux.label1 = NULL, # 1st point label; used for interactive plotting; displayed in the tooltip; typically used to display values of column holding x & y coordinates
                         aux.label2 = NULL,
                         stat.arg = c('', 'mean', 'CI', 'SE')) {
   
@@ -97,6 +101,21 @@ myGgplotTraj = function(dt.arg,
       scale_color_manual(name = '', 
                          values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green', "NOT SEL" = rhg_cols[7]))
   }
+
+  # this is temporary solution for adding colour according to cluster number
+  # use only when plotting traj from clustering!
+  # a horizontal line is added at the top of data
+  if (!is.null(facet.color.arg)) {
+
+    loc.y.max = max(dt.arg[, c(y.arg), with = FALSE])
+    loc.dt.cl = data.table(xx = 1:length(facet.color.arg), yy = loc.y.max)
+    setnames(loc.dt.cl, 'xx', facet.arg)
+    
+    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,
+                          name = '')
+  }
   
   if ('mean' %in% loc.stat)
     p.tmp = p.tmp + 
@@ -175,7 +194,10 @@ myGgplotTraj = function(dt.arg,
       legend.position = "top"
     )
   
-  p.tmp
+  
+
+  
+  return(p.tmp)
 }
 
 

modules/clDistPlot.R

@@ -9,7 +9,13 @@ modClDistPlotUI =  function(id, label = "Plot Fractions WIthin Clusters") {
 }
 
 
-modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf') {
+
+# 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.fname - file name for plot download
+modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fname = 'clDist.pdf') {
   
   ns <- session$ns
  
@@ -24,18 +30,26 @@ modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf
     }
     
     p.out = ggplot(loc.dt, aes(x = group, y = nCells)) +
-      geom_bar(aes(fill = as.factor(cl)), stat = 'identity', position = 'fill') +
+      geom_bar(aes(fill = as.factor(cl)), stat = 'identity', position = 'fill')
+    
+    if(is.null(in.cols))
+      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)
+    
+    
+    p.out = p.out + 
       scale_y_continuous(labels = percent) +
       ylab("percentage of cells\n") +  
       xlab("") +  
-      scale_fill_discrete(name = "Cluster no.") +
       myGgplotTheme
     
     return(p.out)
     
   }
   
-  #  Hierarchical - display bar plot
+  #  display bar plot
   output$outPlotClDist <- renderPlot({
     locBut = input$butPlotClDist
     
@@ -48,7 +62,7 @@ modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf
     plotClDist()
   })
   
-  # Hierarchical - Bar Plot - download pdf
+  # bar Plot - download pdf
   callModule(downPlot, "downPlotClDist", in.fname, plotClDist, TRUE)
   
 }
\ No newline at end of file

modules/downPlot.R

@@ -58,9 +58,16 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
           height = input$inPlotHeight
         )
       } else {
-        pdf(file,
-            width  = input$inPlotWidth,
-            height = input$inPlotHeight)
+        if (in.fname %like% 'pdf') {
+          pdf(file,
+              width  = input$inPlotWidth,
+              height = input$inPlotHeight)
+        } else {
+          png(file,
+              width  = input$inPlotWidth,
+              height = input$inPlotHeight, units = 'in', res = 300)
+        }
+        
         
         in.plot()
         dev.off()

modules/trajPlot.R

@@ -51,7 +51,7 @@ modTrajPlotUI =  function(id, label = "Plot Individual Time Series") {
 }
 
 
-modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.fname = 'tCourses.pdf') {
+modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.facet.color = NULL, in.fname = 'tCourses.pdf') {
   
   ns <- session$ns
   
@@ -145,6 +145,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,
       xlab.arg = 'Time (min)',
       line.col.arg = loc.line.col.arg,
       aux.label1 = if (locPos) 'pos.x' else NULL,

server.R

@@ -15,6 +15,7 @@ library(gplots) # for heatmap.2
 library(plotly)
 library(d3heatmap) # for interactive heatmap
 library(dendextend) # for color_branches
+library(colorspace) # for palettes (ised to colour dendrogram)
 library(RColorBrewer)
 library(sparcl) # sparse hierarchical and k-means
 library(scales) # for percentages on y scale
@@ -690,10 +691,14 @@ shinyServer(function(input, output, session) {
     }
   })
   
+  # perform hierarchical clustering and return dendrogram coloured according to cutree
+  # branch coloring performed using dendextend package
   userFitDendHier <- reactive({
+    cat(file = stderr(), 'userFitDendHier \n')
+
     dm.t = data4clust()
     if (is.null(dm.t)) {
-      return()
+      return(NULL)
     }
     
     cl.dist = dist(dm.t, method = s.cl.diss[as.numeric(input$selectPlotHierDiss)])
@@ -701,12 +706,40 @@ shinyServer(function(input, output, session) {
     cl.lev = rev(row.names(dm.t))
     
     dend <- as.dendrogram(cl.hc)
-    dend <- color_branches(dend, k = input$inPlotHierNclust)
+    dend <- color_branches(dend, 
+                           col = rainbow_hcl, # make sure that n here equals max in the input$inPlotHierNclust slider
+                           k = input$inPlotHierNclust)
     
     return(dend)
   })
   
-  # Function instead of reactive as per:
+  # 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) {
+    
+    loc.col_labels <- 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)))
+  }
+  
+  # returns table prepared with f-n getClCol
+  # for hierarchical clustering
+  getClColHier <- reactive({
+    cat(file = stderr(), 'getClColHier \n')
+    
+    loc.dend = userFitDendHier()
+    if (is.null(loc.dend))
+      return(NULL)
+    
+    return(getClCol(loc.dend, input$inPlotHierNclust))
+  })
+  
+
+  
+    # Function instead of reactive as per:
   # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
   # This function is used to plot and to downoad a pdf
   plotHier <- function() {
@@ -767,7 +800,11 @@ shinyServer(function(input, output, session) {
     return(loc.dt)    
   })
   
-  callModule(modTrajPlot, 'modPlotHierTraj', data4trajPlotCl, 'cl',  paste0('clust_hierch_tCourses_',
+  callModule(modTrajPlot, 'modPlotHierTraj', 
+             in.data = data4trajPlotCl, 
+             in.facet = 'cl',  
+             in.facet.color = getClColHier,
+             in.fname = paste0('clust_hierch_tCourses_',
                                                                             s.cl.diss[as.numeric(input$selectPlotHierDiss)],
                                                                             '_',
                                                                             s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
@@ -872,10 +909,12 @@ shinyServer(function(input, output, session) {
   callModule(downPlot, "downPlotHier",       paste0('clust_hierch_heatMap_',
                                                     s.cl.diss[as.numeric(input$selectPlotHierDiss)],
                                                     '_',
-                                                    s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'), plotHier)
+                                                    s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.png'), plotHier)
 
-  callModule(modClDistPlot, 'hierClDistPlot', data4clDistPlot,
-             paste0('clust_hierch_clDist_',
+  callModule(modClDistPlot, 'hierClDistPlot', 
+             in.data = data4clDistPlot,
+             in.cols = getClColHier,
+             in.fname = paste0('clust_hierch_clDist_',
                     s.cl.diss[as.numeric(input$selectPlotHierDiss)],
                     '_',
                     s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
@@ -958,10 +997,25 @@ shinyServer(function(input, output, session) {
     }
     
     dend <- as.dendrogram(sparsehc$hc)
-    dend <- color_branches(dend, k = input$inPlotHierSparNclust)
+    dend <- color_branches(dend, 
+                           col = rainbow_hcl,
+                           k = input$inPlotHierSparNclust)
     
     return(dend)
   })
+
+  # returns table prepared with f-n getClCol
+  # for sparse hierarchical clustering
+  getClColHierSpar <- reactive({
+    cat(file = stderr(), 'getClColHierSpar \n')
+    
+    loc.dend = userFitDendHierSpar()
+    if (is.null(loc.dend))
+      return(NULL)
+    
+    return(getClCol(loc.dend, input$inPlotHierNclust))
+  })
+  
   
   # Function instead of reactive as per:
   # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
@@ -974,10 +1028,8 @@ shinyServer(function(input, output, session) {
     }
     
     sparsehc <- userFitHierSpar()
-    
-    loc.dend <- as.dendrogram(sparsehc$hc)
-    loc.dend <- color_branches(loc.dend, k = input$inPlotHierSparNclust)
-    
+    loc.dend <- userFitDendHierSpar()
+
     loc.colnames = paste0(ifelse(sparsehc$ws == 0, "",
                                  ifelse(
                                    sparsehc$ws <= 0.1,
@@ -1042,7 +1094,11 @@ shinyServer(function(input, output, session) {
     return(loc.dt)    
   })
   
-  callModule(modTrajPlot, 'modPlotHierSparTraj', data4trajPlotClSpar, 'cl', paste0('clust_hierchSparse_tCourses_',
+  callModule(modTrajPlot, 'modPlotHierSparTraj', 
+             in.data = data4trajPlotClSpar, 
+             in.facet = 'cl', 
+             in.facet.color = getClColHierSpar,
+             paste0('clust_hierchSparse_tCourses_',
                                                                                    s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
                                                                                    '_',
                                                                                    s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'))
@@ -1083,8 +1139,10 @@ shinyServer(function(input, output, session) {
     
   })
   
-  callModule(modClDistPlot, 'hierClSparDistPlot', data4clSparDistPlot,
-             paste0('clust_hierchSparse_clDist_',
+  callModule(modClDistPlot, 'hierClSparDistPlot', 
+             in.data = data4clSparDistPlot,
+             in.cols = getClColHierSpar,
+             in.fname = paste0('clust_hierchSparse_clDist_',
                     s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
                     '_',
                     s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'))