diff --git a/DESCRIPTION b/DESCRIPTION index 30526c0..90156c1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,3 +34,4 @@ Suggests: VignetteBuilder: knitr LinkingTo: cpp11 +Config/testthat/edition: 3 diff --git a/R/biokinetics.R b/R/biokinetics.R index 82295db..6d4a558 100644 --- a/R/biokinetics.R +++ b/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. diff --git a/tests/testthat/manual-test-multiplecovariates.R b/tests/testthat/manual-test-multiplecovariates.R index 2246e40..dec1ca5 100644 --- a/tests/testthat/manual-test-multiplecovariates.R +++ b/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, diff --git a/tests/testthat/manual-test-nocovariates.R b/tests/testthat/manual-test-nocovariates.R index 81d0a20..af254f2 100644 --- a/tests/testthat/manual-test-nocovariates.R +++ b/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, diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index a9aa1a1..57ebbaf 100644 --- a/tests/testthat/test-data.R +++ b/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) }) diff --git a/tests/testthat/test-non-numeric-pids.R b/tests/testthat/test-non-numeric-pids.R index 63529d3..806cca2 100644 --- a/tests/testthat/test-non-numeric-pids.R +++ b/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) }) diff --git a/tests/testthat/test-relative-dates.R b/tests/testthat/test-relative-dates.R index 28316cb..ba58194 100644 --- a/tests/testthat/test-relative-dates.R +++ b/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) diff --git a/tests/testthat/test-snapshots.R b/tests/testthat/test-snapshots.R index b618f16..aa27d6a 100644 --- a/tests/testthat/test-snapshots.R +++ b/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) diff --git a/tests/testthat/testdata/testdraws.rds b/tests/testthat/testdata/testdraws.rds index 069b079..542230e 100644 Binary files a/tests/testthat/testdata/testdraws.rds and b/tests/testthat/testdata/testdraws.rds differ diff --git a/tests/testthat/testdata/testdraws_multiplecovariates.rds b/tests/testthat/testdata/testdraws_multiplecovariates.rds index e45e5f7..fa6daa4 100644 Binary files a/tests/testthat/testdata/testdraws_multiplecovariates.rds and b/tests/testthat/testdata/testdraws_multiplecovariates.rds differ diff --git a/tests/testthat/testdata/testdraws_nocovariates.rds b/tests/testthat/testdata/testdraws_nocovariates.rds index 0df59aa..53985a0 100644 Binary files a/tests/testthat/testdata/testdraws_nocovariates.rds and b/tests/testthat/testdata/testdraws_nocovariates.rds differ