From 5f64bb7bebfd62ec939df77e1f87825c96335f7c Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 7 Jun 2018 09:48:34 +0200 Subject: [PATCH 1/3] download: delete tmp files --- R/function.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/function.R b/R/function.R index cad4570..5001583 100644 --- a/R/function.R +++ b/R/function.R @@ -1193,6 +1193,9 @@ download <- function(file, filename, plot, width, height, ppi = 72, save_plot = # create zip file out <- utils::zip(zipfile = file, files = files, flags = "-j") # discard file path + # remove tmp files + file.remove(files) + # remove notification shiny::removeNotification(session$ns("download-note")) From 928e9666b0497117486373526bed891ae9c0b823 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 7 Jun 2018 10:03:45 +0200 Subject: [PATCH 2/3] implemented forceArgs to evaluate all arguments during plot creation --- R/function.R | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/R/function.R b/R/function.R index 5001583..5066299 100644 --- a/R/function.R +++ b/R/function.R @@ -31,6 +31,9 @@ #' #' @return Returns list(plot = ggplotly/ ggplot, width, height, ppi, exceed_size). create_scatterplot <- function(data, transparency = 1, pointsize = 1, labelsize = 3, colors = NULL, x_label = "", y_label = "", z_label = "", density = T, line = T, categorized = F, highlight.data = NULL, highlight.labels = NULL, highlight.color = "#FF0000", xlim = NULL, ylim = NULL, colorbar.limits = NULL, width = "auto", height = "auto", ppi = 72, plot.method = "static", scale = 1){ + # force evaluation of all arguments + # no promises in plot object + forceArgs() ########## prepare data ########## #set labelnames if needed x_label <- ifelse(nchar(x_label), x_label, names(data)[2]) @@ -296,6 +299,10 @@ create_scatterplot <- function(data, transparency = 1, pointsize = 1, labelsize #' #' @return A named list(plot = ggplot object, data = pca.data, width = width of plot (cm), height = height of plot (cm), ppi = pixel per inch, exceed_size = Boolean whether width/ height exceeded max). create_pca <- function(data, dimensionA = 1, dimensionB = 2, dimensions = 6, on.columns = TRUE, labels = FALSE, custom.labels = NULL, pointsize = 2, labelsize = 3, width = 28, height = 28, ppi = 72, scale = 1) { + # force evaluation of all arguments + # no promises in plot object + forceArgs() + requireNamespace("FactoMineR", quietly = TRUE) requireNamespace("factoextra", quietly = TRUE) @@ -422,6 +429,10 @@ create_pca <- function(data, dimensionA = 1, dimensionB = 2, dimensions = 6, on. #' #' @return Returns list(plot = complexHeatmap/ plotly object, width = width in cm, height = height in cm, ppi = pixel per inch, exceed_size = Boolean whether width/ height exceeded max) depending on plot.method. create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label = NULL, column.label=T, column.custom.label = NULL, clustering='none', clustdist='auto', clustmethod='auto', colors=NULL, winsorize.colors = NULL, plot.method = "static", width = "auto", height = "auto", ppi = 72, scale = 1) { + # force evaluation of all arguments + # no promises in plot object + forceArgs() + requireNamespace("heatmaply", quietly = TRUE) requireNamespace("ComplexHeatmap", quietly = TRUE) requireNamespace("grDevices", quietly = TRUE) @@ -689,6 +700,9 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label #' #' @return Returns depending on plot.method list(plot = ggplot/ plotly object, width = width in cm, height = height in cm, ppi = pixel per inch, exceed_size = Boolean). create_geneview <- function(data, grouping, plot.type = "line", facet.target = "gene", facet.cols = 2, colors = NULL, ylabel = NULL, ylimits = NULL, gene.label = NULL, plot.method = "static", width = "auto", height = "auto", ppi = 72, scale = 1){ + # force evaluation of all arguments + # no promises in plot object + forceArgs() #grouping #group by factor if existing (fill with key if empty) grouping[grouping[[2]] == "", 2 := grouping[grouping[[2]] == "", 1]] @@ -1201,3 +1215,25 @@ download <- function(file, filename, plot, width, height, ppi = 72, save_plot = return(out) } + +#' Force evaluation of the parent function's arguments. +#' +#' @param args List of Argument names to force evaluation. Defaults to all named arguments see \code{\link[base]{match.call}}. +#' +#' @details Similar to \code{\link[base]{forceAndCall}} but used from within the respective function. +#' @details This method is not using \code{\link[base]{force}} as it is restricted to it's calling environment. Instead \code{\link[base]{get}} is used. +#' +forceArgs <- function(args) { + if (missing(args)) { + # get parent's call + args <- match.call(definition = sys.function(-1), call = sys.call(-1)) + # use argument names + args <- names(as.list(args)) + # omit empty names ("") + args <- args[-which(args == "")] + } + + for (i in args) { + get(i, envir = sys.parent()) + } +} From 884042c4aa75da7125b49f34571b9850d6f9fe3c Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 7 Jun 2018 10:06:15 +0200 Subject: [PATCH 3/3] download: save version info (R, ggplot, plotly) --- R/function.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/function.R b/R/function.R index 5066299..1b71fbe 100644 --- a/R/function.R +++ b/R/function.R @@ -1198,8 +1198,11 @@ download <- function(file, filename, plot, width, height, ppi = 72, save_plot = if (save_plot) { # create temp file name plot_object_file <- tempfile(pattern = "plot_object", fileext = ".RData") + ggplot2_version <- as.character(packageVersion("ggplot2")) + plotly_version <- as.character(packageVersion("plotly")) + r_version <- R.Version()$version.string - save(plot, file = plot_object_file) + save(plot, ggplot2_version, plotly_version, r_version, file = plot_object_file) files <- c(files, plot_object_file) }