Addded: an option to manually set bounds for heatmap colour scale

modules/auxfunc.R

@@ -456,14 +456,17 @@ myPlotHeatmap <- function(data.arg,
                           labCol.arg = NULL,
                           font.row.arg = 1,
                           font.col.arg = 1,
+                          breaks.arg = NULL,
                           title.arg = 'Clustering') {
   
+  loc.n.colbreaks = 99
+  
   if (palette.rev.arg)
     my_palette <-
-    rev(colorRampPalette(brewer.pal(9, palette.arg))(n = 99))
+    rev(colorRampPalette(brewer.pal(9, palette.arg))(n = loc.n.colbreaks))
   else
     my_palette <-
-    colorRampPalette(brewer.pal(9, palette.arg))(n = 99)
+    colorRampPalette(brewer.pal(9, palette.arg))(n = loc.n.colbreaks)
   
   
   col_labels <- get_leaves_branches_col(dend.arg)
@@ -501,7 +504,8 @@ myPlotHeatmap <- function(data.arg,
     cexCol = font.col.arg,
     main = title.arg,
     symbreaks = FALSE,
-    symkey = FALSE
+    symkey = FALSE,
+    breaks = if (is.null(breaks.arg)) NULL else seq(breaks.arg[1], breaks.arg[2], length.out = loc.n.colbreaks+1)
   )
   
   return(loc.p)

modules/tabClHier.R

@@ -65,7 +65,17 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
                           selected = 'Rainbow'
                         ),
 
-                        checkboxInput(ns('selectPlotHierKey'), 'Plot colour key', TRUE)
+                        checkboxInput(ns('selectPlotHierKey'), 'Plot colour key', TRUE),
+                        checkboxInput(ns('chBsetColBounds'), 'Set bounds for colour scale', FALSE),
+                        
+                        fluidRow(
+                          column(3,
+                                 uiOutput(ns('uiSetColBoundsLow'))
+                          ),
+                          column(3,
+                                 uiOutput(ns('uiSetColBoundsHigh'))
+                          )
+                        )
                  ),
                  column(3,
                         selectInput(
@@ -175,6 +185,39 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
     }
   })
   
+  output$uiSetColBoundsLow = renderUI({
+    ns <- session$ns
+    
+    if(input$chBsetColBounds) {
+
+      loc.dt = in.data4trajPlot()
+
+      numericInput(
+        ns('inSetColBoundsLow'),
+        label = 'Lower',
+        step = 0.1, 
+        value = floor(min(loc.dt[['y']], na.rm = T))
+      )
+    }
+  })
+  
+  
+  output$uiSetColBoundsHigh = renderUI({
+    ns <- session$ns
+    
+    if(input$chBsetColBounds) {
+
+      loc.dt = in.data4trajPlot()
+      
+      numericInput(
+        ns('inSetColBoundsHigh'),
+        label = 'Upper',
+        step = 0.1, 
+        value = ceil(max(loc.dt[['y']], na.rm = T))
+      )
+    }
+  })
+  
   # calculate distance matrix for further clustering
   # time series arranged in rows with columns corresponding to time points
   userFitDistHier <- reactive({
@@ -365,6 +408,13 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
     if (is.null(loc.dend))
       return(NULL)
     
+    loc.col.bounds = NULL
+    if (input$chBsetColBounds)
+      loc.col.bounds = c(input$inSetColBoundsLow, input$inSetColBoundsHigh)
+    else 
+      loc.col.bounds = NULL
+    
+    
     loc.p = myPlotHeatmap(loc.dm,
                           loc.dend, 
                           palette.arg = input$selectPlotHierPalette, 
@@ -376,6 +426,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
                           nacol.arg = input$inPlotHierNAcolor, 
                           font.row.arg = input$inPlotHierFontX, 
                           font.col.arg = input$inPlotHierFontY, 
+                          breaks.arg = loc.col.bounds,
                           title.arg = paste0(
                             "Distance measure: ",
                             s.cl.diss[as.numeric(input$selectPlotHierDiss)],

modules/tabClHierSpar.R

@@ -70,7 +70,19 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
                           selected = 'Spectral'
                         ),
                         checkboxInput(ns('inPlotHierSparRevPalette'), 'Reverse colour palette', TRUE),
-                        checkboxInput(ns('selectPlotHierSparKey'), 'Plot colour key', TRUE)
+                        checkboxInput(ns('selectPlotHierSparKey'), 'Plot colour key', TRUE),
+                        
+                        checkboxInput(ns('chBsetColBounds'), 'Set bounds for colour scale', FALSE),
+                        
+                        fluidRow(
+                          column(3,
+                                 uiOutput(ns('uiSetColBoundsLow'))
+                          ),
+                          column(3,
+                                 uiOutput(ns('uiSetColBoundsHigh'))
+                          )
+                        )
+                        
                  ),
                  column(3,
                         sliderInput(
@@ -189,6 +201,39 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
       )
   })
   
+  output$uiSetColBoundsLow = renderUI({
+    ns <- session$ns
+    
+    if(input$chBsetColBounds) {
+      
+      loc.dt = in.data4trajPlot()
+      
+      numericInput(
+        ns('inSetColBoundsLow'),
+        label = 'Lower',
+        step = 0.1, 
+        value = floor(min(loc.dt[['y']], na.rm = T))
+      )
+    }
+  })
+  
+  
+  output$uiSetColBoundsHigh = renderUI({
+    ns <- session$ns
+    
+    if(input$chBsetColBounds) {
+      
+      loc.dt = in.data4trajPlot()
+      
+      numericInput(
+        ns('inSetColBoundsHigh'),
+        label = 'Upper',
+        step = 0.1, 
+        value = ceil(max(loc.dt[['y']], na.rm = T))
+      )
+    }
+  })
+  
   # UI for advanced options
   output$uiPlotHierSparNiter = renderUI({
     ns <- session$ns
@@ -422,6 +467,13 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
                             ifelse(sparsehc$ws <= 0.5, "green", "red")
                           ))
     
+    loc.col.bounds = NULL
+    if (input$chBsetColBounds)
+      loc.col.bounds = c(input$inSetColBoundsLow, input$inSetColBoundsHigh)
+    else 
+      loc.col.bounds = NULL
+    
+    
     loc.p = myPlotHeatmap(loc.dm,
                           loc.dend, 
                           palette.arg = input$selectPlotHierSparPalette, 
@@ -435,6 +487,7 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
                           labCol.arg = loc.colnames,
                           font.row.arg = input$inPlotHierSparFontX, 
                           font.col.arg = input$inPlotHierSparFontY, 
+                          breaks.arg = loc.col.bounds,
                           title.arg = paste(
                             "Distance measure: ",
                             s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],