From 7ee66a8205fd2dff6f0ba32eb23aa203403d88f7 Mon Sep 17 00:00:00 2001 From: Adam Howes Date: Fri, 20 Sep 2024 11:05:04 +0100 Subject: [PATCH] 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 | 5 +++-- R/globals.R | 27 +-------------------------- R/latent_individual.R | 16 ++++++++-------- R/observe.R | 36 ++++++++++++++++++------------------ R/postprocess.R | 8 ++++---- R/simulate.R | 2 +- R/utils.R | 4 ++-- 7 files changed, 37 insertions(+), 61 deletions(-) diff --git a/R/diagnostics.R b/R/diagnostics.R index 4a6bee9ef..fef867fdd 100644 --- a/R/diagnostics.R +++ b/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( diff --git a/R/globals.R b/R/globals.R index 6dfc6b4a0..14ba5ce70 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,38 +1,13 @@ # Generated by roxyglobals: do not edit by hand utils::globalVariables(c( - "max_treedepth", # - "no_at_max_treedepth", # "samples", # - "obs_at", # - "ptime_lwr", # "stime_lwr", # - "ptime_upr", # "stime_upr", # - "row_id", # + "ptime_upr", # "woverlap", # - "ptime", # - "ptime_daily", # - "stime", # - "stime_daily", # - "delay_daily", # - "ptime", # - "obs_at", # - "ptime_lwr", # - "stime_upr", # - "ptime_upr", # - "stime_upr", # ":=", # - "ptime", # - "ptime_lwr", # - "mu", # - "sigma", # - "mu", # - "shape", # "rlnorm", # - "ptime", # - "delay", # - "prior_old", # <.replace_prior> "prior_new", # <.replace_prior> "source_new", # <.replace_prior> NULL diff --git a/R/latent_individual.R b/R/latent_individual.R index 5f3095893..b28312db8 100644 --- a/R/latent_individual.R +++ b/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) diff --git a/R/observe.R b/R/observe.R index 7f88e7131..cdb5ef38d 100644 --- a/R/observe.R +++ b/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") { diff --git a/R/postprocess.R b/R/postprocess.R index 3742dbe6c..b4dadf3c4 100644 --- a/R/postprocess.R +++ b/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) ) } diff --git a/R/simulate.R b/R/simulate.R index e78c0be53..a125b5554 100644 --- a/R/simulate.R +++ b/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 ) } diff --git a/R/utils.R b/R/utils.R index 8b46dfc18..df1b08f87 100644 --- a/R/utils.R +++ b/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)