From 26b188454242a2d3e206412f38b6c645bdddf31d Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Tue, 16 Apr 2024 13:50:30 +0100 Subject: [PATCH 1/7] env: bump the version of {renv} --- renv.lock | 5 ++++- renv/activate.R | 43 +++++++++++++++++++++++++++++++------------ 2 files changed, 35 insertions(+), 13 deletions(-) diff --git a/renv.lock b/renv.lock index c510492..f14bce5 100644 --- a/renv.lock +++ b/renv.lock @@ -1401,7 +1401,10 @@ }, "renv": { "Package": "renv", - "Version": "1.0.5", + "Version": "1.0.7", + "OS_type": null, + "NeedsCompilation": "no", + "Repository": "CRAN", "Source": "Repository" }, "rlang": { diff --git a/renv/activate.R b/renv/activate.R index 9b2e7f1..d13f993 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,11 +2,13 @@ local({ # the requested version of renv - version <- "1.0.5" + version <- "1.0.7" attr(version, "sha") <- NULL # the project directory - project <- getwd() + project <- Sys.getenv("RENV_PROJECT") + if (!nzchar(project)) + project <- getwd() # use start-up diagnostics if enabled diagnostics <- Sys.getenv("RENV_STARTUP_DIAGNOSTICS", unset = "FALSE") @@ -129,6 +131,21 @@ local({ } + heredoc <- function(text, leave = 0) { + + # remove leading, trailing whitespace + trimmed <- gsub("^\\s*\\n|\\n\\s*$", "", text) + + # split into lines + lines <- strsplit(trimmed, "\n", fixed = TRUE)[[1L]] + + # compute common indent + indent <- regexpr("[^[:space:]]", lines) + common <- min(setdiff(indent, -1L)) - leave + paste(substring(lines, common), collapse = "\n") + + } + startswith <- function(string, prefix) { substring(string, 1, nchar(prefix)) == prefix } @@ -631,6 +648,9 @@ local({ # if the user has requested an automatic prefix, generate it auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA) + if (is.na(auto) && getRversion() >= "4.4.0") + auto <- "TRUE" + if (auto %in% c("TRUE", "True", "true", "1")) return(renv_bootstrap_platform_prefix_auto()) @@ -822,24 +842,23 @@ local({ # the loaded version of renv doesn't match the requested version; # give the user instructions on how to proceed - remote <- if (!is.null(description[["RemoteSha"]])) { + dev <- identical(description[["RemoteType"]], "github") + remote <- if (dev) paste("rstudio/renv", description[["RemoteSha"]], sep = "@") - } else { + else paste("renv", description[["Version"]], sep = "@") - } # display both loaded version + sha if available friendly <- renv_bootstrap_version_friendly( version = description[["Version"]], - sha = description[["RemoteSha"]] + sha = if (dev) description[["RemoteSha"]] ) - fmt <- paste( - "renv %1$s was loaded from project library, but this project is configured to use renv %2$s.", - "- Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.", - "- Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.", - sep = "\n" - ) + fmt <- heredoc(" + renv %1$s was loaded from project library, but this project is configured to use renv %2$s. + - Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile. + - Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library. + ") catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote) FALSE From 78d5e7a4147964ca99c55a2c36cb47306895cafc Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Tue, 16 Apr 2024 14:05:16 +0100 Subject: [PATCH 2/7] env: add {bsicons} to renv.lock --- renv.lock | 46 ++++++++++++++++++++++------------------------ 1 file changed, 22 insertions(+), 24 deletions(-) diff --git a/renv.lock b/renv.lock index f14bce5..325cd49 100644 --- a/renv.lock +++ b/renv.lock @@ -225,6 +225,20 @@ ], "Hash": "68bd2b066e1fe780bbf62fc8bcc36de3" }, + "bsicons": { + "Package": "bsicons", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "htmltools", + "rlang", + "utils" + ], + "Hash": "d8f892fbd94d0b9b1f6d688b05b8633c" + }, "bslib": { "Package": "bslib", "Version": "0.6.1", @@ -772,13 +786,7 @@ "Package": "highr", "Version": "0.10", "Source": "Repository", - "Repository": "RSPM", - "RemoteType": "standard", - "RemotePkgRef": "highr", - "RemoteRef": "highr", - "RemoteRepos": "https://packagemanager.rstudio.com/all/latest", - "RemotePkgPlatform": "source", - "RemoteSha": "0.10", + "Repository": "https://packagemanager.rstudio.com/all/latest", "Requirements": [ "R", "xfun" @@ -904,13 +912,7 @@ "Package": "janitor", "Version": "2.2.0", "Source": "Repository", - "Repository": "RSPM", - "RemoteType": "standard", - "RemotePkgRef": "janitor", - "RemoteRef": "janitor", - "RemoteRepos": "https://packagemanager.rstudio.com/all/latest", - "RemotePkgPlatform": "source", - "RemoteSha": "2.2.0", + "Repository": "https://packagemanager.rstudio.com/all/latest", "Requirements": [ "R", "dplyr", @@ -1402,10 +1404,12 @@ "renv": { "Package": "renv", "Version": "1.0.7", - "OS_type": null, - "NeedsCompilation": "no", + "Source": "Repository", "Repository": "CRAN", - "Source": "Repository" + "Requirements": [ + "utils" + ], + "Hash": "397b7b2a265bc5a7a06852524dabae20" }, "rlang": { "Package": "rlang", @@ -1530,13 +1534,7 @@ "Package": "shinybrowser", "Version": "1.0.0", "Source": "Repository", - "Repository": "RSPM", - "RemoteType": "standard", - "RemotePkgRef": "shinybrowser", - "RemoteRef": "shinybrowser", - "RemoteRepos": "https://packagemanager.rstudio.com/all/latest", - "RemotePkgPlatform": "source", - "RemoteSha": "1.0.0", + "Repository": "https://packagemanager.rstudio.com/all/latest", "Requirements": [ "R", "shiny" From c3dc4a2a2eeef3ce473e9519d667c23ba4bb8ce1 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Tue, 16 Apr 2024 16:04:40 +0100 Subject: [PATCH 3/7] fix: get_data_dir() should return fully-specified path for data directory --- R/config.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/config.R b/R/config.R index 9217639..c904513 100644 --- a/R/config.R +++ b/R/config.R @@ -8,8 +8,10 @@ #' @return Scalar string. The data-directory for use in the app. get_data_dir = function() { - Sys.getenv( + path = Sys.getenv( "APP_DATA_DIR", system.file("app", "www", "data", package = "tfpbrowser") ) + + normalizePath(path) } From a347c0f23ec8ba709ae272fd40f117c2b9d2a50c Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 15:19:53 +0000 Subject: [PATCH 4/7] refac: move creation of interactive ggiraph graphics into a function --- R/app_server.R | 48 ++++++--------------------------- R/ggiraph.R | 64 ++++++++++++++++++++++++++++++++++++++++++++ man/create_girafe.Rd | 29 ++++++++++++++++++++ 3 files changed, 101 insertions(+), 40 deletions(-) create mode 100644 R/ggiraph.R create mode 100644 man/create_girafe.Rd diff --git a/R/app_server.R b/R/app_server.R index f6c4318..8b6db4d 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -36,53 +36,21 @@ app_server = function(input, output, session) { # create ggiraph output from saved ggplot2 outputs output$treeview = ggiraph::renderGirafe({ shiny::req(input$widgetChoice) - # define tooltip - tooltip_css = paste0( - "background-color:black;", - "color:grey;", - "padding:14px;", - "border-radius:8px;", - "font-family:\"Courier New\",monospace;" - ) - # set options - if (input$widgetChoice == "tree-mutations.rds") { - girafe_options = list( - ggiraph::opts_selection(css = "fill:red;"), - ggiraph::opts_selection_inv(css = "fill:grey;"), - ggiraph::opts_sizing(rescale = FALSE), - ggiraph::opts_zoom(max = 5), - ggiraph::opts_tooltip( - css = tooltip_css, - use_fill = FALSE - ) - ) - } else { - girafe_options = list( - ggiraph::opts_selection(type = "single"), - ggiraph::opts_sizing(rescale = FALSE), - ggiraph::opts_zoom(max = 5), - ggiraph::opts_tooltip( - css = tooltip_css, - use_fill = FALSE - ) - ) - } + # set size w = shinybrowser::get_width() / 72 h = (1800 - 40) / 72 - # make tree - suppressWarnings( - ggiraph::girafe( - ggobj = imported_ggtree(), - width_svg = w, - height_svg = h, - options = girafe_options - ) + + create_girafe( + ggobj = imported_ggtree(), + widget_choice = input$widgetChoice, + width_svg = w, + height_svg = h, + suppress_warnings = TRUE ) }) %>% shiny::bindCache(input$widgetChoice) - # Mutation colouring ------------------------------------------------------ # disable dropdown unless mutation treeview diff --git a/R/ggiraph.R b/R/ggiraph.R new file mode 100644 index 0000000..0a0f5a2 --- /dev/null +++ b/R/ggiraph.R @@ -0,0 +1,64 @@ +#' Convert a ggplot object into an interactive {ggiraph} object +#' +#' @param ggobj The ggplot2/ggtree object. +#' @param widget_choice Scalar character. Describes the type of plot that is contained in +#' `ggobj`. Typically a file basename that includes the file extension, of the form "tree-XXX.rds" +#' (for `{ggtree}` objects) or "sina-XXX.rds" (for `{ggplot2}` scatter plots). +#' @param width_svg,height_svg Scalar numeric. The width/height of the output plot. +#' @param suppress_warnings Scalar logical. Should warnings from `ggiraph::girafe()` be printed +#' to the console? +create_girafe = function( + ggobj, + widget_choice, + width_svg, + height_svg, + suppress_warnings = FALSE) { + # define tooltip + tooltip_css = paste0( + "background-color:black;", + "color:grey;", + "padding:14px;", + "border-radius:8px;", + "font-family:\"Courier New\",monospace;" + ) + + # set options + if (widget_choice == "tree-mutations.rds") { + girafe_options = list( + ggiraph::opts_selection(css = "fill:red;"), + ggiraph::opts_selection_inv(css = "fill:grey;"), + ggiraph::opts_sizing(rescale = FALSE), + ggiraph::opts_zoom(max = 5), + ggiraph::opts_tooltip( + css = tooltip_css, + use_fill = FALSE + ) + ) + } else { + girafe_options = list( + ggiraph::opts_selection(type = "single"), + ggiraph::opts_sizing(rescale = FALSE), + ggiraph::opts_zoom(max = 5), + ggiraph::opts_tooltip( + css = tooltip_css, + use_fill = FALSE + ) + ) + } + + create_widget = function() { + ggiraph::girafe( + ggobj = ggobj, + width_svg = width_svg, + height_svg = height_svg, + options = girafe_options + ) + } + + # make tree + if (suppress_warnings) { + suppressWarnings(create_widget()) + } else { + create_widget() + } +} diff --git a/man/create_girafe.Rd b/man/create_girafe.Rd new file mode 100644 index 0000000..3776c91 --- /dev/null +++ b/man/create_girafe.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ggiraph.R +\name{create_girafe} +\alias{create_girafe} +\title{Convert a ggplot object into an interactive {ggiraph} object} +\usage{ +create_girafe( + ggobj, + widget_choice, + width_svg, + height_svg, + suppress_warnings = FALSE +) +} +\arguments{ +\item{ggobj}{The ggplot2/ggtree object.} + +\item{widget_choice}{Scalar character. Describes the type of plot that is contained in +\code{ggobj}. Typically a file basename that includes the file extension, of the form "tree-XXX.rds" +(for \code{{ggtree}} objects) or "sina-XXX.rds" (for \code{{ggplot2}} scatter plots).} + +\item{width_svg, height_svg}{Scalar numeric. The width/height of the output plot.} + +\item{suppress_warnings}{Scalar logical. Should warnings from \code{ggiraph::girafe()} be printed +to the console?} +} +\description{ +Convert a ggplot object into an interactive {ggiraph} object +} From b3cf4b033c29f893934a7be0cbe31d12594a9635 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Mon, 11 Mar 2024 15:29:15 +0000 Subject: [PATCH 5/7] refac: reduce some duplicated code for setting girafe options --- R/ggiraph.R | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/R/ggiraph.R b/R/ggiraph.R index 0a0f5a2..0b49ced 100644 --- a/R/ggiraph.R +++ b/R/ggiraph.R @@ -23,29 +23,26 @@ create_girafe = function( ) # set options - if (widget_choice == "tree-mutations.rds") { - girafe_options = list( + common_options = list( + ggiraph::opts_sizing(rescale = FALSE), + ggiraph::opts_zoom(max = 5), + ggiraph::opts_tooltip( + css = tooltip_css, + use_fill = FALSE + ) + ) + + plot_specific_options = if (widget_choice == "tree-mutations.rds") { + list( ggiraph::opts_selection(css = "fill:red;"), - ggiraph::opts_selection_inv(css = "fill:grey;"), - ggiraph::opts_sizing(rescale = FALSE), - ggiraph::opts_zoom(max = 5), - ggiraph::opts_tooltip( - css = tooltip_css, - use_fill = FALSE - ) + ggiraph::opts_selection_inv(css = "fill:grey;") ) } else { - girafe_options = list( - ggiraph::opts_selection(type = "single"), - ggiraph::opts_sizing(rescale = FALSE), - ggiraph::opts_zoom(max = 5), - ggiraph::opts_tooltip( - css = tooltip_css, - use_fill = FALSE - ) - ) + list(ggiraph::opts_selection(type = "single")) } + girafe_options = c(plot_specific_options, common_options) + create_widget = function() { ggiraph::girafe( ggobj = ggobj, From f1cfb0d3dba8814cca537ad83d81f1066d805906 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Thu, 14 Mar 2024 11:31:06 +0000 Subject: [PATCH 6/7] feat: scatterplots are less tall than dendrograms --- R/app_server.R | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 8b6db4d..64f7a78 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -37,15 +37,20 @@ app_server = function(input, output, session) { output$treeview = ggiraph::renderGirafe({ shiny::req(input$widgetChoice) - # set size - w = shinybrowser::get_width() / 72 - h = (1800 - 40) / 72 + # set the relative height/width of the ggiraph-based graphs + is_dendrogram = grepl("^tree-", x = input$widgetChoice) + width = shinybrowser::get_width() / 72 + height = if (is_dendrogram) { + (1800 - 40) / 72 + } else { + (600 - 40) / 72 + } create_girafe( ggobj = imported_ggtree(), widget_choice = input$widgetChoice, - width_svg = w, - height_svg = h, + width_svg = width, + height_svg = height, suppress_warnings = TRUE ) }) %>% From 19710976b94d6ca8fecf2485ecd47065736ead00 Mon Sep 17 00:00:00 2001 From: Russ Hyde Date: Thu, 2 May 2024 14:17:56 +0100 Subject: [PATCH 7/7] env: add {markdown} dependency, needed by shiny::includeMarkdown --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 89c47da..b891a68 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,6 +20,7 @@ Imports: htmltools, janitor, magrittr, + markdown, purrr, reactable, readr,