Scatter plot sizes

DESCRIPTION

@@ -20,6 +20,7 @@ Imports:
     htmltools,
     janitor,
     magrittr,
+    markdown,
     purrr,
     reactable,
     readr,

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

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)
 }

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()
+  }
+}

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"

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