diff --git a/DESCRIPTION b/DESCRIPTION index 2133303..815bd5b 100644 --- a/DESCRIPTION +++ b/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 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, diff --git a/NEWS.md b/NEWS.md index 6e33998..f69857a 100644 --- a/NEWS.md +++ b/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 diff --git a/R/plot_cluster_sina.R b/R/plot_cluster_sina.R index 8c07f47..e73a15c 100644 --- a/R/plot_cluster_sina.R +++ b/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"}). #' diff --git a/R/plot_tree.R b/R/plot_tree.R index da0c250..3dbfa03 100644 --- a/R/plot_tree.R +++ b/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) } diff --git a/R/treeview.R b/R/treeview.R index c07237f..985dac0 100644 --- a/R/treeview.R +++ b/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 ) } }) diff --git a/man/save_sina_plot.Rd b/man/save_sina_plot.Rd index 4eeae30..a394131 100644 --- a/man/save_sina_plot.Rd +++ b/man/save_sina_plot.Rd @@ -20,8 +20,8 @@ save_sina_plot( \item{output_dir}{File path. The directory where the plot will be stored.} -\item{output_format}{String (either \code{rds}, \code{html} or both). In which formats should -the plots be saved?} +\item{output_format}{String (either \code{rds}, \code{html} or both). Default: both. In +which file format(s) should the plots be saved?} \item{width_svg, height_svg}{The width and height of the plot (only used when \code{output_format == "html"}).} diff --git a/man/save_trees.Rd b/man/save_trees.Rd index 333d689..a140cf7 100644 --- a/man/save_trees.Rd +++ b/man/save_trees.Rd @@ -4,7 +4,14 @@ \alias{save_trees} \title{Save the tree views to files} \usage{ -save_trees(tree_list, branch_col, n_leaves, output_dir, include_date = FALSE) +save_trees( + tree_list, + branch_col, + n_leaves, + output_dir, + output_format = c("rds", "html"), + include_date = FALSE +) } \arguments{ \item{tree_list}{List of \code{ggtree} objects. The "noninteractive" and "interactive" @@ -17,6 +24,11 @@ entries will be saved to an external file. As generated by \code{create_trees}.} \item{output_dir}{Scalar string. The directory where the plots will be saved.} +\item{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.} + \item{include_date}{Boolean. Should the file-paths include the current date?} } \value{ diff --git a/man/treeview.Rd b/man/treeview.Rd index 987a3e0..7226756 100644 --- a/man/treeview.Rd +++ b/man/treeview.Rd @@ -10,7 +10,7 @@ treeview( 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 = 0.075, heatmap_lab_offset = -6 ) @@ -29,14 +29,16 @@ logistic growth rate plot will always be produced.} \item{output_dir}{Outputs will be saved in this directory. Will create the directory if it does not exist.} -\item{sina_output_format}{String (either \code{rds}, \code{html} or both). In which formats -should the sina-cluster plots be saved?} +\item{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.} \item{heatmap_width, heatmap_lab_offset}{Width and label-offset parameters for the constructed heatmap.} } \value{ -A ggtree plot +A \code{ggtree} plot. } \description{ This will produce a set of html widgets which will highlight by colour and tooltips statistics diff --git a/tests/testthat/test-plot_tree.R b/tests/testthat/test-plot_tree.R index c535583..9ed7596 100644 --- a/tests/testthat/test-plot_tree.R +++ b/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))) }) })