Issue #340: Use .data$ in right hand side of dplyr for safety (#348)

* Put .data$ into mutate calls

* Add .data$ to filter

* obs_time is not a column!

* pfilt_t also now a row

* Regeneration globals

R/diagnostics.R

@@ -46,8 +46,9 @@ epidist_diagnostics <- function(fit) {
       max_treedepth = max(np[treedepth_ind, ]$Value)
     ) |>
       mutate(
-        no_at_max_treedepth = sum(np[treedepth_ind, ]$Value == max_treedepth),
-        per_at_max_treedepth = no_at_max_treedepth / samples
+        no_at_max_treedepth =
+          sum(np[treedepth_ind, ]$Value == .data$max_treedepth),
+        per_at_max_treedepth = .data$no_at_max_treedepth / samples
       )
   } else {
     cli_abort(c(

R/globals.R

@@ -1,38 +1,13 @@
 # Generated by roxyglobals: do not edit by hand
 
 utils::globalVariables(c(
-  "max_treedepth", # <epidist_diagnostics>
-  "no_at_max_treedepth", # <epidist_diagnostics>
   "samples", # <epidist_diagnostics>
-  "obs_at", # <as_latent_individual.data.frame>
-  "ptime_lwr", # <as_latent_individual.data.frame>
   "stime_lwr", # <as_latent_individual.data.frame>
-  "ptime_upr", # <as_latent_individual.data.frame>
   "stime_upr", # <as_latent_individual.data.frame>
-  "row_id", # <as_latent_individual.data.frame>
+  "ptime_upr", # <as_latent_individual.data.frame>
   "woverlap", # <epidist_stancode.epidist_latent_individual>
-  "ptime", # <observe_process>
-  "ptime_daily", # <observe_process>
-  "stime", # <observe_process>
-  "stime_daily", # <observe_process>
-  "delay_daily", # <observe_process>
-  "ptime", # <filter_obs_by_obs_time>
-  "obs_at", # <filter_obs_by_obs_time>
-  "ptime_lwr", # <filter_obs_by_obs_time>
-  "stime_upr", # <filter_obs_by_obs_time>
-  "ptime_upr", # <filter_obs_by_ptime>
-  "stime_upr", # <filter_obs_by_ptime>
   ":=", # <filter_obs_by_ptime>
-  "ptime", # <filter_obs_by_ptime>
-  "ptime_lwr", # <filter_obs_by_ptime>
-  "mu", # <add_mean_sd.lognormal_samples>
-  "sigma", # <add_mean_sd.lognormal_samples>
-  "mu", # <add_mean_sd.gamma_samples>
-  "shape", # <add_mean_sd.gamma_samples>
   "rlnorm", # <simulate_secondary>
-  "ptime", # <simulate_secondary>
-  "delay", # <simulate_secondary>
-  "prior_old", # <.replace_prior>
   "prior_new", # <.replace_prior>
   "source_new", # <.replace_prior>
   NULL

R/latent_individual.R

@@ -46,19 +46,19 @@ as_latent_individual.data.frame <- function(data) {
   class(data) <- c("epidist_latent_individual", class(data))
   data <- data |>
     mutate(
-      obs_t = obs_at - ptime_lwr,
+      obs_t = .data$obs_at - .data$ptime_lwr,
       pwindow = ifelse(
-        stime_lwr < ptime_upr,
-        stime_upr - ptime_lwr,
-        ptime_upr - ptime_lwr
+        stime_lwr < .data$ptime_upr,
+        stime_upr - .data$ptime_lwr,
+        ptime_upr - .data$ptime_lwr
       ),
-      woverlap = as.numeric(stime_lwr < ptime_upr),
-      swindow = stime_upr - stime_lwr,
-      delay = stime_lwr - ptime_lwr,
+      woverlap = as.numeric(.data$stime_lwr < .data$ptime_upr),
+      swindow = .data$stime_upr - .data$stime_lwr,
+      delay = .data$stime_lwr - .data$ptime_lwr,
       row_id = dplyr::row_number()
     )
   if (nrow(data) > 1) {
-    data <- mutate(data, row_id = factor(row_id))
+    data <- mutate(data, row_id = factor(.data$row_id))
   }
   epidist_validate(data)
   return(data)

R/observe.R

@@ -21,16 +21,16 @@
 observe_process <- function(linelist) {
   linelist |>
     mutate(
-      ptime_daily = floor(ptime),
-      ptime_lwr = ptime_daily,
-      ptime_upr = ptime_daily + 1,
-      stime_daily = floor(stime),
-      stime_lwr = stime_daily,
-      stime_upr = stime_daily + 1,
-      delay_daily = stime_daily - ptime_daily,
-      delay_lwr = purrr::map_dbl(delay_daily, ~ max(0, . - 1)),
-      delay_upr = delay_daily + 1,
-      obs_at = ceiling(max(stime))
+      ptime_daily = floor(.data$ptime),
+      ptime_lwr = .data$ptime_daily,
+      ptime_upr = .data$ptime_daily + 1,
+      stime_daily = floor(.data$stime),
+      stime_lwr = .data$stime_daily,
+      stime_upr = .data$stime_daily + 1,
+      delay_daily = .data$stime_daily - .data$ptime_daily,
+      delay_lwr = purrr::map_dbl(.data$delay_daily, ~ max(0, . - 1)),
+      delay_upr = .data$delay_daily + 1,
+      obs_at = ceiling(max(.data$stime))
     )
 }
 
@@ -45,11 +45,11 @@ filter_obs_by_obs_time <- function(linelist, obs_time) {
   linelist |>
     mutate(
       obs_at = obs_time,
-      obs_time = obs_time - ptime,
-      censored_obs_time = obs_at - ptime_lwr,
+      obs_time = obs_time - .data$ptime,
+      censored_obs_time = .data$obs_at - .data$ptime_lwr,
       censored = "interval"
     ) |>
-    filter(stime_upr <= obs_at)
+    filter(.data$stime_upr <= .data$obs_at)
 }
 
 #' Filter observations based on the observation time of primary events
@@ -66,19 +66,19 @@ filter_obs_by_ptime <- function(linelist, obs_time,
   pfilt_t <- obs_time
   truncated_linelist <- linelist |>
     mutate(censored = "interval") |>
-    filter(ptime_upr <= pfilt_t)
+    filter(.data$ptime_upr <= pfilt_t)
   if (obs_at == "obs_secondary") {
     # Update observation time to be the same as the maximum secondary time
-    truncated_linelist <- mutate(truncated_linelist, obs_at = stime_upr)
+    truncated_linelist <- mutate(truncated_linelist, obs_at = .data$stime_upr)
   } else if (obs_at == "max_secondary") {
     truncated_linelist <- truncated_linelist |>
-      mutate(obs_at := stime_upr |> max() |> ceiling())
+      mutate(obs_at := .data$stime_upr |> max() |> ceiling())
   }
   # Make observation time as specified
   truncated_linelist <- truncated_linelist |>
     mutate(
-      obs_time = obs_at - ptime,
-      censored_obs_time = obs_at - ptime_lwr
+      obs_time = .data$obs_at - .data$ptime,
+      censored_obs_time = .data$obs_at - .data$ptime_lwr
     )
   # Set observation time to artificial observation time if needed
   if (obs_at == "obs_secondary") {

R/postprocess.R

@@ -73,8 +73,8 @@ add_mean_sd.default <- function(data, ...) {
 #' @export
 add_mean_sd.lognormal_samples <- function(data, ...) {
   mutate(data,
-    mean = exp(mu + sigma ^ 2 / 2),
-    sd = mean * sqrt(exp(sigma ^ 2) - 1)
+    mean = exp(.data$mu + .data$sigma ^ 2 / 2),
+    sd = .data$mean * sqrt(exp(.data$sigma ^ 2) - 1)
   )
 }
 
@@ -91,7 +91,7 @@ add_mean_sd.lognormal_samples <- function(data, ...) {
 #' @export
 add_mean_sd.gamma_samples <- function(data, ...) {
   mutate(data,
-    mean = mu,
-    sd = mu / sqrt(shape)
+    mean = .data$mu,
+    sd = .data$mu / sqrt(.data$shape)
   )
 }

R/simulate.R

@@ -132,6 +132,6 @@ simulate_secondary <- function(linelist, dist = rlnorm, ...) {
   linelist |>
     mutate(
       delay = dist(dplyr::n(), ...),
-      stime = ptime + delay
+      stime = .data$ptime + .data$delay
     )
 }

R/utils.R

@@ -66,7 +66,7 @@
   if (any(is.na(prior$prior_old))) {
     missing_prior <- utils::capture.output(print(
       prior |>
-        filter(is.na(prior_old)) |>
+        filter(is.na(.data$prior_old)) |>
         select(
           prior = prior_new, dplyr::all_of(cols), source = source_new
         )
@@ -79,7 +79,7 @@
   }
 
   prior <- prior |>
-    filter(!is.na(prior_old), !is.na(prior_new)) |>
+    filter(!is.na(.data$prior_old), !is.na(.data$prior_new)) |>
     select(prior = prior_new, dplyr::all_of(cols), source = source_new)
 
   return(prior)