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, diff --git a/R/app_server.R b/R/app_server.R index f6c4318..64f7a78 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -36,53 +36,26 @@ 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 - ) - ) + + # 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 { - 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 - ) - ) + (600 - 40) / 72 } - # 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 = width, + height_svg = height, + suppress_warnings = TRUE ) }) %>% shiny::bindCache(input$widgetChoice) - # Mutation colouring ------------------------------------------------------ # disable dropdown unless mutation treeview 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) } diff --git a/R/ggiraph.R b/R/ggiraph.R new file mode 100644 index 0000000..0b49ced --- /dev/null +++ b/R/ggiraph.R @@ -0,0 +1,61 @@ +#' 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 + 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;") + ) + } else { + list(ggiraph::opts_selection(type = "single")) + } + + girafe_options = c(plot_specific_options, common_options) + + 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 +} diff --git a/renv.lock b/renv.lock index c510492..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", @@ -1401,8 +1403,13 @@ }, "renv": { "Package": "renv", - "Version": "1.0.5", - "Source": "Repository" + "Version": "1.0.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "397b7b2a265bc5a7a06852524dabae20" }, "rlang": { "Package": "rlang", @@ -1527,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" 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