update renv files locally

episodes/model-choices.Rmd

@@ -197,7 +197,7 @@
 + $\rho^E$, the mean preinfectious period,
 + $p_{hosp}$ the probability of being transferred to the hospitalised compartment. 
 
 **Note: the functional relationship between the preinfectious  period ($\rho^E$) and the transition rate between exposed and infectious ($\gamma^E$) is $\rho^E = k^E/\gamma^E$ where $k^E$ is the shape of the Erlang distribution. Similarly for the infectious period $\rho^I = k^I/\gamma^I$. See [here](https://epiverse-trace.github.io/epidemics/articles/ebola_model.html#details-discrete-time-ebola-virus-disease-model) for more detail on the stochastic model formulation. ** 
 
 ```{r, echo = FALSE, message = FALSE}
 DiagrammeR::grViz("digraph {
@@ -334,10 +334,13 @@
   prop_community = 0.9,
   etu_risk = 0.7,
   funeral_risk = 0.5,
-  time_end = 100
+  time_end = 100,
+  replicates = 1 # replicates argument
 )
 
-ggplot(output[output$compartment == "infectious", ]) +
+output %>%
+  filter(compartment == "infectious") %>%
+  ggplot() +
   geom_line(
     aes(time, value),
     linewidth = 1.2
@@ -359,31 +362,23 @@
 We run the model 100 times with the *same* parameter values. 
 
 ```{r}
-output_samples <- Map(
-  x = seq(100),
-  f = function(x) {
-    output <- model_ebola(
-      population = guinea_population,
-      transmission_rate = 1.1 / 12,
-      infectiousness_rate = 2.0 / 5,
-      removal_rate = 2.0 / 12,
-      prop_community = 0.9,
-      etu_risk = 0.7,
-      funeral_risk = 0.5,
-      time_end = 100
-    )
-    # add replicate number and return data
-    output$replicate <- x
-    output
-  }
+output_replicates <- model_ebola(
+  population = guinea_population,
+  transmission_rate = 1.1 / 12,
+  infectiousness_rate = 2.0 / 5,
+  removal_rate = 2.0 / 12,
+  prop_community = 0.9,
+  etu_risk = 0.7,
+  funeral_risk = 0.5,
+  time_end = 100,
+  replicates = 100 # replicates argument
 )
 
-output_samples <- bind_rows(output_samples) # requires the dplyr package
-
-ggplot(
-  output_samples[output_samples$compartment == "infectious", ],
-  aes(time, value)
-) +
+output_replicates %>%
+  filter(compartment == "infectious") %>%
+  ggplot(
+    aes(time, value)
+  ) +
   stat_summary(geom = "line", fun = mean) +
   stat_summary(
     geom = "ribbon",

renv/activate.R

@@ -2,11 +2,13 @@
 local({
 
   # the requested version of renv
-  version <- "1.0.3"
+  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")
@@ -31,6 +33,14 @@ local({
     if (!is.null(override))
       return(override)
 
+    # if we're being run in a context where R_LIBS is already set,
+    # don't load -- presumably we're being run as a sub-process and
+    # the parent process has already set up library paths for us
+    rcmd <- Sys.getenv("R_CMD", unset = NA)
+    rlibs <- Sys.getenv("R_LIBS", unset = NA)
+    if (!is.na(rlibs) && !is.na(rcmd))
+      return(FALSE)
+
     # next, check environment variables
     # TODO: prefer using the configuration one in the future
     envvars <- c(
@@ -50,9 +60,22 @@ local({
 
   })
 
-  if (!enabled)
+  # bail if we're not enabled
+  if (!enabled) {
+
+    # if we're not enabled, we might still need to manually load
+    # the user profile here
+    profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
+    if (file.exists(profile)) {
+      cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE")
+      if (tolower(cfg) %in% c("true", "t", "1"))
+        sys.source(profile, envir = globalenv())
+    }
+
     return(FALSE)
 
+  }
+
   # avoid recursion
   if (identical(getOption("renv.autoloader.running"), TRUE)) {
     warning("ignoring recursive attempt to run renv autoloader")
@@ -108,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
   }
@@ -610,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())
 
@@ -801,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
@@ -1041,7 +1081,7 @@ local({
     # if jsonlite is loaded, use that instead
     if ("jsonlite" %in% loadedNamespaces()) {
 
-      json <- catch(renv_json_read_jsonlite(file, text))
+      json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity)
       if (!inherits(json, "error"))
         return(json)
 
@@ -1050,7 +1090,7 @@ local({
     }
 
     # otherwise, fall back to the default JSON reader
-    json <- catch(renv_json_read_default(file, text))
+    json <- tryCatch(renv_json_read_default(file, text), error = identity)
     if (!inherits(json, "error"))
       return(json)
 
@@ -1063,14 +1103,14 @@ local({
   }
 
   renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
-    text <- paste(text %||% read(file), collapse = "\n")
+    text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
     jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
   }
 
   renv_json_read_default <- function(file = NULL, text = NULL) {
 
     # find strings in the JSON
-    text <- paste(text %||% read(file), collapse = "\n")
+    text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
     pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
     locs <- gregexpr(pattern, text, perl = TRUE)[[1]]
 
@@ -1118,14 +1158,14 @@ local({
     map <- as.list(map)
 
     # remap strings in object
-    remapped <- renv_json_remap(json, map)
+    remapped <- renv_json_read_remap(json, map)
 
     # evaluate
     eval(remapped, envir = baseenv())
 
   }
 
-  renv_json_remap <- function(json, map) {
+  renv_json_read_remap <- function(json, map) {
 
     # fix names
     if (!is.null(names(json))) {
@@ -1152,7 +1192,7 @@ local({
     # recurse
     if (is.recursive(json)) {
       for (i in seq_along(json)) {
-        json[i] <- list(renv_json_remap(json[[i]], map))
+        json[i] <- list(renv_json_read_remap(json[[i]], map))
       }
     }