From c770d7479fe1e63bc88986809978be44d4e155a4 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Thu, 7 Mar 2024 15:32:17 +0000 Subject: [PATCH 01/19] docs: fix a function name in the README --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index ddd9307..39a5898 100644 --- a/README.md +++ b/README.md @@ -62,7 +62,7 @@ Then, to set up all the remaining files required by tfpbrowser, you would make t function call: ``` -tfpscanner::create_browser_files( +tfpscanner::create_browser_data( e0 = "tfpbrowser_files/scanner_output/scanner-env-2023-07-05.rds", output_dir = "tfpbrowser_files", [any additional arguments to be passed on to `tfpscanner::treeview()`] From 971cfb7ece1085cc1b21a2cb8405a146af7d0d7e Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 11:22:27 +0000 Subject: [PATCH 02/19] ci: update the .lintr config (no_tab_linter is now called whitespace_linter) --- .lintr | 1 - 1 file changed, 1 deletion(-) diff --git a/.lintr b/.lintr index 6c7e8fa..7ffcdad 100644 --- a/.lintr +++ b/.lintr @@ -2,7 +2,6 @@ linters: linters_with_defaults( object_name_linter = NULL, line_length_linter = line_length_linter(120), cyclocomp_linter = NULL, - no_tab_linter = NULL, commented_code_linter = NULL, object_usage_linter = NULL ) From 1cffa07395f7437798fb28651312ff1476a03d7a Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 11:27:55 +0000 Subject: [PATCH 03/19] fix(lint): ensure package passes linting --- R/plot_tree.R | 4 +--- R/tfpscanner.R | 40 +++++++++++++++++++++------------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index 3dbfa03..4ba9df3 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -461,9 +461,7 @@ sort_mutations <- function(muts) { upres <- sort(unique(pre)) sorted_mutations <- do.call(c, lapply(upres, function(.pre) { .muts <- muts[pre == .pre] - .muts1 <- sapply(strsplit(.muts, - split = ":" - ), "[", 2) + .muts1 <- sapply(strsplit(.muts, split = ":"), "[", 2) sites <- regmatches( .muts1, regexpr(.muts1, diff --git a/R/tfpscanner.R b/R/tfpscanner.R index fbb77f9..b29209c 100644 --- a/R/tfpscanner.R +++ b/R/tfpscanner.R @@ -591,28 +591,30 @@ tfpscan <- function(tre, allsegregating <- Reduce(union, segregatingmut) # remove stops from allseg - allsegregating <- allsegregating[!grepl(allsegregating, - pattern = "[*]$" - )] - allsegregating <- allsegregating[!grepl(allsegregating, - pattern = ":[*]" - )] + allsegregating <- allsegregating[ + !grepl(allsegregating, pattern = "[*]$") + ] + allsegregating <- allsegregating[ + !grepl(allsegregating, pattern = ":[*]") + ] annots <- rep("", ape::Ntip(tr) + ape::Nnode(tr)) if (length(allsegregating) > 0) { - allseg1 <- substr(regmatches(allsegregating, regexpr(allsegregating, - pattern = ":[A-Z]" - )), 2, 2) - allseg2 <- regmatches(allsegregating, regexpr(allsegregating, - pattern = "[A-Z*]$" - )) - sites_post <- regmatches(allsegregating, regexpr(allsegregating, - pattern = ":.*$" - )) + allseg1 <- substr( + regmatches(allsegregating, regexpr(allsegregating, pattern = ":[A-Z]")), + 2, + 2 + ) + allseg2 <- regmatches( + allsegregating, regexpr(allsegregating, pattern = "[A-Z*]$") + ) + sites_post <- regmatches( + allsegregating, regexpr(allsegregating, pattern = ":.*$") + ) sites_post <- substr(sites_post, 3, nchar(sites_post) - 1) - sites_pre <- regmatches(allsegregating, regexpr(allsegregating, - pattern = "^.*:" - )) + sites_pre <- regmatches( + allsegregating, regexpr(allsegregating, pattern = "^.*:") + ) sites <- paste0(sites_pre, sites_post) aas <- c() @@ -661,7 +663,7 @@ tfpscan <- function(tre, gtr1 <- gtr1 + ggtree::geom_tiplab(align = TRUE) gtr2 <- gtr1 - if ((length(allsegregating) < 100) & (length(allsegregating) > 0)) { + if ((length(allsegregating) < 100) && (length(allsegregating) > 0)) { gtr2 <- ggtree::gheatmap(gtr1, as.data.frame(aas), width = .66, From f44d52e77f299f2ca1ea786a5fafc2248e837908 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 11:44:35 +0000 Subject: [PATCH 04/19] fix(ci): name::space() a function --- R/plot_tree.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index 4ba9df3..3b47079 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -118,7 +118,7 @@ save_trees <- function(tree_list, interactive_html = glue::glue("{basename_prefix}.html") )[required_filetypes] - files <- setNames( + files <- stats::setNames( file.path(output_dir, basenames), required_filetypes ) From 5b22890ea011264699c443af2b1d239b5ce7e5d7 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Fri, 1 Mar 2024 13:06:43 +0000 Subject: [PATCH 05/19] fix: create output dir if missing in create_browser_data() --- R/create_browser_data.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/create_browser_data.R b/R/create_browser_data.R index d3b1cce..883cea3 100644 --- a/R/create_browser_data.R +++ b/R/create_browser_data.R @@ -12,6 +12,10 @@ create_browser_data <- function(e0, output_dir, ...) { + if (!dir.exists(output_dir)) { + dir.create(output_dir) + } + dirs <- list( treeview = file.path(output_dir, "treeview"), mutations = file.path(output_dir, "mutations"), From c79e1b28946ce2e3e9575ad3bfd2efd5caf113bb Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Tue, 19 Mar 2024 11:37:55 +0000 Subject: [PATCH 06/19] bump CI scripts to use R 4.3 and bioconductor 3.18 --- .github/workflows/R-CMD-check.yaml | 2 +- .github/workflows/lint.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index af5b818..e58f2e8 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -18,7 +18,7 @@ jobs: fail-fast: false matrix: config: - - { os: ubuntu-latest, r: '4.2', bioc: '3.16', cont: "bioconductor/bioconductor_docker:RELEASE_3_16" } + - { os: ubuntu-latest, r: '4.3', bioc: '3.18', cont: "bioconductor/bioconductor_docker:RELEASE_3_18" } env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 12bb147..4fcd545 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -18,7 +18,7 @@ jobs: fail-fast: false matrix: config: - - { os: ubuntu-latest, r: '4.2', bioc: '3.16', cont: "bioconductor/bioconductor_docker:RELEASE_3_16" } + - { os: ubuntu-latest, r: '4.3', bioc: '3.18', cont: "bioconductor/bioconductor_docker:RELEASE_3_18" } env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} From 70e7518ba57023b9c0d61af81045746b73ef2786 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Fri, 1 Mar 2024 15:02:30 +0000 Subject: [PATCH 07/19] remove legend for internal-node vs leaf 'shape' aesthetic --- R/plot_tree.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/plot_tree.R b/R/plot_tree.R index 3b47079..9a932ce 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -202,6 +202,7 @@ create_noninteractive_ggtree <- function(ggtree_data, name = "Cluster size", range = c(2, 16) ) + + ggplot2::guides(shape = "none") + ggplot2::ggtitle(glue::glue("{Sys.Date()}, colour: {branch_col}")) + ggplot2::theme(legend.position = "top") From 75b41a508c18c3a639cb46d59439acabdce7136c Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Tue, 12 Mar 2024 09:16:09 +0000 Subject: [PATCH 08/19] feat: squash genotype TRUE/FALSE legend levels into 1 column --- R/plot_tree.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index 9a932ce..0fca5fa 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -390,9 +390,11 @@ append_heatmap <- function(ggobj, offset = 0.0005, colnames_angle = -90, colnames_position = "top", - colnames_offset_y = heatmap_lab_offset, - legend_title = "Genotype" - ) + colnames_offset_y = heatmap_lab_offset + ) + + ggplot2::guides( + fill = ggplot2::guide_legend(title = "Genotype", nrow = 2) + ) } #' Converts a \code{ggtree} object into a \code{ggiraph} object with interactive potential From 7cfd9f01188be9b5afd9f59b336b12bc538f5f9d Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Fri, 1 Mar 2024 16:14:54 +0000 Subject: [PATCH 09/19] feat: user can set heatmap_offset (so heatmap doesn't overlap tree) --- R/plot_tree.R | 8 ++++++-- R/treeview.R | 5 ++++- man/append_heatmap.Rd | 11 +++++++++-- man/create_trees.Rd | 4 +++- man/treeview.Rd | 5 ++++- 5 files changed, 26 insertions(+), 7 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index 0fca5fa..d58fe26 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -10,7 +10,8 @@ #' \code{lins$node_names} a string vector giving the name of the lineage. For \code{nodes} and #' \code{node_names} the order of entries matches that for \code{lins}. #' @param sc0,cmuts Data-frames. -#' @param heatmap_width,heatmap_lab_offset Parameters for positioning of the heatmap. +#' @param heatmap_width,heatmap_offset,heatmap_lab_offset Parameters for positioning of the +#' heatmap. #' @param mut_regex Regular expression. Defines the mutations under study here. #' @param colours Vector of colours. #' @param colour_limits Min and max values for the colours. @@ -25,6 +26,7 @@ create_trees <- function(ggtree_data, sc0, cmuts, heatmap_width, + heatmap_offset, heatmap_lab_offset, mut_regex = NULL, colours = NULL, @@ -63,6 +65,7 @@ create_trees <- function(ggtree_data, ggobj = tree_list[["with_interactivity_data"]], genotype = genotype, heatmap_width = heatmap_width, + heatmap_offset = heatmap_offset, heatmap_lab_offset = heatmap_lab_offset ) @@ -382,12 +385,13 @@ extract_genotype_data <- function(ggobj, append_heatmap <- function(ggobj, genotype, heatmap_width = 1, + heatmap_offset = 5, heatmap_lab_offset = 0) { ggtree::gheatmap( p = ggobj, data = genotype, width = heatmap_width, - offset = 0.0005, + offset = heatmap_offset, colnames_angle = -90, colnames_position = "top", colnames_offset_y = heatmap_lab_offset diff --git a/R/treeview.R b/R/treeview.R index 7b9a405..6851f16 100644 --- a/R/treeview.R +++ b/R/treeview.R @@ -15,8 +15,9 @@ #' 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 +#' @param heatmap_width,heatmap_offset Width relative to the tree and offset from the tree for the #' heatmap. +#' @param heatmap_lab_offset Label-offset parameter for the constructed heatmap. #' #' @importFrom rlang .data #' @@ -31,6 +32,7 @@ treeview <- function(e0, output_dir = "treeview", output_format = c("rds", "html"), heatmap_width = .075, + heatmap_offset = 8, heatmap_lab_offset = -6) { output_format <- match.arg(output_format, several.ok = TRUE) @@ -236,6 +238,7 @@ treeview <- function(e0, mut_regex = mutations, colours = cols, heatmap_width = heatmap_width, + heatmap_offset = heatmap_offset, heatmap_lab_offset = heatmap_lab_offset ) } diff --git a/man/append_heatmap.Rd b/man/append_heatmap.Rd index de676dd..db0de17 100644 --- a/man/append_heatmap.Rd +++ b/man/append_heatmap.Rd @@ -4,14 +4,21 @@ \alias{append_heatmap} \title{Adds a heatmap to the right of a ggtree object} \usage{ -append_heatmap(ggobj, genotype, heatmap_width = 1, heatmap_lab_offset = 0) +append_heatmap( + ggobj, + genotype, + heatmap_width = 1, + heatmap_offset = 5, + heatmap_lab_offset = 0 +) } \arguments{ \item{ggobj}{A ggtree object.} \item{genotype}{The heatmap data.} -\item{heatmap_width, heatmap_lab_offset}{Parameters for positioning of the heatmap.} +\item{heatmap_width, heatmap_offset, heatmap_lab_offset}{Parameters for positioning of the +heatmap.} } \value{ A \code{ggtree} / \code{gg} / \code{ggplot} object with an appended heatmap. diff --git a/man/create_trees.Rd b/man/create_trees.Rd index b551af4..05814c4 100644 --- a/man/create_trees.Rd +++ b/man/create_trees.Rd @@ -12,6 +12,7 @@ create_trees( sc0, cmuts, heatmap_width, + heatmap_offset, heatmap_lab_offset, mut_regex = NULL, colours = NULL, @@ -34,7 +35,8 @@ vector of node numbers, these correspond to nodes in \code{ggtree_data$node}. \item{sc0, cmuts}{Data-frames.} -\item{heatmap_width, heatmap_lab_offset}{Parameters for positioning of the heatmap.} +\item{heatmap_width, heatmap_offset, heatmap_lab_offset}{Parameters for positioning of the +heatmap.} \item{mut_regex}{Regular expression. Defines the mutations under study here.} diff --git a/man/treeview.Rd b/man/treeview.Rd index 7226756..83b484a 100644 --- a/man/treeview.Rd +++ b/man/treeview.Rd @@ -12,6 +12,7 @@ treeview( output_dir = "treeview", output_format = c("rds", "html"), heatmap_width = 0.075, + heatmap_offset = 8, heatmap_lab_offset = -6 ) } @@ -34,8 +35,10 @@ format(s) should the interactive plots be saved? For \code{rds}, a \code{ggtree} \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 +\item{heatmap_width, heatmap_offset}{Width relative to the tree and offset from the tree for the heatmap.} + +\item{heatmap_lab_offset}{Label-offset parameter for the constructed heatmap.} } \value{ A \code{ggtree} plot. From 942de42e0eb7aa8cf93735e244255c646707d089 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Fri, 1 Mar 2024 16:45:11 +0000 Subject: [PATCH 10/19] feat: make heatmap colours light/mid grey instead of colourful --- R/plot_tree.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index d58fe26..71077c9 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -66,7 +66,8 @@ create_trees <- function(ggtree_data, genotype = genotype, heatmap_width = heatmap_width, heatmap_offset = heatmap_offset, - heatmap_lab_offset = heatmap_lab_offset + heatmap_lab_offset = heatmap_lab_offset, + heatmap_fill = c("FALSE" = "grey90", "TRUE" = "grey70") ) tree_list$interactive <- create_interactive_ggtree( @@ -386,7 +387,8 @@ append_heatmap <- function(ggobj, genotype, heatmap_width = 1, heatmap_offset = 5, - heatmap_lab_offset = 0) { + heatmap_lab_offset = 0, + heatmap_fill = c("FALSE" = "grey85", "TRUE" = "grey50")) { ggtree::gheatmap( p = ggobj, data = genotype, @@ -396,6 +398,9 @@ append_heatmap <- function(ggobj, colnames_position = "top", colnames_offset_y = heatmap_lab_offset ) + + ggplot2::scale_fill_manual( + values = heatmap_fill + ) + ggplot2::guides( fill = ggplot2::guide_legend(title = "Genotype", nrow = 2) ) From 863ecc1619385b5d6237795eece2300d87fddc2c Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 12:07:18 +0000 Subject: [PATCH 11/19] doc: inherit heatmap parameters from treeview() in all downstream function docs --- R/plot_tree.R | 8 ++++---- R/treeview.R | 6 +++++- man/append_heatmap.Rd | 11 +++++++++-- man/create_trees.Rd | 9 ++++++++- man/treeview.Rd | 7 ++++++- 5 files changed, 32 insertions(+), 9 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index 71077c9..7bb0624 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -10,11 +10,10 @@ #' \code{lins$node_names} a string vector giving the name of the lineage. For \code{nodes} and #' \code{node_names} the order of entries matches that for \code{lins}. #' @param sc0,cmuts Data-frames. -#' @param heatmap_width,heatmap_offset,heatmap_lab_offset Parameters for positioning of the -#' heatmap. #' @param mut_regex Regular expression. Defines the mutations under study here. #' @param colours Vector of colours. #' @param colour_limits Min and max values for the colours. +#' @inheritParams treeview #' #' @return A list with several entries. Each entry is a \code{ggtree} object. The list names are #' "noninteractive", "with_interactivity_data", "with_heatmap", "interactive". @@ -28,6 +27,7 @@ create_trees <- function(ggtree_data, heatmap_width, heatmap_offset, heatmap_lab_offset, + heatmap_fill = c("FALSE" = "grey90", "TRUE" = "grey70"), mut_regex = NULL, colours = NULL, colour_limits = NULL) { @@ -67,7 +67,7 @@ create_trees <- function(ggtree_data, heatmap_width = heatmap_width, heatmap_offset = heatmap_offset, heatmap_lab_offset = heatmap_lab_offset, - heatmap_fill = c("FALSE" = "grey90", "TRUE" = "grey70") + heatmap_fill = heatmap_fill ) tree_list$interactive <- create_interactive_ggtree( @@ -388,7 +388,7 @@ append_heatmap <- function(ggobj, heatmap_width = 1, heatmap_offset = 5, heatmap_lab_offset = 0, - heatmap_fill = c("FALSE" = "grey85", "TRUE" = "grey50")) { + heatmap_fill = c("FALSE" = "grey90", "TRUE" = "grey70")) { ggtree::gheatmap( p = ggobj, data = genotype, diff --git a/R/treeview.R b/R/treeview.R index 6851f16..c2bf402 100644 --- a/R/treeview.R +++ b/R/treeview.R @@ -18,6 +18,9 @@ #' @param heatmap_width,heatmap_offset Width relative to the tree and offset from the tree for the #' heatmap. #' @param heatmap_lab_offset Label-offset parameter for the constructed heatmap. +#' @param heatmap_fill Colours for filling the interior of the heatmap (which indicates the +#' presence / absence of a particular genotype). By default this is light grey for `FALSE` and +#' mid-grey for `TRUE`. #' #' @importFrom rlang .data #' @@ -33,7 +36,8 @@ treeview <- function(e0, output_format = c("rds", "html"), heatmap_width = .075, heatmap_offset = 8, - heatmap_lab_offset = -6) { + heatmap_lab_offset = -6, + heatmap_fill = c("FALSE" = "grey90", "TRUE" = "grey70")) { output_format <- match.arg(output_format, several.ok = TRUE) # require logistic growth rate, prevent non-empty diff --git a/man/append_heatmap.Rd b/man/append_heatmap.Rd index db0de17..ff72fc9 100644 --- a/man/append_heatmap.Rd +++ b/man/append_heatmap.Rd @@ -9,7 +9,8 @@ append_heatmap( genotype, heatmap_width = 1, heatmap_offset = 5, - heatmap_lab_offset = 0 + heatmap_lab_offset = 0, + heatmap_fill = c(`FALSE` = "grey90", `TRUE` = "grey70") ) } \arguments{ @@ -17,8 +18,14 @@ append_heatmap( \item{genotype}{The heatmap data.} -\item{heatmap_width, heatmap_offset, heatmap_lab_offset}{Parameters for positioning of the +\item{heatmap_width, heatmap_offset}{Width relative to the tree and offset from the tree for the heatmap.} + +\item{heatmap_lab_offset}{Label-offset parameter for the constructed heatmap.} + +\item{heatmap_fill}{Colours for filling the interior of the heatmap (which indicates the +presence / absence of a particular genotype). By default this is light grey for `FALSE` and +mid-grey for `TRUE`.} } \value{ A \code{ggtree} / \code{gg} / \code{ggplot} object with an appended heatmap. diff --git a/man/create_trees.Rd b/man/create_trees.Rd index 05814c4..2ed1e82 100644 --- a/man/create_trees.Rd +++ b/man/create_trees.Rd @@ -14,6 +14,7 @@ create_trees( heatmap_width, heatmap_offset, heatmap_lab_offset, + heatmap_fill = c(`FALSE` = "grey90", `TRUE` = "grey70"), mut_regex = NULL, colours = NULL, colour_limits = NULL @@ -35,9 +36,15 @@ vector of node numbers, these correspond to nodes in \code{ggtree_data$node}. \item{sc0, cmuts}{Data-frames.} -\item{heatmap_width, heatmap_offset, heatmap_lab_offset}{Parameters for positioning of the +\item{heatmap_width, heatmap_offset}{Width relative to the tree and offset from the tree for the heatmap.} +\item{heatmap_lab_offset}{Label-offset parameter for the constructed heatmap.} + +\item{heatmap_fill}{Colours for filling the interior of the heatmap (which indicates the +presence / absence of a particular genotype). By default this is light grey for `FALSE` and +mid-grey for `TRUE`.} + \item{mut_regex}{Regular expression. Defines the mutations under study here.} \item{colours}{Vector of colours.} diff --git a/man/treeview.Rd b/man/treeview.Rd index 83b484a..2663d0e 100644 --- a/man/treeview.Rd +++ b/man/treeview.Rd @@ -13,7 +13,8 @@ treeview( output_format = c("rds", "html"), heatmap_width = 0.075, heatmap_offset = 8, - heatmap_lab_offset = -6 + heatmap_lab_offset = -6, + heatmap_fill = c(`FALSE` = "grey90", `TRUE` = "grey70") ) } \arguments{ @@ -39,6 +40,10 @@ will be placed in a \code{html} file.} heatmap.} \item{heatmap_lab_offset}{Label-offset parameter for the constructed heatmap.} + +\item{heatmap_fill}{Colours for filling the interior of the heatmap (which indicates the +presence / absence of a particular genotype). By default this is light grey for `FALSE` and +mid-grey for `TRUE`.} } \value{ A \code{ggtree} plot. From 97ca176cee41f0d4f8076e32f4754112212556e5 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Wed, 6 Mar 2024 15:18:32 +0000 Subject: [PATCH 12/19] feat: define colours for dendrogram branches in treeview() args; Use Blue-Red diverging palette with light-grey midpoint --- R/treeview.R | 10 ++++++---- man/treeview.Rd | 5 +++++ 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/R/treeview.R b/R/treeview.R index c2bf402..9a01bc4 100644 --- a/R/treeview.R +++ b/R/treeview.R @@ -15,6 +15,8 @@ #' 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 dendrogram_colours Colours for the dendrogram statistics. Default is blue (low) to red +#' (high) with a light-grey for the mid-point of the statistic range. #' @param heatmap_width,heatmap_offset Width relative to the tree and offset from the tree for the #' heatmap. #' @param heatmap_lab_offset Label-offset parameter for the constructed heatmap. @@ -34,6 +36,9 @@ treeview <- function(e0, lineages = c("AY\\.9", "AY\\.43", "AY\\.4\\.2"), output_dir = "treeview", output_format = c("rds", "html"), + dendrogram_colours = c( + "#2166ac", "#738fc0", "#afbad4", "#e8e8e8", "#e0a9a4", "#ce6964", "#b2182b" + ), heatmap_width = .075, heatmap_offset = 8, heatmap_lab_offset = -6, @@ -179,9 +184,6 @@ treeview <- function(e0, } } - # cols for continuous stats - cols <- rev(c("red", "orange", "green", "cyan", "blue")) - # lineages for clade labels td$lineages1 <- sapply(strsplit(td$lineages, split = "\\|"), "[", 1) sc0$lineage1 <- sapply(strsplit(sc0$lineage, split = "\\|"), "[", 1) @@ -240,7 +242,7 @@ treeview <- function(e0, sc0 = sc0, cmuts = cmuts, mut_regex = mutations, - colours = cols, + colours = dendrogram_colours, heatmap_width = heatmap_width, heatmap_offset = heatmap_offset, heatmap_lab_offset = heatmap_lab_offset diff --git a/man/treeview.Rd b/man/treeview.Rd index 2663d0e..d5b3202 100644 --- a/man/treeview.Rd +++ b/man/treeview.Rd @@ -11,6 +11,8 @@ treeview( lineages = c("AY\\\\.9", "AY\\\\.43", "AY\\\\.4\\\\.2"), output_dir = "treeview", output_format = c("rds", "html"), + dendrogram_colours = c("#2166ac", "#738fc0", "#afbad4", "#e8e8e8", "#e0a9a4", + "#ce6964", "#b2182b"), heatmap_width = 0.075, heatmap_offset = 8, heatmap_lab_offset = -6, @@ -36,6 +38,9 @@ format(s) should the interactive plots be saved? For \code{rds}, a \code{ggtree} \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{dendrogram_colours}{Colours for the dendrogram statistics. Default is blue (low) to red +(high) with a light-grey for the mid-point of the statistic range.} + \item{heatmap_width, heatmap_offset}{Width relative to the tree and offset from the tree for the heatmap.} From 4c3f264b8b89399a3fb6b4b2934675e53f4827cb Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 11:37:00 +0000 Subject: [PATCH 13/19] feat: dendrogram statistic ranges are centred on zero --- R/treeview.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/treeview.R b/R/treeview.R index 9a01bc4..bf4b1d1 100644 --- a/R/treeview.R +++ b/R/treeview.R @@ -263,9 +263,10 @@ treeview <- function(e0, ) for (branch_col in setdiff(branch_cols, c("logistic_growth_rate"))) { + zero_centred_colour_limits <- c(-1, 1) * max(abs(td[[branch_col]])) tree_list <- create_trees_curried( branch_col = branch_col, - colour_limits = range(td[[branch_col]]) + colour_limits = zero_centred_colour_limits ) save_trees( tree_list, From a0ff2bdf3bc10c1ea37591757759299b084e848b Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 14:12:18 +0000 Subject: [PATCH 14/19] refac: height/width of tree plot output stored in consistently-named vars in 'save_trees' --- R/plot_tree.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index 7bb0624..736f391 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -110,6 +110,9 @@ save_trees <- function(tree_list, c(rds = "interactive_rds", html = "interactive_html")[output_format] ) + height_svg <- max(14, floor(n_leaves / 10)) + width_svg <- 16 + basename_prefix <- if (include_date) { glue::glue("tree-{branch_col}-{Sys.Date()}") } else { @@ -127,13 +130,11 @@ save_trees <- function(tree_list, required_filetypes ) - plot_height <- max(14, floor(n_leaves / 10)) - ggplot2::ggsave( tree_list[["noninteractive"]], filename = files[["noninteractive"]], - height = plot_height, - width = 16, + height = height_svg, + width = width_svg, limitsize = FALSE ) @@ -147,8 +148,8 @@ save_trees <- function(tree_list, if ("html" %in% output_format) { widget <- create_widget( tree_list[["interactive"]], - width_svg = 15, - height_svg = plot_height + width_svg = width_svg, + height_svg = height_svg ) htmlwidgets::saveWidget( From 193227d170f52a518533b29fd8b0d91ab1e3ee3a Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 14:29:22 +0000 Subject: [PATCH 15/19] refac: width/height of tree-views is specified in treeview() rather than in (non-exported) save_trees() This makes the function call for save_trees() more similar to save_sina_plot(), where the width and height are specified as function arguments. --- R/plot_tree.R | 11 +++++------ R/treeview.R | 13 +++++++++---- inst/WORDLIST | 3 +++ man/save_trees.Rd | 10 ++++++---- tests/testthat/test-plot_tree.R | 8 ++++---- 5 files changed, 27 insertions(+), 18 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index 736f391..e162582 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -94,25 +94,24 @@ create_trees <- function(ggtree_data, #' 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 +#' @param height_svg,width_svg Scalar numeric. Height/width of the generated plots. Passed on to +#' `ggplot2::ggsave(..., height, width)` and `ggiraph::girafe(..., height_svg, width_svg)`. #' #' @return A named vector containing the file paths that were generated. save_trees <- function(tree_list, branch_col, - n_leaves, output_dir, output_format = c("rds", "html"), - include_date = FALSE) { + include_date = FALSE, + height_svg = NULL, + width_svg = NULL) { output_format <- match.arg(output_format, several.ok = TRUE) required_filetypes <- c( "noninteractive", c(rds = "interactive_rds", html = "interactive_html")[output_format] ) - height_svg <- max(14, floor(n_leaves / 10)) - width_svg <- 16 - basename_prefix <- if (include_date) { glue::glue("tree-{branch_col}-{Sys.Date()}") } else { diff --git a/R/treeview.R b/R/treeview.R index bf4b1d1..609d429 100644 --- a/R/treeview.R +++ b/R/treeview.R @@ -250,6 +250,9 @@ treeview <- function(e0, } suppressWarnings({ + height_svg <- max(14, floor(n_leaves / 10)) + width_svg <- 16 + lgr_trees <- create_trees_curried( branch_col = "logistic_growth_rate", colour_limits = c(-.5, .5) @@ -257,9 +260,10 @@ treeview <- function(e0, save_trees( lgr_trees, branch_col = "logistic_growth_rate", - n_leaves = n_leaves, output_dir = output_dir, - output_format = output_format + output_format = output_format, + height_svg = height_svg, + width_svg = width_svg ) for (branch_col in setdiff(branch_cols, c("logistic_growth_rate"))) { @@ -271,9 +275,10 @@ treeview <- function(e0, save_trees( tree_list, branch_col = branch_col, - n_leaves = n_leaves, output_dir = output_dir, - output_format = output_format + output_format = output_format, + height_svg = height_svg, + width_svg = width_svg ) } }) diff --git a/inst/WORDLIST b/inst/WORDLIST index 3853463..d629804 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -22,7 +22,9 @@ foreach generalised ggiraph ggplot +ggsave ggtree +girafe grey htmlwidget htmlwidgets @@ -61,6 +63,7 @@ stringr styler sublicense summarised +svg svglite SystemRequirements testthat diff --git a/man/save_trees.Rd b/man/save_trees.Rd index a140cf7..2790177 100644 --- a/man/save_trees.Rd +++ b/man/save_trees.Rd @@ -7,10 +7,11 @@ save_trees( tree_list, branch_col, - n_leaves, output_dir, output_format = c("rds", "html"), - include_date = FALSE + include_date = FALSE, + height_svg = NULL, + width_svg = NULL ) } \arguments{ @@ -20,8 +21,6 @@ entries will be saved to an external file. As generated by \code{create_trees}.} \item{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.} -\item{n_leaves}{Scalar integer. The number of leaves in the tree.} - \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 @@ -30,6 +29,9 @@ object will be placed in an \code{rds} file. For \code{html}, a \code{htmlwidget placed in a \code{html} file.} \item{include_date}{Boolean. Should the file-paths include the current date?} + +\item{height_svg, width_svg}{Scalar numeric. Height/width of the generated plots. Passed on to +`ggplot2::ggsave(..., height, width)` and `ggiraph::girafe(..., height_svg, width_svg)`.} } \value{ A named vector containing the file paths that were generated. diff --git a/tests/testthat/test-plot_tree.R b/tests/testthat/test-plot_tree.R index 9ed7596..1c7eca7 100644 --- a/tests/testthat/test-plot_tree.R +++ b/tests/testthat/test-plot_tree.R @@ -33,7 +33,7 @@ describe("save_trees", { created_files <- save_trees( tree_list, - branch_col = branch_col, output_dir = td, n_leaves = 100 + branch_col = branch_col, output_dir = td, width_svg = 16, height_svg = 14 ) expect_mapequal(created_files, expected_files) @@ -54,7 +54,7 @@ describe("save_trees", { created_files <- save_trees( tree_list, - branch_col = branch_col, output_dir = td, n_leaves = 100, + branch_col = branch_col, output_dir = td, width_svg = 16, height_svg = 14, output_format = "html" ) @@ -77,7 +77,7 @@ describe("save_trees", { created_files <- save_trees( tree_list, - branch_col = branch_col, output_dir = td, n_leaves = 100, + branch_col = branch_col, output_dir = td, width_svg = 16, height_svg = 14, output_format = "rds" ) @@ -100,7 +100,7 @@ describe("save_trees", { created_files <- save_trees( tree_list, - branch_col = branch_col, output_dir = td, n_leaves = 100, include_date = TRUE + branch_col = branch_col, output_dir = td, width_svg = 16, height_svg = 14, include_date = TRUE ) expect_mapequal(created_files, expected_files) From 64ede8e700b91d6bb11680914dbe0ef909f022b0 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 15 Apr 2024 15:42:41 +0100 Subject: [PATCH 16/19] chore: bump version number --- DESCRIPTION | 2 +- NEWS.md | 11 +++++++++++ inst/WORDLIST | 3 +++ 3 files changed, 15 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4e71aa1..533ffaf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: tfpscanner Title: Transmission fitness polymorphism scanner -Version: 0.3.0 +Version: 0.3.1 Date: 2023-01-18 Author: Erik Volz, Olivia Boyd Maintainer: Erik Volz diff --git a/NEWS.md b/NEWS.md index b454e46..4ed37e6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,14 @@ +# tfpscanner 0.3.1 + +- Feature: genotype TRUE/FALSE legends were squashed into 1 column on the heatmap/dendrogram figure +- Feature: genotype TRUE/FALSE colours in the heatmaps are now light/mid grey instead of colourful + to reduce colour clashes with the dendrogram colour scheme +- Feature: user can set `heatmap_offset` in `treeview()` for dictating the distance between the + heatmap and dendrogram +- Feature: Colours for dendrogram branches can be defined in the `treeview()` args; by default these + are now a Blue-Red diverging palette with light-grey midpoint +- Feature: Dendrogram statistic ranges are now centred on zero + # tfpscanner 0.3.0 _2023-07-06_ - Feature: function `create_browser_data()` was added to generate all treeview illustrations and diff --git a/inst/WORDLIST b/inst/WORDLIST index d629804..5005116 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,4 +1,6 @@ allmuts +args +centred clade Clade clades @@ -6,6 +8,7 @@ clusterID clusterIDs CMD colour +colourful Config CoV cpu From ee35873067d7e96685c04027927f404feb1aaced Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Fri, 25 Oct 2024 19:19:18 +0100 Subject: [PATCH 17/19] add remote for {ggtree} to DESCRIPTION --- DESCRIPTION | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 533ffaf..c449caf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,14 @@ Package: tfpscanner -Title: Transmission fitness polymorphism scanner +Title: Transmission fitness polymorphism scanner Version: 0.3.1 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 - patterns and high evolutionary rates. +Description: A pipeline for scanning a SARS-CoV-2 phylogeny for clades + with outlying growth patterns and high evolutionary rates. +License: MIT + file LICENSE Depends: - R (>= 4.1.0) + R (>= 4.1.0) Imports: ape, dplyr, @@ -38,9 +39,9 @@ Suggests: testthat (>= 3.0.0), withr Remotes: - emvolz-phylodynamics/mlesky -SystemRequirements: libopenmpi-dev + emvolz-phylodynamics/mlesky, + YuLab-SMU/ggtree +Config/testthat/edition: 3 Encoding: UTF-8 -License: MIT + file LICENSE RoxygenNote: 7.2.3 -Config/testthat/edition: 3 +SystemRequirements: libopenmpi-dev From 8a67ec2e01c6fa668daa7a790e16407b68a5fea3 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Fri, 25 Oct 2024 19:30:16 +0100 Subject: [PATCH 18/19] fix: set heatmap_offset default to old value 0.0005 --- R/plot_tree.R | 2 +- R/treeview.R | 2 +- man/append_heatmap.Rd | 2 +- man/treeview.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/plot_tree.R b/R/plot_tree.R index e162582..d717fc9 100644 --- a/R/plot_tree.R +++ b/R/plot_tree.R @@ -386,7 +386,7 @@ extract_genotype_data <- function(ggobj, append_heatmap <- function(ggobj, genotype, heatmap_width = 1, - heatmap_offset = 5, + heatmap_offset, heatmap_lab_offset = 0, heatmap_fill = c("FALSE" = "grey90", "TRUE" = "grey70")) { ggtree::gheatmap( diff --git a/R/treeview.R b/R/treeview.R index 609d429..ce54ad3 100644 --- a/R/treeview.R +++ b/R/treeview.R @@ -40,7 +40,7 @@ treeview <- function(e0, "#2166ac", "#738fc0", "#afbad4", "#e8e8e8", "#e0a9a4", "#ce6964", "#b2182b" ), heatmap_width = .075, - heatmap_offset = 8, + heatmap_offset = 0.0005, heatmap_lab_offset = -6, heatmap_fill = c("FALSE" = "grey90", "TRUE" = "grey70")) { output_format <- match.arg(output_format, several.ok = TRUE) diff --git a/man/append_heatmap.Rd b/man/append_heatmap.Rd index ff72fc9..f5b90d9 100644 --- a/man/append_heatmap.Rd +++ b/man/append_heatmap.Rd @@ -8,7 +8,7 @@ append_heatmap( ggobj, genotype, heatmap_width = 1, - heatmap_offset = 5, + heatmap_offset, heatmap_lab_offset = 0, heatmap_fill = c(`FALSE` = "grey90", `TRUE` = "grey70") ) diff --git a/man/treeview.Rd b/man/treeview.Rd index d5b3202..773118e 100644 --- a/man/treeview.Rd +++ b/man/treeview.Rd @@ -14,7 +14,7 @@ treeview( dendrogram_colours = c("#2166ac", "#738fc0", "#afbad4", "#e8e8e8", "#e0a9a4", "#ce6964", "#b2182b"), heatmap_width = 0.075, - heatmap_offset = 8, + heatmap_offset = 5e-04, heatmap_lab_offset = -6, heatmap_fill = c(`FALSE` = "grey90", `TRUE` = "grey70") ) From cff68e483226bebe35436ee527fc61dcb5671951 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Fri, 25 Oct 2024 19:37:31 +0100 Subject: [PATCH 19/19] remove ggtree remote from DESCRIPTION, for bioconductor >= 3.18 the remote isn't needed --- DESCRIPTION | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c449caf..c435a47 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,9 +39,8 @@ Suggests: testthat (>= 3.0.0), withr Remotes: - emvolz-phylodynamics/mlesky, - YuLab-SMU/ggtree + emvolz-phylodynamics/mlesky Config/testthat/edition: 3 Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 SystemRequirements: libopenmpi-dev