Viewport

R/geneView.R

@@ -98,6 +98,7 @@ geneViewUI <- function(id, plot.columns = 3){
 #' @param width Width of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
 #' @param height Height of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
 #' @param ppi Pixel per inch. Defaults to 72 and supports reactive.
+#' @param scale Scale plot size. Defaults to 1, supports reactive.
 #'
 #' @details Width/ height/ ppi less or equal to default will use default value.
 #' @details Ppi less or equal to zero will use default.
@@ -106,7 +107,7 @@ geneViewUI <- function(id, plot.columns = 3){
 #'
 #' @export
 
-geneView <- function(input, output, session, data, metadata, level = NULL, plot.method = "static", custom.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72){
+geneView <- function(input, output, session, data, metadata, level = NULL, plot.method = "static", custom.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72, scale = 1){
   #handle reactive data
   data.r <- shiny::reactive({
     if(shiny::is.reactive(data)){
@@ -136,6 +137,7 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
     width <- ifelse(shiny::is.reactive(width), width(), width)
     height <- ifelse(shiny::is.reactive(height), height(), height)
     ppi <- ifelse(shiny::is.reactive(ppi), ppi(), ppi)
+    scale <- ifelse(shiny::is.reactive(scale), scale(), scale)
 
     if(!is.numeric(width) || width <= 0) {
       width <- "auto"
@@ -149,7 +151,8 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
 
     list(width = width,
          height = height,
-         ppi = ppi)
+         ppi = ppi,
+         scale = scale)
   })
 
   #Fetch the reactive guide for this module
@@ -158,6 +161,10 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
     rintrojs::introjs(session, options = list(steps = guide()))
   })
 
+  # clear plot
+  clearPlot <- shiny::reactiveVal(FALSE)
+
+  # reset
   shiny::observeEvent(input$reset, {
     shinyjs::reset("genes")
     shinyjs::reset("plotType")
@@ -170,6 +177,7 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
       custom_label <<- shiny::callModule(label, "labeller", data = custom.label, sep = label.sep)
     }
     limiter <<- shiny::callModule(limit, "limit", lower = shiny::reactive(get_limits()[1]), upper = shiny::reactive(get_limits()[2]))
+    clearPlot(TRUE)
   })
 
   get_limits <- shiny::reactive({
@@ -255,6 +263,7 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
   plot <- shiny::eventReactive(input$plot, {
     # enable downloadButton
     shinyjs::enable("download")
+    clearPlot(FALSE)
 
     #new progress indicator
     progress <- shiny::Progress$new()
@@ -282,7 +291,8 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
       plot.method = plot.method,
       width = size()$width,
       height = size()$height,
-      ppi = size()$ppi
+      ppi = size()$ppi,
+      scale = size()$scale
     )
 
     progress$set(1, detail = "Return plot")
@@ -327,30 +337,38 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
 
   if(plot.method == "interactive") {
     output$interactive <- plotly::renderPlotly({
-      #progress indicator
-      progress <- shiny::Progress$new()
-      on.exit(progress$close())
-      progress$set(message = "Rendering plot", value = 0)
-
-      plot <- plot()$plot
-
-      progress$set(value = 1)
-      return(plot)
-    })
-  } else if(plot.method == "static") {
-    output$static <- shiny::renderPlot(
-      width = shiny::reactive(plot()$width * (plot()$ppi / 2.54)),
-      height = shiny::reactive(plot()$height * (plot()$ppi / 2.54)),
-      {
+      if(clearPlot()) {
+        return()
+      } else {
         #progress indicator
         progress <- shiny::Progress$new()
         on.exit(progress$close())
-        progress$set(message = "Rendering plot", value = 0.3)
+        progress$set(message = "Rendering plot", value = 0)
 
         plot <- plot()$plot
 
         progress$set(value = 1)
         return(plot)
+      }
+    })
+  } else if(plot.method == "static") {
+    output$static <- shiny::renderPlot(
+      width = shiny::reactive(plot()$width * (plot()$ppi / 2.54)),
+      height = shiny::reactive(plot()$height * (plot()$ppi / 2.54)),
+      {
+        if(clearPlot()) {
+          return()
+        } else {
+          #progress indicator
+          progress <- shiny::Progress$new()
+          on.exit(progress$close())
+          progress$set(message = "Rendering plot", value = 0.3)
+
+          plot <- plot()$plot
+
+          progress$set(value = 1)
+          return(plot)
+        }
       })
   }
 

R/global_cor_heatmap.R

@@ -157,13 +157,14 @@ global_cor_heatmapUI <- function(id) {
 #' @param width Width of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
 #' @param height Height of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
 #' @param ppi Pixel per inch. Defaults to 72 and supports reactive.
+#' @param scale Scale plot size. Defaults to 1, supports reactive.
 #'
 #'
 #'
 #' @return Reactive containing data used for plotting.
 #'
 #' @export
-global_cor_heatmap <- function(input, output, session, data, types, plot.method = "static", width = "auto", height = "auto", ppi = 72) {
+global_cor_heatmap <- function(input, output, session, data, types, plot.method = "static", width = "auto", height = "auto", ppi = 72, scale = 1) {
   # load module -------------------------------------------------------------
   # handle reactive data
   data_r <- shiny::reactive({
@@ -180,6 +181,7 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
     width <- ifelse(shiny::is.reactive(width), width(), width)
     height <- ifelse(shiny::is.reactive(height), height(), height)
     ppi <- ifelse(shiny::is.reactive(ppi), ppi(), ppi)
+    scale <- ifelse(shiny::is.reactive(scale), scale(), scale)
 
     if(!is.numeric(width) || width <= 0) {
       width <- "auto"
@@ -197,7 +199,8 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
 
     list(width = width,
          height = height,
-         ppi = ppi)
+         ppi = ppi,
+         scale = scale)
   })
 
   # load internal modules
@@ -217,6 +220,9 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
   }
 
   # functionality -----------------------------------------------------------
+  # clear plot
+  clearPlot <- shiny::reactiveVal(FALSE)
+
   # reset ui
   shiny::observeEvent(input$reset, {
     shinyjs::reset("calc")
@@ -230,6 +236,7 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
     columns <<- shiny::callModule(columnSelector, "select", type.columns = types, columnTypeLabel = "Column types to choose from")
     transform <<- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(data_r()[, columns$selectedColumns(), with = FALSE])))
     colorPicker <<- shiny::callModule(colorPicker2, "color", distribution = shiny::reactive(tolower(input$distribution)), winsorize = shiny::reactive(equalize(result_data()[, -1])))
+    clearPlot(TRUE)
   })
 
   # warning if plot size exceeds limits
@@ -308,6 +315,8 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
   plot <- shiny::eventReactive(input$plot, {
     # enable downloadButton
     shinyjs::enable("download")
+    # show plot
+    clearPlot(FALSE)
 
     # progress indicator
     progress <- shiny::Progress$new()
@@ -346,7 +355,8 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
       height = size()$height,
       ppi = size()$ppi,
       plot.method = plot.method,
-      winsorize.colors = colorPicker()$winsorize
+      winsorize.colors = colorPicker()$winsorize,
+      scale = size()$scale
     )
 
     # update progress indicator
@@ -361,34 +371,42 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
       width = shiny::reactive(plot()$width * (plot()$ppi / 2.54)),
       height = shiny::reactive(plot()$height * (plot()$ppi / 2.54)),
       {
+        if(clearPlot()) {
+          return()
+        } else {
+          # progress indicator
+          progress <- shiny::Progress$new()
+          on.exit(progress$close())
+          progress$set(0.2, message = "Rendering plot")
+
+          # get plot
+          plot <- plot()$plot
+
+          # update progress indicator
+          progress$set(1)
+
+          # draw plot
+          return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
+        }
+      }
+    )
+  }else if(plot.method == "interactive") {
+    output$interactive <- plotly::renderPlotly({
+      if(clearPlot()) {
+        return()
+      } else {
         # progress indicator
         progress <- shiny::Progress$new()
         on.exit(progress$close())
         progress$set(0.2, message = "Rendering plot")
 
-        # get plot
         plot <- plot()$plot
 
         # update progress indicator
         progress$set(1)
 
-        # draw plot
-        return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
+        return(plot)
       }
-    )
-  }else if(plot.method == "interactive") {
-    output$interactive <- plotly::renderPlotly({
-      # progress indicator
-      progress <- shiny::Progress$new()
-      on.exit(progress$close())
-      progress$set(0.2, message = "Rendering plot")
-
-      plot <- plot()$plot
-
-      # update progress indicator
-      progress$set(1)
-
-      return(plot)
     })
   }
 

R/heatmap.R

@@ -103,11 +103,12 @@ heatmapUI <- function(id, row.label = TRUE) {
 #' @param width Width of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
 #' @param height Height of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
 #' @param ppi Pixel per inch. Defaults to 72 and supports reactive.
+#' @param scale Scale plot size. Defaults to 1, supports reactive.
 #'
 #' @return Reactive containing data used for plotting.
 #'
 #' @export
-heatmap <- function(input, output, session, data, types, plot.method = "static", custom.row.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72) {
+heatmap <- function(input, output, session, data, types, plot.method = "static", custom.row.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72, scale = 1) {
   # cluster limitation
   static <- 11000
   interactive <- 3000
@@ -125,6 +126,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
     width <- ifelse(shiny::is.reactive(width), width(), width)
     height <- ifelse(shiny::is.reactive(height), height(), height)
     ppi <- ifelse(shiny::is.reactive(ppi), ppi(), ppi)
+    scale <- ifelse(shiny::is.reactive(scale), scale(), scale)
 
     if(!is.numeric(width) || width <= 0) {
       width <- "auto"
@@ -142,7 +144,8 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
 
     list(width = width,
          height = height,
-         ppi = ppi)
+         ppi = ppi,
+         scale = scale)
   })
 
   # Fetch the reactive guide for this module
@@ -205,7 +208,10 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
     }
   })
 
-  #reset ui
+  # clear plot
+  clearPlot <- shiny::reactiveVal(FALSE)
+
+  # reset ui
   shiny::observeEvent(input$reset, {
     shinyjs::reset("cluster.distance")
     shinyjs::reset("cluster.method")
@@ -220,6 +226,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
     if(!is.null(custom.row.label)) {
       custom_label <<- shiny::callModule(label, "labeller", data = custom.row.label, label = "Select row label", sep = label.sep, disable = shiny::reactive(!input$row.label))
     }
+    clearPlot(TRUE)
   })
 
   columns <- shiny::callModule(columnSelector, "select", type.columns = types, columnTypeLabel = "Column types to choose from")
@@ -249,6 +256,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
   plot <- shiny::eventReactive(input$plot, {
     # enable downloadButton
     shinyjs::enable("download")
+    clearPlot(FALSE)
 
     #new progress indicator
     progress <- shiny::Progress$new()
@@ -277,6 +285,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
       width = size()$width,
       height = size()$height,
       ppi = size()$ppi,
+      scale = size()$scale,
       plot.method = plot.method,
       winsorize.colors = colorPicker()$winsorize
     )
@@ -292,16 +301,20 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
     })
 
     output$interactive <- plotly::renderPlotly({
-      #new progress indicator
-      progress <- shiny::Progress$new()
-      on.exit(progress$close())
-      progress$set(0.2, message = "Render plot")
+      if(clearPlot()) {
+        return()
+      } else {
+        #new progress indicator
+        progress <- shiny::Progress$new()
+        on.exit(progress$close())
+        progress$set(0.2, message = "Render plot")
 
-      plot <- plot()$plot
+        plot <- plot()$plot
 
-      progress$set(1)
+        progress$set(1)
 
-      return(plot)
+        return(plot)
+      }
     })
   }else{
     output$heatmap <- shiny::renderUI({
@@ -312,15 +325,19 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
       width = shiny::reactive(plot()$width * (plot()$ppi / 2.54)),
       height = shiny::reactive(plot()$height * (plot()$ppi / 2.54)),
       {
-        #new progress indicator
-        progress <- shiny::Progress$new()
-        on.exit(progress$close())
-        progress$set(0.2, message = "Render plot")
+        if(clearPlot()) {
+          return()
+        } else {
+          #new progress indicator
+          progress <- shiny::Progress$new()
+          on.exit(progress$close())
+          progress$set(0.2, message = "Render plot")
 
-        plot <- plot()$plot
+          plot <- plot()$plot
 
-        progress$set(1)
-        return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
+          progress$set(1)
+          return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
+        }
     })
   }
 

R/limit.R

@@ -28,6 +28,11 @@ limitUI <- function(id, label = "Limit"){
 #'
 #' @export
 limit <- function(input, output, session, lower = NULL, upper = NULL){
+  # reset on re-run
+  shinyjs::reset("enable")
+  shinyjs::reset("lowerLimit")
+  shinyjs::reset("upperLimit")
+
   # evaluate reactive parameter
   lower.r <- shiny::reactive({
     if(shiny::is.reactive(lower)) {