Merge pull request #6 from HendrikSchultheis/scatterplot

Scatterplot & some fixes
loosolab · Feb 13, 2018 · 9492c1b · 9492c1b
2 parents 37b218f + 0b80bcc
commit 9492c1b
Show file tree

Hide file tree

Showing 10 changed files with 205 additions and 53 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -19,7 +19,7 @@ Imports: shiny,
     plotly,
     scales,
     shinydashboard,
-    DT,
+    DT (>= 0.3),
     colourpicker,
     RColorBrewer,
     shinyjs,
@@ -42,7 +42,7 @@ Imports: shiny,
     rjson,
     FactoMineR,
     factoextra,
-    heatmaply,
+    heatmaply (>= 0.14.1),
     shinyBS,
     shinythemes,
     shinycssloaders

diff --git a/R/columnSelector.R b/R/columnSelector.R
@@ -141,7 +141,7 @@ columnSelector <- function(input, output, session, type.columns, type = NULL, co
   })
 
   out.type <- shiny::reactive(input$select.type)
-  out.selectedColumns <- shiny::reactive(ifelse(input$select.column == "None", "", input$select.column))
+  out.selectedColumns <- shiny::reactive(if(shiny::isTruthy(input$select.column) && input$select.column != "None") input$select.column else "")
   out.label <- shiny::reactive({
     if(is.null(input$select.label)) {
       label <- create_label()

diff --git a/R/featureSelector.R b/R/featureSelector.R
@@ -204,7 +204,7 @@ featureSelector <- function(input, output, session, data, features = NULL, featu
   })
 
   # access data table information
-  proxy <- DT::dataTableProxy(session$ns("table"))
+  proxy <- DT::dataTableProxy("table")
 
   # select rows via row_selector
   shiny::observe({

diff --git a/R/function.R b/R/function.R
@@ -478,14 +478,12 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label
     #layout
     plot <- heatmaply::heatmaply(plot,
                                  plot_method = "ggplot",
+                                 node_type = "heatmap",
                                  scale_fill_gradient_fun = ggplot2::scale_fill_gradientn(colors = colors, name = unitlabel, limits = winsorize.colors, oob = scales::squish),
                                  heatmap_layers = ggplot2::theme(text = ggplot2::element_text(size = 12 * scale))
     )
 
-    # scale axis ticks
-    ticks <- list(tickfont = list(size = 12 * scale))
-
-    plot <- plotly::layout(plot, autosize = ifelse(width == "auto", TRUE, FALSE), margin = list(l = rowlabel_size, r = legend, b = collabel_size), xaxis = ticks, yaxis2 = ticks)
+    plot <- plotly::layout(plot, autosize = ifelse(width == "auto", TRUE, FALSE), margin = list(l = rowlabel_size, r = legend, b = collabel_size), showlegend = FALSE)
 
     # decide which sizes should be used
     if(width == "auto") {
@@ -516,14 +514,16 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label
     plot$x$layout$width <- width
     plot$x$layout$height <- height
 
-    #address correct axis
+    # address correct axis
+    # scale axis tickfont
+    ticks <- list(size = 12 * scale)
     if(clustering == "both" || clustering == "column"){
-      plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label),
-                             yaxis2 = list(showticklabels = row.label)
+      plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label, tickfont = ticks),
+                             yaxis2 = list(showticklabels = row.label, tickfont = ticks)
       )
     }else if(clustering == "row" || clustering == "none"){
-      plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label),
-                             yaxis = list(showticklabels = row.label)
+      plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label, tickfont = ticks),
+                             yaxis = list(showticklabels = row.label, tickfont = ticks)
       )
     }
 
@@ -572,7 +572,7 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label
     row.names(prep.data) <- row.label.strings
     colnames(prep.data) <- column.label.strings
 
-    plot <- ComplexHeatmap::Heatmap(
+    plot <- try(ComplexHeatmap::Heatmap(
       prep.data,
       name = unitlabel,
       col = colors,
@@ -602,7 +602,7 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label
         labels_gp = grid::gpar(fontsize = 8 * scale),
         grid_height = grid::unit(0.15 * scale, "inches")
       )
-    )
+    ))
 
     #width/ height calculation
     col_names_maxlength_label_width=max(sapply(colnames(prep.data), graphics::strwidth, units="in", font = 12))	#longest column label when plotted in inches

diff --git a/R/global_cor_heatmap.R b/R/global_cor_heatmap.R
@@ -258,9 +258,24 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
     rintrojs::introjs(session, options = list(steps = guide()))
   })
 
+  # show warning if not enough columns selected
+  shiny::observe({
+    shiny::req(columns$selectedColumns())
+
+    if(length(columns$selectedColumns()) < 2) {
+      shiny::showNotification(
+        ui = "Warning! At least two columns needed. Please select more.",
+        id = "less_data_warning",
+        type = "warning"
+      )
+    } else {
+      shiny::removeNotification("less_data_warning")
+    }
+  })
+
   # enable/ disable plot button
   shiny::observe({
-    if(length(columns$selectedColumns()) <= 1) {
+    if(!shiny::isTruthy(columns$selectedColumns()) || length(columns$selectedColumns()) < 2) {
       shinyjs::disable("plot")
     }else {
       shinyjs::enable("plot")

diff --git a/R/heatmap.R b/R/heatmap.R
@@ -158,7 +158,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
   shiny::observe({
     shiny::req(data.r())
 
-    if(length(columns$selectedColumns()) > 0){
+    if(shiny::isTruthy(columns$selectedColumns())){
       if(input$clustering != "none") { # clustering
         if(plot.method == "static" && nrow(data.r()) > static) { # cluster limitation (static)
           shiny::showNotification(
@@ -289,6 +289,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
       plot.method = plot.method,
       winsorize.colors = colorPicker()$winsorize
     )
+
     progress$set(1)
 
     return(plot)
@@ -335,6 +336,12 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
 
           plot <- plot()$plot
 
+          # handle error
+          if(is(plot, "try-error")) {
+            # TODO add logging
+            stop("An error occured! Please try a different dataset.")
+          }
+
           progress$set(1)
           return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
         }
@@ -372,20 +379,45 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
     all <- list(selection = selection, clustering = clustering, options = options)
   })
 
-  #enable/ disable plot button
+  # enable/ disable plot button
+  # show warning if disabled
   shiny::observe({
-    if(length(columns$selectedColumns()) <= 0){ # columns selected
-      shinyjs::disable("plot")
-    } else {
-      # clustering
-      if(input$clustering != "none") {
-        if(plot.method == "static" && nrow(data.r()) > static || plot.method == "interactive" && nrow(data.r()) > interactive) {
-          shinyjs::disable("plot")
-        } else {
+    shinyjs::disable("plot")
+    show_warning <- TRUE
+
+    # are columns selected?
+    if(shiny::isTruthy(columns$selectedColumns())) {
+      row.num <- nrow(shiny::isolate(data.r()))
+      col.num <- length(columns$selectedColumns())
+
+      # minimal heatmap possible (greater 1x1)?
+      if(row.num > 1 || col.num > 1) {
+        # no clustering for single rows or columns
+        if(row.num == 1 && !is.element(input$clustering, c("both", "row"))) {
+          show_warning <- FALSE
+          shinyjs::enable("plot")
+        } else if(col.num == 1 && !is.element(input$clustering, c("both", "column"))) {
+          show_warning <- FALSE
+          shinyjs::enable("plot")
+        } else if(row.num > 1 && col.num > 1) { # no border case heatmaps
+          show_warning <- FALSE
           shinyjs::enable("plot")
         }
+      }
+
+      if(show_warning) {
+        shiny::showNotification(
+          ui = "Warning! Insufficient columns/ rows. Either disable the respective clustering or expand the dataset.",
+          id = "insuf_data",
+          type = "warning"
+        )
       } else {
-        shinyjs::enable("plot")
+        shiny::removeNotification("insuf_data")
+      }
+
+      # maximum heatmap reached?
+      if(plot.method == "static" && row.num > static || plot.method == "interactive" && row.num > interactive) {
+        shinyjs::disable("plot")
       }
     }
   })

diff --git a/R/pca.R b/R/pca.R
@@ -171,21 +171,16 @@ pca <- function(input, output, session, data, types, levels = NULL, entryLabel =
 
   #update dimension inputs
   shiny::observe({
-    col.num <- length(columnSelect$selectedColumns())
-    if(col.num < 3 | nrow(data.r()) < 3 | is.na(input$dimA) | is.na(input$dimB)){
+    col.num <- length(shiny::req(columnSelect$selectedColumns()))
+    if(col.num < 3 || nrow(shiny::isolate(data.r())) < 3 || is.na(input$dimA) || is.na(input$dimB)){
       shinyjs::disable("plot")
 
       # show warning if not enough selected
-      if(col.num > 0) {
-        shiny::showNotification(
-          ui = "Not enough columns selected! At least 3 needed for plotting.",
-          id = "warning",
-          type = "warning"
-        )
-      }else {
-        shiny::removeNotification("warning")
-      }
-
+      shiny::showNotification(
+        ui = "Not enough columns/ rows selected! At least 3 of each needed for plotting.",
+        id = "warning",
+        type = "warning"
+      )
     }else{
       shiny::removeNotification("warning")
       shinyjs::enable("plot")