Issue #432: Remove exported filtering functions

NAMESPACE

@@ -39,8 +39,6 @@ export(epidist_prior)
 export(epidist_stancode)
 export(epidist_validate_data)
 export(epidist_validate_model)
-export(filter_obs_by_obs_time)
-export(filter_obs_by_ptime)
 export(is_direct_model)
 export(is_epidist_linelist)
 export(is_latent_individual)

R/globals.R

@@ -3,7 +3,6 @@
 utils::globalVariables(c(
   "samples", # <epidist_diagnostics>
   "woverlap", # <epidist_stancode.epidist_latent_individual>
-  ":=", # <filter_obs_by_ptime>
   "rlnorm", # <simulate_secondary>
   "prior_new", # <.replace_prior>
   "source_new", # <.replace_prior>

R/observe.R

@@ -33,55 +33,3 @@ observe_process <- function(linelist) {
       obs_time = ceiling(max(.data$stime))
     )
 }
-
-#' Filter observations based on a observation time of secondary events
-#'
-#' @param linelist ...
-#' @param obs_time ...
-#' @family observe
-#' @autoglobal
-#' @export
-filter_obs_by_obs_time <- function(linelist, obs_time) {
-  linelist |>
-    mutate(
-      obs_time = obs_time,
-      relative_obs_time = .data$obs_time - .data$ptime,
-    ) |>
-    filter(.data$stime_upr <= .data$obs_time)
-}
-
-#' Filter observations based on the observation time of primary events
-#'
-#' @param linelist ...
-#' @param obs_time ...
-#' @param obs_time_type ...
-#' @family observe
-#' @autoglobal
-#' @export
-filter_obs_by_ptime <- function(linelist, obs_time,
-                                obs_time_type =
-                                  c("obs_secondary", "max_secondary")) {
-  obs_time <- match.arg(obs_time)
-  pfilt_t <- obs_time
-  truncated_linelist <- linelist |>
-    mutate(censored = "interval") |>
-    filter(.data$ptime_upr <= pfilt_t)
-  if (obs_time_type == "obs_secondary") {
-    # Update observation time to be the same as the maximum secondary time
-    truncated_linelist <- mutate(truncated_linelist, obs_time = .data$stime_upr)
-  } else if (obs_time_type == "max_secondary") {
-    truncated_linelist <- truncated_linelist |>
-      mutate(obs_time := .data$stime_upr |> max() |> ceiling())
-  }
-  # Make observation time as specified
-  truncated_linelist <- truncated_linelist |>
-    mutate(
-      obs_time = .data$obs_time - .data$ptime,
-      censored_obs_time = .data$obs_time - .data$ptime_lwr
-    )
-  # Set observation time to artificial observation time if needed
-  if (obs_time_type == "obs_secondary") {
-    truncated_linelist <- mutate(truncated_linelist, obs_time = pfilt_t)
-  }
-  return(truncated_linelist)
-}

inst/make_hexsticker.R

@@ -3,6 +3,15 @@ library(ggplot2)
 library(dplyr)
 library(magick)
 
+filter_obs_by_obs_time <- function(linelist, obs_time) {
+  linelist |>
+    mutate(
+      obs_time = obs_time,
+      relative_obs_time = .data$obs_time - .data$ptime,
+    ) |>
+    filter(.data$stime_upr <= .data$obs_time)
+}
+
 # make standard plot
 outbreak <- simulate_gillespie(seed = 101)
 

tests/testthat/setup.R

@@ -6,6 +6,15 @@ as_epidist_linelist_time <- function(data) {
   return(data)
 }
 
+filter_obs_by_obs_time <- function(linelist, obs_time) {
+  linelist |>
+    mutate(
+      obs_time = obs_time,
+      relative_obs_time = .data$obs_time - .data$ptime,
+    ) |>
+    filter(.data$stime_upr <= .data$obs_time)
+}
+
 obs_time <- 25
 sample_size <- 500
 

vignettes/approx-inference.Rmd

@@ -110,6 +110,15 @@ sdlog <- 0.5
 obs_time <- 25
 sample_size <- 200
 
+filter_obs_by_obs_time <- function(linelist, obs_time) {
+  linelist |>
+    mutate(
+      obs_time = obs_time,
+      relative_obs_time = .data$obs_time - .data$ptime,
+    ) |>
+    filter(.data$stime_upr <= .data$obs_time)
+}
+
 obs_cens_trunc_samp <- simulate_gillespie(seed = 101) |>
   simulate_secondary(
     meanlog = meanlog,

vignettes/epidist.Rmd

@@ -179,7 +179,16 @@ This is called (right) truncation, and biases the observation process towards sh
 
 ```{r}
 obs_time <- 25
-# filter_obs_by_obs_time() should be renamed to refer to stime
+
+filter_obs_by_obs_time <- function(linelist, obs_time) {
+  linelist |>
+    mutate(
+      obs_time = obs_time,
+      relative_obs_time = .data$obs_time - .data$ptime,
+    ) |>
+    filter(.data$stime_upr <= .data$obs_time)
+}
+
 obs_cens_trunc <- filter_obs_by_obs_time(obs_cens, obs_time = obs_time)
 ```
 

vignettes/faq.Rmd

@@ -38,6 +38,15 @@ sdlog <- 0.5
 obs_time <- 25
 sample_size <- 200
 
+filter_obs_by_obs_time <- function(linelist, obs_time) {
+  linelist |>
+    mutate(
+      obs_time = obs_time,
+      relative_obs_time = .data$obs_time - .data$ptime,
+    ) |>
+    filter(.data$stime_upr <= .data$obs_time)
+}
+
 obs_cens_trunc_samp <- simulate_gillespie(seed = 101) |>
   simulate_secondary(
     meanlog = meanlog,