Merge pull request #24 from seroanalytics/tidyup

Some tidying up

DESCRIPTION

@@ -34,3 +34,4 @@ Suggests:
 VignetteBuilder: knitr
 LinkingTo: 
     cpp11
+Config/testthat/edition: 3

R/biokinetics.R

@@ -156,7 +156,7 @@ biokinetics <- R6::R6Class(
       dt_out
     },
     prepare_stan_data = function() {
-      pid <- value <- censored <- titre_type <- obs_id <- t_since_last_exp <- NULL
+      pid <- value <- censored <- titre_type <- obs_id <- time_since_last_exp <- NULL
       stan_data <- list(
         N = private$data[, .N],
         N_events = private$data[, data.table::uniqueN(pid)],
@@ -173,7 +173,7 @@ biokinetics <- R6::R6Class(
         cens_lo_idx = private$data[censored == -2, obs_id],
         cens_hi_idx = private$data[censored == 1, obs_id])
 
-      stan_data$t <- private$data[, t_since_last_exp]
+      stan_data$t <- private$data[, time_since_last_exp]
       stan_data$X <- private$design_matrix
       stan_data$P <- ncol(private$design_matrix)
 
@@ -250,7 +250,7 @@ biokinetics <- R6::R6Class(
         private$data <- convert_log2_scale(private$data, "value")
       }
       private$data[, `:=`(obs_id = seq_len(.N),
-                          t_since_last_exp = as.integer(day - last_exp_day, units = "days"))]
+                          time_since_last_exp = as.integer(day - last_exp_day, units = "days"))]
       if (!("censored" %in% colnames(private$data))) {
         private$data$censored <- 0
       }
@@ -477,7 +477,7 @@ biokinetics <- R6::R6Class(
       # Calculating the maximum time each individual has data for after the
       # exposure of interest
       dt_max_dates <- private$data[
-        , .(t_max = max(t_since_last_exp)), by = "pid"]
+        , .(t_max = max(time_since_last_exp)), by = "pid"]
 
       # A very small number of individuals have bleeds on the same day or a few days
       # after their recorded exposure dates, resulting in very short trajectories.

tests/testthat/manual-test-multiplecovariates.R

@@ -1,9 +1,8 @@
 library(ggplot2)
 library(epikinetics)
 
-mod <- scova$new(file_path = system.file("delta_full.rds", package = "epikinetics"),
-                 priors = scova_priors(),
-                 covariate_formula = ~0 + infection_history:last_vax_type)
+mod <- biokinetics$new(file_path = system.file("delta_full.rds", package = "epikinetics"),
+                       covariate_formula = ~0 + infection_history:last_vax_type)
 
 mod$fit(chains = 4,
         parallel_chains = 4,
@@ -86,13 +85,14 @@ plot_data[, titre_type := forcats::fct_relevel(
   titre_type,
   c("Ancestral", "Alpha", "Delta"))]
 
-ggplot() + geom_line(
-  data = plot_data,
-  aes(x = calendar_date,
-      y = me,
-      group = interaction(titre_type, wave),
-      colour = titre_type),
-  alpha = 0.2) +
+ggplot() +
+  geom_line(
+    data = plot_data,
+    aes(x = calendar_date,
+        y = me,
+        group = interaction(titre_type, wave),
+        colour = titre_type),
+    alpha = 0.2) +
   geom_ribbon(
     data = plot_data,
     aes(x = calendar_date,

tests/testthat/manual-test-nocovariates.R

@@ -1,8 +1,7 @@
 library(ggplot2)
 library(epikinetics)
 
-mod <- scova$new(file_path = system.file("delta_full.rds", package = "epikinetics"),
-                 priors = scova_priors())
+mod <- biokinetics$new(file_path = system.file("delta_full.rds", package = "epikinetics"))
 
 mod$fit(chains = 4,
         parallel_chains = 4,
@@ -21,7 +20,7 @@ ggplot(data = dat) +
                 colour = titre_type)) +
   geom_ribbon(aes(x = t,
                   ymin = lo,
-                  ymax  = hi,
+                  ymax = hi,
                   fill = titre_type), alpha = 0.65) +
   coord_cartesian(clip = "off") +
   labs(x = "Time since last exposure (days)",
@@ -85,13 +84,14 @@ plot_data[, titre_type := forcats::fct_relevel(
   titre_type,
   c("Ancestral", "Alpha", "Delta"))]
 
-ggplot() + geom_line(
-  data = plot_data,
-  aes(x = calendar_date,
-      y = me,
-      group = interaction(titre_type, wave),
-      colour = titre_type),
-  alpha = 0.2) +
+ggplot() +
+  geom_line(
+    data = plot_data,
+    aes(x = calendar_date,
+        y = me,
+        group = interaction(titre_type, wave),
+        colour = titre_type),
+    alpha = 0.2) +
   geom_ribbon(
     data = plot_data,
     aes(x = calendar_date,

tests/testthat/test-data.R

@@ -26,7 +26,7 @@ test_that("Can construct stan data", {
   expect_equal(stan_data$N_events, 335)
   expect_equal(stan_data$mu_t0, priors$mu_t0)
   expect_equal(stan_data$sigma_t0, priors$sigma_t0)
-  expect_equivalent(stan_data$id, dat$pid)
+  expect_equal(stan_data$id, dat$pid, ignore_attr = TRUE)
 })
 
 test_that("All data is assumed uncensored if no censored column provided", {
@@ -45,19 +45,19 @@ test_that("Can handle non-numeric pids", {
   dat$pid <- paste0("ID-", dat$pid)
   mod <- biokinetics$new(data = dat)
   stan_data <- mod$get_stan_data()
-  expect_equivalent(stan_data$id, ids)
+  expect_equal(stan_data$id, ids, ignore_attr = TRUE)
 })
 
 test_that("Natural scale data is converted to log scale for stan", {
   dat <- data.table::fread(system.file("delta_full.rds", package = "epikinetics"))
   mod <- biokinetics$new(data = dat)
   stan_data <- mod$get_stan_data()
-  expect_equivalent(stan_data$value, convert_log2_scale(dat, "value")$value)
+  expect_equal(stan_data$value, convert_log2_scale(dat, "value")$value, ignore_attr = TRUE)
 })
 
 test_that("Log scale data is passed directly to stan", {
   dat <- data.table::fread(system.file("delta_full.rds", package = "epikinetics"))
   mod <- biokinetics$new(data = dat, scale = "log")
   stan_data <- mod$get_stan_data()
-  expect_equivalent(stan_data$value, dat$value)
+  expect_equal(stan_data$value, dat$value, ignore_attr = TRUE)
 })

tests/testthat/test-non-numeric-pids.R

@@ -9,19 +9,19 @@ test_that("Using numeric and non-numeric pids gives the same answer", {
   mod_new <- biokinetics$new(data = dat, covariate_formula = ~0 + infection_history)
   stan_data_new <- mod_new$get_stan_data()
 
-  expect_equivalent(stan_data, stan_data_new)
+  expect_equal(stan_data, stan_data_new, ignore_attr = TRUE)
 
   fit <- mod$fit(parallel_chains = 4,
-          iter_warmup = 50,
-          iter_sampling = 100,
+          iter_warmup = 10,
+          iter_sampling = 40,
           seed = 100)
 
   fit_new <- mod_new$fit(parallel_chains = 4,
-          iter_warmup = 50,
-          iter_sampling = 100,
+          iter_warmup = 10,
+          iter_sampling = 40,
           seed = 100)
 
-  expect_equivalent(fit$draws(), fit_new$draws())
+  expect_equal(fit$draws(), fit_new$draws(), ignore_attr = TRUE)
 
   set.seed(1)
   params <- mod$extract_individual_parameters(100)
@@ -30,7 +30,7 @@ test_that("Using numeric and non-numeric pids gives the same answer", {
   params_new <- mod_new$extract_individual_parameters(100)
 
   params$pid <- paste0("ID", params$pid)
-  expect_equivalent(params, params_new)
+  expect_equal(params, params_new, ignore_attr = TRUE)
 
   set.seed(1)
   trajectories <- mod$simulate_individual_trajectories(summarise = FALSE,
@@ -41,5 +41,5 @@ test_that("Using numeric and non-numeric pids gives the same answer", {
                                                                n_draws = 100)
   trajectories$pid <- paste0("ID", trajectories$pid)
   trajectories <- dplyr::arrange(trajectories, pid)
-  expect_equivalent(trajectories, trajectories_new)
+  expect_equal(trajectories, trajectories_new, ignore_attr = TRUE)
 })

tests/testthat/test-relative-dates.R

@@ -4,26 +4,27 @@ test_that("Using relative and absolute dates gives the same answer", {
   dat_absolute <- data.table::fread(system.file("delta_full.rds", package = "epikinetics"))
   mod_absolute <- biokinetics$new(data = dat_absolute, covariate_formula = ~0 + infection_history)
   delta_absolute <- mod_absolute$fit(parallel_chains = 4,
-                   iter_warmup = 50,
-                   iter_sampling = 100,
+                   iter_warmup = 10,
+                   iter_sampling = 75,
                    seed = 100)
 
   set.seed(1)
-  trajectories_absolute <- mod_absolute$simulate_individual_trajectories()
+  trajectories_absolute <- mod_absolute$simulate_individual_trajectories(summarise = FALSE)
 
   dat_relative <- data.table::fread(test_path("testdata", "delta_full_relative.rds"))
   mod_relative <- biokinetics$new(data = dat_relative, covariate_formula = ~0 + infection_history)
   delta_relative <- mod_relative$fit(parallel_chains = 4,
-                   iter_warmup = 50,
-                   iter_sampling = 100,
+                   iter_warmup = 10,
+                   iter_sampling = 75,
                    seed = 100)
 
   set.seed(1)
-  trajectories_relative <- mod_relative$simulate_individual_trajectories()
+  trajectories_relative <- mod_relative$simulate_individual_trajectories(summarise = FALSE)
 
   # convert relative days to absolute
   min_date <- min(dat_absolute$day)
   trajectories_relative$calendar_day <- min_date + trajectories_relative$calendar_day
+  trajectories_relative$exposure_day <- min_date + trajectories_relative$exposure_day
 
   expect_equal(trajectories_relative, trajectories_absolute)
 

tests/testthat/test-snapshots.R

@@ -14,8 +14,6 @@ delta <- mod$fit(parallel_chains = 4,
                  iter_sampling = 100,
                  seed = 100)
 
-local_edition(3)
-
 test_that("Model fits are the same", {
   skip_on_ci()
   expect_snapshot(delta)