Merge pull request loosolab#16 from HendrikSchultheis/review

Review requests

R/featureSelector.R

@@ -28,6 +28,7 @@ featureSelectorUI <- function(id){
                             shiny::actionButton(ns("select"), "Select", style = "color: #fff; background-color: #3c8dbc"),
                             shiny::actionButton(ns("reset"), "Reset", style = "color: #fff; background-color: #3c8dbc"),
                             shiny::actionButton(ns("guide"), "Launch guide", style = "color: #fff; background-color: #3c8dbc", icon = shiny::icon("question-circle")),
+                            shiny::downloadButton(ns("download")),
                             shiny::br("The SELECT button only evaluates the filter(s) below. Sorting or sub-selections based on the table above will reset!")
                             )
 
@@ -316,6 +317,16 @@ featureSelector <- function(input, output, session, data, features = NULL, featu
     data_change(1)
   })
 
+  # download #####
+  output$download <- shiny::downloadHandler(
+    filename = "subset.tsv",
+    content = function(file) {
+      log_message("FeatureSelector: download", "INFO", token = session$token)
+
+      data.table::fwrite(x = result()$data, file = file, sep = "\t")
+    }
+  )
+
   return(result)
 }
 
@@ -338,7 +349,8 @@ featureSelectorGuide <- function(session, grouping = FALSE) {
       So in order to apply a filter and create a specific subset adjust the selectors as needed.<br/>
       The sum of those adjustments will be the filter used in the next step.",
     "guide_buttons" = "<h4>Apply filter</h4>
-      After the filter is set as intended, click on 'select' to filter the dataset, or click on 'reset' to delete the current filter.",
+      After the filter is set as intended, click on 'select' to filter the dataset, or click on 'reset' to delete the current filter.<br/>
+      Download the current subset via the respecting 'Download' Button (includes reorder, text search & row selection).",
     "guide_table" = "<h4>Further limit dataset</h4>
       Once the filter is successfully applied the remaining data is shown in this table.<br/>
       <br/>

R/function.R

@@ -1112,37 +1112,38 @@ searchData <- function(input, choices, options = c("=", "<", ">"), min. = min(ch
 #' @param width in centimeter.
 #' @param height in centimeter.
 #' @param ppi pixel per inch. Defaults to 72.
+#' @param save_plot Logical if plot object should be saved as .RData.
 #' @param ui List of user inputs. Will be converted to Javascript Object Notation. See \code{\link[RJSONIO]{toJSON}}
 #'
 #' @return See \code{\link[utils]{zip}}.
-download <- function(file, filename, plot, width, height, ppi = 72, ui = NULL) {
+download <- function(file, filename, plot, width, height, ppi = 72, save_plot = TRUE, ui = NULL) {
   # cut off file extension
   name <- sub("(.*)\\..*$", replacement = "\\1", filename)
 
   # create tempfile names
   plot_file_pdf <- tempfile(pattern = name, fileext = ".pdf")
   plot_file_png <- tempfile(pattern = name, fileext = ".png")
-  if(!is.null(ui)) {
+  if (!is.null(ui)) {
     selection_file <- tempfile(pattern = "selection", fileext = ".json")
   } else {
     selection_file <- NULL
   }
 
   # save plots depending on given plot object
-  if(ggplot2::is.ggplot(plot)) {
+  if (ggplot2::is.ggplot(plot)) {
     # ggplot
 
     ggplot2::ggsave(plot_file_pdf, plot = plot, width = width, height = height, units = "cm", device = "pdf", useDingbats = FALSE)
     ggplot2::ggsave(plot_file_png, plot = plot, width = width, height = height, units = "cm", device = "png", dpi = ppi)
-  } else if(class(plot)[1] == "plotly") {
+  } else if (class(plot)[1] == "plotly") {
     # plotly
     # change working directory temporary so mounted drives are not a problem
     wd <- getwd()
     setwd(tempdir())
     plotly::export(p = plot, file = plot_file_pdf)
     plotly::export(p = plot, file = plot_file_png)
     setwd(wd)
-  } else if(class(plot) == "Heatmap") { # TODO: find better way to check for complexHeatmap object
+  } else if (class(plot) == "Heatmap") { # TODO: find better way to check for complexHeatmap object
     # complexHeatmap
     grDevices::pdf(plot_file_pdf, width = width / 2.54, height = height / 2.54, useDingbats = FALSE) # cm to inch
     ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom")
@@ -1156,7 +1157,7 @@ download <- function(file, filename, plot, width, height, ppi = 72, ui = NULL) {
   files <- c(plot_file_pdf, plot_file_png)
 
   # save user input
-  if(!is.null(selection_file)) {
+  if (!is.null(selection_file)) {
     # make key = value pair using value of name variable
     ui_list <- list()
     ui_list[[name]] <- ui
@@ -1167,6 +1168,16 @@ download <- function(file, filename, plot, width, height, ppi = 72, ui = NULL) {
     files <- c(files, selection_file)
   }
 
+  # save plot object
+  if (save_plot) {
+    # create temp file name
+    plot_object_file <- tempfile(pattern = "plot_object", fileext = ".RData")
+
+    save(plot, file = plot_object_file)
+
+    files <- c(files, plot_object_file)
+  }
+
   # create zip file
   utils::zip(zipfile = file, files = files, flags = "-j") # discard file path
 }