Create html and rds treeviews by default

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: tfpscanner
 Title: Transmission fitness polymorphism scanner 
-Version: 0.2.1
-Date: 2022-12-06
+Version: 0.2.2
+Date: 2023-01-18
 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 
@@ -16,7 +16,7 @@ Imports:
     ggplot2,
     ggtree,
     glue,
-    htmlwidgets,
+    htmlwidgets (>= 1.6.0),
     knitr,
     lubridate,
     mgcv,

NEWS.md

@@ -1,3 +1,10 @@
+# tfpscanner 0.2.2 _2023-01-18_
+
+- Interactive tree view plots can be saved in either `html` (as an htmlwidget) or `rds` (as a 
+  ggtree object) files
+- Cluster SINA plots and interactive tree view plots are saved as _both_ `html` and `rds` by
+  default
+
 # 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

R/plot_cluster_sina.R

@@ -32,8 +32,8 @@ plot_cluster_sina <- function(pldf,
 #' @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   output_format   String (either \code{rds}, \code{html} or both). Default: both. In
+#'   which file format(s) should the plots be saved?
 #' @param   width_svg,height_svg   The width and height of the plot (only used when
 #'   \code{output_format == "html"}).
 #'

R/plot_tree.R

@@ -85,6 +85,10 @@ create_trees <- function(ggtree_data,
 #' @param   branch_col   Scalar string. The name of the statistic that is under study here (e.g.,
 #'   "logistic_growth_rate" or "clock_outlier"). This name will be used in the output file paths.
 #' @param   output_dir   Scalar string. The directory where the plots will be saved.
+#' @param   output_format   String (either \code{rds} or \code{html} or both). Default: both. Which
+#'   file format(s) should the interactive tree plot(s) be placed? For \code{rds}, a \code{ggtree}
+#'   object will be placed in an \code{rds} file. For \code{html}, a \code{htmlwidget} will be
+#'   placed in a \code{html} file.
 #' @param   include_date   Boolean. Should the file-paths include the current date?
 #' @inheritParams   create_trees
 #'
@@ -94,7 +98,14 @@ save_trees <- function(tree_list,
                        branch_col,
                        n_leaves,
                        output_dir,
+                       output_format = c("rds", "html"),
                        include_date = FALSE) {
+  output_format <- match.arg(output_format, several.ok = TRUE)
+  required_filetypes <- c(
+    "noninteractive",
+    c(rds = "interactive_rds", html = "interactive_html")[output_format]
+  )
+
   basename_prefix <- if (include_date) {
     glue::glue("tree-{branch_col}-{Sys.Date()}")
   } else {
@@ -103,23 +114,45 @@ save_trees <- function(tree_list,
 
   basenames <- c(
     noninteractive = glue::glue("{basename_prefix}.svg"),
-    interactive = glue::glue("{basename_prefix}.rds")
+    interactive_rds = glue::glue("{basename_prefix}.rds"),
+    interactive_html = glue::glue("{basename_prefix}.html")
+  )[required_filetypes]
+
+  files <- setNames(
+    file.path(output_dir, basenames),
+    required_filetypes
   )
-  files <- file.path(output_dir, basenames)
-  names(files) <- names(basenames)
+
+  plot_height <- max(14, floor(n_leaves / 10))
 
   ggplot2::ggsave(
     tree_list[["noninteractive"]],
     filename = files[["noninteractive"]],
-    height = max(14, floor(n_leaves / 10)),
+    height = plot_height,
     width = 16,
     limitsize = FALSE
   )
 
-  saveRDS(
-    tree_list[["interactive"]],
-    file = files[["interactive"]]
-  )
+  if ("rds" %in% output_format) {
+    saveRDS(
+      tree_list[["interactive"]],
+      file = files[["interactive_rds"]]
+    )
+  }
+
+  if ("html" %in% output_format) {
+    widget <- create_widget(
+      tree_list[["interactive"]],
+      width_svg = 15,
+      height_svg = plot_height
+    )
+
+    htmlwidgets::saveWidget(
+      widget,
+      file = files[["interactive_html"]],
+      title = glue::glue("SARS CoV 2 scan {Sys.Date()}")
+    )
+  }
 
   invisible(files)
 }

R/treeview.R

@@ -11,14 +11,16 @@
 #' @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 output_format String (either \code{rds}, \code{html} or both). Default: both. In which
+#'   format(s) should the interactive plots be saved? For \code{rds}, a \code{ggtree} or
+#'   \code{ggplot2} object will be placed in \code{rds} files. For \code{html}, \code{htmlwidget}s
+#'   will be placed in a \code{html} file.
 #' @param heatmap_width,heatmap_lab_offset Width and label-offset parameters for the constructed
 #'   heatmap.
 #'
 #' @importFrom rlang .data
 #'
-#' @return A ggtree plot
+#' @return A \code{ggtree} plot.
 #'
 #' @export
 
@@ -27,10 +29,10 @@ 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"),
+                     output_format = c("rds", "html"),
                      heatmap_width = .075,
                      heatmap_lab_offset = -6) {
-  sina_output_format <- match.arg(sina_output_format, several.ok = TRUE)
+  output_format <- match.arg(output_format, several.ok = TRUE)
 
   # require logistic growth rate, prevent non-empty
   branch_cols <- unique(c(
@@ -251,7 +253,8 @@ treeview <- function(e0,
       lgr_trees,
       branch_col = "logistic_growth_rate",
       n_leaves = n_leaves,
-      output_dir = output_dir
+      output_dir = output_dir,
+      output_format = output_format
     )
 
     for (branch_col in setdiff(branch_cols, c("logistic_growth_rate"))) {
@@ -263,7 +266,8 @@ treeview <- function(e0,
         tree_list,
         branch_col = branch_col,
         n_leaves = n_leaves,
-        output_dir = output_dir
+        output_dir = output_dir,
+        output_format = output_format
       )
     }
   })
@@ -284,7 +288,7 @@ treeview <- function(e0,
         sina_plot,
         varx = vn,
         output_dir = output_dir,
-        output_format = sina_output_format
+        output_format = output_format
       )
     }
   })

tests/testthat/test-plot_tree.R

@@ -1,3 +1,13 @@
+get_default_filepaths <- function(dir_path, base_name) {
+  filepaths <- c(
+    noninteractive = file.path(dir_path, glue::glue("{base_name}.svg")),
+    interactive_html = file.path(dir_path, glue::glue("{base_name}.html")),
+    interactive_rds = file.path(dir_path, glue::glue("{base_name}.rds"))
+  )
+
+  filepaths
+}
+
 describe("save_trees", {
   tree_list <- list(
     noninteractive = ggplot2::ggplot(),
@@ -6,40 +16,95 @@ describe("save_trees", {
     interactive = ggplot2::ggplot()
   )
   branch_col <- "logistic_growth_rate"
+  default_base_name <- glue::glue("tree-{branch_col}")
+  dated_base_name <- glue::glue("tree-{branch_col}-{Sys.Date()}")
 
-  it("creates .svg / .rds files - default: without the current date", {
+  it("creates .svg / .rds / .html files - default: without the current date", {
     td <- withr::local_tempdir(pattern = "no-date-svg")
-    output_rds <- file.path(td, glue::glue("tree-{branch_col}.rds"))
-    output_svg <- file.path(td, glue::glue("tree-{branch_col}.svg"))
+
+    filetypes <- list(
+      expected = c("noninteractive", "interactive_html", "interactive_rds"),
+      unexpected = character(0)
+    )
+
+    default_files <- get_default_filepaths(td, default_base_name)
+    expected_files <- default_files[filetypes$expected]
+    unexpected_files <- default_files[filetypes$unexpected]
 
     created_files <- save_trees(
       tree_list,
       branch_col = branch_col, output_dir = td, n_leaves = 100
     )
 
-    expect_equal(
-      created_files,
-      c("noninteractive" = output_svg, "interactive" = output_rds)
+    expect_mapequal(created_files, expected_files)
+    expect_true(all(file.exists(expected_files)))
+  })
+
+  it("creates interactive html plot 'only' based on output_format argument", {
+    td <- withr::local_tempdir(pattern = "no-date-svg")
+
+    filetypes <- list(
+      expected = c("noninteractive", "interactive_html"),
+      unexpected = "interactive_rds"
+    )
+
+    default_files <- get_default_filepaths(td, default_base_name)
+    expected_files <- default_files[filetypes$expected]
+    unexpected_files <- default_files[filetypes$unexpected]
+
+    created_files <- save_trees(
+      tree_list,
+      branch_col = branch_col, output_dir = td, n_leaves = 100,
+      output_format = "html"
     )
-    expect_true(file.exists(output_svg))
-    expect_true(file.exists(output_rds))
+
+    expect_mapequal(created_files, expected_files)
+    expect_true(all(file.exists(expected_files)))
+    expect_false(any(file.exists(unexpected_files)))
   })
 
-  it("creates .svg / .rds files - optionally including the current date", {
+  it("creates interactive rds plot 'only' based on output_format argument", {
+    td <- withr::local_tempdir(pattern = "no-date-svg")
+
+    filetypes <- list(
+      expected = c("noninteractive", "interactive_rds"),
+      unexpected = "interactive_html"
+    )
+
+    default_files <- get_default_filepaths(td, default_base_name)
+    expected_files <- default_files[filetypes$expected]
+    unexpected_files <- default_files[filetypes$unexpected]
+
+    created_files <- save_trees(
+      tree_list,
+      branch_col = branch_col, output_dir = td, n_leaves = 100,
+      output_format = "rds"
+    )
+
+    expect_mapequal(created_files, expected_files)
+    expect_true(all(file.exists(expected_files)))
+    expect_false(any(file.exists(unexpected_files)))
+  })
+
+  it("creates .svg / .rds / .html files - optionally including the current date", {
     td <- withr::local_tempdir(pattern = "noninteractive-svg")
-    output_rds <- file.path(td, glue::glue("tree-{branch_col}-{Sys.Date()}.rds"))
-    output_svg <- file.path(td, glue::glue("tree-{branch_col}-{Sys.Date()}.svg"))
+
+    filetypes <- list(
+      expected = c("noninteractive", "interactive_html", "interactive_rds"),
+      unexpected = character(0)
+    )
+
+    default_files <- get_default_filepaths(td, dated_base_name)
+    expected_files <- default_files[filetypes$expected]
+    unexpected_files <- default_files[filetypes$unexpected]
 
     created_files <- save_trees(
       tree_list,
       branch_col = branch_col, output_dir = td, n_leaves = 100, include_date = TRUE
     )
 
-    expect_equal(
-      created_files,
-      c("noninteractive" = output_svg, "interactive" = output_rds)
-    )
-    expect_true(file.exists(output_svg))
-    expect_true(file.exists(output_rds))
+    expect_mapequal(created_files, expected_files)
+    expect_true(all(file.exists(expected_files)))
+    expect_false(any(file.exists(unexpected_files)))
   })
 })