Merge pull request #17 from jumpingrivers/sinaplot-rds

Save sina-plot .rds files

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: tfpscanner
 Title: Transmission fitness polymorphism scanner 
-Version: 0.2.0
-Date: 2022-11-09
+Version: 0.2.1
+Date: 2022-12-06
 Author: Erik Volz, Olivia Boyd
 Maintainer: Erik Volz <[email protected]>
 Description: A pipeline for scanning a SARS-CoV-2 phylogeny for clades with outlying growth 
@@ -39,5 +39,5 @@ Remotes:
 SystemRequirements: libopenmpi-dev
 Encoding: UTF-8
 License: MIT + file LICENSE
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.2
 Config/testthat/edition: 3

NEWS.md

@@ -1,3 +1,8 @@
+# tfpscanner 0.2.1 _2022-12-06_
+
+- "Cluster sina plot"s can be saved in either `html` (as an htmlwidget) or `rds` (as a ggplot2
+  object) files
+
 # tfpscanner 0.2.0 _2022-11-09_
 
 - Breaking change: `htmlwidget`s are no longer saved to file by `treeview()`

R/plot_cluster_sina.R

@@ -1,19 +1,17 @@
 #' Create a sina plot against lineage
 #'
-#' Side-effect: this function creates a plot and stores it to a file.
-#'
 #' @param pldf  Data-frame. The data element of a tree plot.
-#' @param output_dir  String. The directory within which the plot should be stored.
 #' @param varx  String. Which variable in \code{pldf} should be plotted on the y-axis.
 #' @param mut_regexp  String. Regular-expression(s) for restricting the plot to a subset of the rows
 #'   in \code{pldf}. Only rows with an "allmuts" entry that matches one of these regular expressions
 #'   will be presented. If NULL, all rows are presented.
 #' @param lineage_regexp  String. Regular-expression(s) for restricting the lineages that are
 #'   presented in the plot. Only those rows of \code{pldf} with a "lineage" entry that matches one
 #'   of these regular expressions will be presented. If NULL, all rows are presented.
+#'
+#' @return   A \code{ggplot2} object storing the sina-cluster plot.
 
 plot_cluster_sina <- function(pldf,
-                              output_dir,
                               varx = "logistic_growth_rate",
                               mut_regexp = "S:A222V",
                               lineage_regexp = NULL) {
@@ -24,17 +22,58 @@ plot_cluster_sina <- function(pldf,
     lineage_regexp = lineage_regexp
   )
 
-  p1 <- create_cluster_sina_ggplot(sc1, y_lab = varx)
+  create_cluster_sina_ggplot(sc1, y_lab = varx)
+}
 
-  g1 <- create_widget(
-    ggobj = p1,
-    width_svg = 8,
-    height_svg = 8
-  )
+#' Save a sina-cluster-plot to a file
+#'
+#' Saves as either an htmlwidget (in a \code{html} file) or a ggplot object (in a \code{rds} file).
+#'
+#' @param   ggobj   \code{ggplot2} object. Contains the plot that is to be saved.
+#' @param   varx   Scalar string. Which variable is depicted in the plot?
+#' @param   output_dir   File path. The directory where the plot will be stored.
+#' @param   output_format   String (either \code{rds}, \code{html} or both). In which formats should
+#'   the plots be saved?
+#' @param   width_svg,height_svg   The width and height of the plot (only used when
+#'   \code{output_format == "html"}).
+#'
+#' @return   Invisibly returns the file paths (one for each output format) where the plots were
+#'   saved.
+
+save_sina_plot <- function(ggobj,
+                           varx,
+                           output_dir,
+                           output_format = c("rds", "html"),
+                           width_svg = 8,
+                           height_svg = 8) {
+  save_widget <- function(file_path) {
+    g1 <- create_widget(
+      ggobj = ggobj,
+      width_svg = width_svg,
+      height_svg = height_svg
+    )
 
-  htmlwidgets::saveWidget(g1,
-    file = as.character(glue::glue("{output_dir}/sina-{varx}.html"))
+    htmlwidgets::saveWidget(g1, file = file_path)
+  }
+
+  output_format <- match.arg(output_format, several.ok = TRUE)
+
+  file_paths <- stats::setNames(
+    file.path(output_dir, glue::glue("sina-{varx}.{output_format}")),
+    output_format
   )
+
+  for (fmt in output_format) {
+    file_path <- file_paths[fmt]
+
+    if (fmt == "rds") {
+      saveRDS(ggobj, file = file_path)
+    } else {
+      save_widget(file_path)
+    }
+  }
+
+  invisible(file_paths)
 }
 
 #' Reformats data for a tree-plot for presentation in a sina plot

R/treeview.R

@@ -11,6 +11,8 @@
 #' @param lineages A set of lineage names which will be used to subdivide outputs in scatter plots.
 #' @param output_dir Outputs will be saved in this directory. Will create the directory if it does
 #'   not exist.
+#' @param sina_output_format String (either \code{rds}, \code{html} or both). In which formats
+#'   should the sina-cluster plots be saved?
 #' @param heatmap_width,heatmap_lab_offset Width and label-offset parameters for the constructed
 #'   heatmap.
 #'
@@ -25,8 +27,11 @@ treeview <- function(e0,
                      mutations = c("S:A222V", "S:Y145H", "N:Q9L", "S:E484K"),
                      lineages = c("AY\\.9", "AY\\.43", "AY\\.4\\.2"),
                      output_dir = "treeview",
+                     sina_output_format = c("rds", "html"),
                      heatmap_width = .075,
                      heatmap_lab_offset = -6) {
+  sina_output_format <- match.arg(sina_output_format, several.ok = TRUE)
+
   # require logistic growth rate, prevent non-empty
   branch_cols <- unique(c(
     "logistic_growth_rate",
@@ -266,13 +271,19 @@ treeview <- function(e0,
 
   suppressWarnings({
     for (vn in unique(c("logistic_growth_rate", branch_cols))) {
-      plot_cluster_sina(
+      sina_plot <- plot_cluster_sina(
         pldf,
-        output_dir = output_dir,
         varx = vn,
         mut_regexp = mutations,
         lineage_regexp = lineages
       )
+
+      save_sina_plot(
+        sina_plot,
+        varx = vn,
+        output_dir = output_dir,
+        output_format = sina_output_format
+      )
     }
   })
 

inst/WORDLIST

@@ -18,6 +18,7 @@ generalised
 ggiraph
 ggplot
 ggtree
+htmlwidget
 htmlwidgets
 ide
 Ile