starting to fix the unit tests after changes

Author: n8thangreen

R/prep_data.R

@@ -76,6 +76,12 @@ reshape_ald_to_wide <- function(df) {
 }
 
 ##TODO: check this
+#' Convert from wide to long format
+#'
+#' @import tidyr
+#' @import stringr
+#' 
+#' @examples
 reshape_ald_to_long <- function(df) {
 
   # Separate the 'colname' into 'stat', 'variable', and 'study' columns

tests/testthat/test-ALD_stats.R

@@ -11,9 +11,9 @@ ald <- list(
 
 strategy <- list(family = binomial(link = "logit"))
 
-## ALD_stats() ----
-test_that("ALD_stats() returns mean and variance", {
-  res <- ALD_stats(strategy, ald, scale = "log_odds")
+## calc_ALD_stats() ----
+test_that("calc_ALD_stats() returns mean and variance", {
+  res <- calc_ALD_stats(strategy, ald, scale = "log_odds")
   expect_type(res, "list")
   expect_named(res, c("mean", "var"))
   expect_type(res$mean, "double")
@@ -33,39 +33,39 @@ test_that("marginal_treatment_effect() calculates correct difference", {
   expect_type(res, "double")
 })
 
-## Edge Cases for ALD_stats() ----
-test_that("ALD_stats() handles NULL or empty ald", {
-  expect_error(ALD_stats(strategy, NULL))
-  expect_error(ALD_stats(strategy, list()))
+## Edge Cases for calc_ALD_stats() ----
+test_that("calc_ALD_stats() handles NULL or empty ald", {
+  expect_error(calc_ALD_stats(strategy, NULL))
+  expect_error(calc_ALD_stats(strategy, list()))
 })
 
-test_that("ALD_stats() handles missing treatment labels", {
+test_that("calc_ALD_stats() handles missing treatment labels", {
   ald_missing <- list(
     y.B.sum = 30,
     N.B = 100
     # C is missing
   )
-  expect_error(ALD_stats(strategy, ald_missing))
+  expect_error(calc_ALD_stats(strategy, ald_missing))
 })
 
-test_that("ALD_stats() handles incorrect data types", {
+test_that("calc_ALD_stats() handles incorrect data types", {
   ald_wrong <- list(
     y.B.sum = "thirty",
     N.B = 100,
     y.C.sum = 20,
     N.C = "one hundred"
   )
-  expect_error(ALD_stats(strategy, ald_wrong))
+  expect_error(calc_ALD_stats(strategy, ald_wrong))
 })
 
-test_that("ALD_stats() handles extreme values", {
+test_that("calc_ALD_stats() handles extreme values", {
   ald_extreme <- list(
     y.B.sum = 0,   # Zero events
     N.B = 100,
     y.C.sum = 100, # All events
     N.C = 100
   )
-  res <- ALD_stats(strategy, ald_extreme, scale = "log_odds")
+  res <- calc_ALD_stats(strategy, ald_extreme, scale = "log_odds")
   expect_type(res$mean, "double")
   expect_type(res$var, "double")
 })
@@ -81,7 +81,7 @@ test_that("marginal_variance() handles zero and full counts", {
     N.C = 100
   )
 
-  res <- ALD_stats(strategy, ald_extreme, scale = "log_odds") |> unlist()
+  res <- calc_ALD_stats(strategy, ald_extreme, scale = "log_odds") |> unlist()
 
   expect_true(all(is.finite(res)))
 })

tests/testthat/test-IPD_stats.R

@@ -46,52 +46,52 @@ ipd <- data.frame(
 )
 
 ## General Tests ----
-test_that("IPD_stats() works for MAIC", {
-  res <- IPD_stats(strategy_maic, ipd, ald, scale = "log_odds")
+test_that("calc_IPD_stats() works for MAIC", {
+  res <- calc_IPD_stats(strategy_maic, ipd, ald, scale = "log_odds")
   expect_type(res$mean, "double")
   expect_type(res$var, "double")
 })
 
-test_that("IPD_stats() works for STC", {
-  res <- IPD_stats(strategy_stc, ipd, ald, scale = "log_odds")
+test_that("calc_IPD_stats() works for STC", {
+  res <- calc_IPD_stats(strategy_stc, ipd, ald, scale = "log_odds")
   expect_type(res$mean, "double")
   expect_type(res$var, "double")
 })
 
-test_that("IPD_stats() works for G-computation (ML)", {
-  res <- IPD_stats(strategy_gcomp_ml, ipd, ald, scale = "log_odds")
+test_that("calc_IPD_stats() works for G-computation (ML)", {
+  res <- calc_IPD_stats(strategy_gcomp_ml, ipd, ald, scale = "log_odds")
   expect_type(res$mean, "double")
   expect_type(res$var, "double")
 })
 
-test_that("IPD_stats() works for G-computation (Stan)", {
-  res <- IPD_stats(strategy_gcomp_stan, ipd, ald, scale = "log_odds")
+test_that("calc_IPD_stats() works for G-computation (Stan)", {
+  res <- calc_IPD_stats(strategy_gcomp_stan, ipd, ald, scale = "log_odds")
   expect_type(res$mean, "double")
   expect_type(res$var, "double")
 })
 
-test_that("IPD_stats() works for Multiple Imputation Marginalisation", {
-  res <- IPD_stats(strategy_mim, ipd, ald, scale = "log_odds")
+test_that("calc_IPD_stats() works for Multiple Imputation Marginalisation", {
+  res <- calc_IPD_stats(strategy_mim, ipd, ald, scale = "log_odds")
   expect_type(res$mean, "double")
   expect_type(res$var, "double")
 })
 
 ## Edge Cases ----
-test_that("IPD_stats() handles NULL or empty inputs", {
-  expect_error(IPD_stats(strategy_maic, NULL, ald, scale = "log_odds"))
-  expect_error(IPD_stats(strategy_maic, ipd, NULL, scale = "log_odds"))
-  expect_error(IPD_stats(strategy_maic, list(), ald, scale = "log_odds"))
+test_that("calc_IPD_stats() handles NULL or empty inputs", {
+  expect_error(calc_IPD_stats(strategy_maic, NULL, ald, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_maic, ipd, NULL, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_maic, list(), ald, scale = "log_odds"))
 })
 
-test_that("IPD_stats() handles unexpected input types", {
+test_that("calc_IPD_stats() handles unexpected input types", {
   ipd_wrong <- list(y = "1", trt = "A")
   ald_wrong <- list(y.A.sum = "thirty", N.A = "one hundred")
 
-  expect_error(IPD_stats(strategy_maic, ipd_wrong, ald, scale = "log_odds"))
-  expect_error(IPD_stats(strategy_maic, ipd, ald_wrong, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_maic, ipd_wrong, ald, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_maic, ipd, ald_wrong, scale = "log_odds"))
 })
 
-test_that("IPD_stats() handles extreme values", {
+test_that("calc_IPD_stats() handles extreme values", {
   ipd_extreme <- data.frame(
     y = c(1, 1, 1, 1, 0, 0, 0, 0),
     trt = c("A", "A", "A", "A", "C", "C", "C", "C")
@@ -102,46 +102,46 @@ test_that("IPD_stats() handles extreme values", {
     y.C.sum = 100, # All events
     N.C = 100
   )
-  res <- IPD_stats(strategy_maic, ipd_extreme, ald_extreme, scale = "log_odds")
+  res <- calc_IPD_stats(strategy_maic, ipd_extreme, ald_extreme, scale = "log_odds")
   expect_type(res$mean, "double")
   expect_type(res$var, "double")
 })
 
-test_that("IPD_stats() handles unsupported strategies", {
+test_that("calc_IPD_stats() handles unsupported strategies", {
   strategy_invalid <- list(class = "unsupported")
-  expect_error(IPD_stats(strategy_invalid, ipd, ald, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_invalid, ipd, ald, scale = "log_odds"))
 })
 
-test_that("IPD_stats() handles missing columns", {
+test_that("calc_IPD_stats() handles missing columns", {
   ipd_missing <- data.frame(
     y = c(1, 0, 1, 0),
     # trt column missing
     z = c("A", "A", "C", "C")
   )
-  expect_error(IPD_stats(strategy_maic, ipd_missing, ald))
+  expect_error(calc_IPD_stats(strategy_maic, ipd_missing, ald))
 })
 
-test_that("IPD_stats() handles different link functions", {
+test_that("calc_IPD_stats() handles different link functions", {
   strategy_log <- list(class = "stc", formula = y ~ trt, family = binomial(link = "log"))
   strategy_identity <- list(class = "stc", formula = y ~ trt, family = binomial(link = "identity"))
 
-  res_log <- IPD_stats(strategy_log, ipd, ald, scale = "log_odds")
-  res_identity <- IPD_stats(strategy_identity, ipd, ald, scale = "log_odds")
+  res_log <- calc_IPD_stats(strategy_log, ipd, ald, scale = "log_odds")
+  res_identity <- calc_IPD_stats(strategy_identity, ipd, ald, scale = "log_odds")
 
   expect_type(res_log$mean, "double")
   expect_type(res_log$var, "double")
   expect_type(res_identity$mean, "double")
   expect_type(res_identity$var, "double")
 })
 
-test_that("IPD_stats() handles unsupported link functions", {
+test_that("calc_IPD_stats() handles unsupported link functions", {
   strategy_unknown <- list(class = "stc",
                            formula = y ~ trt,
                            family = list(link = "unknown"))
-  expect_error(IPD_stats(strategy_unknown, ipd, ald, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_unknown, ipd, ald, scale = "log_odds"))
 })
 
-test_that("IPD_stats() handles negative or NA values", {
+test_that("calc_IPD_stats() handles negative or NA values", {
   ipd_negative <- data.frame(
     y = c(-1, 0, 1, 0),
     trt = c("A", "A", "C", "C")
@@ -152,6 +152,6 @@ test_that("IPD_stats() handles negative or NA values", {
     y.C.sum = 20,
     N.C = 100
   )
-  expect_error(IPD_stats(strategy_maic, ipd_negative, ald, scale = "log_odds"))
-  expect_error(IPD_stats(strategy_maic, ipd, ald_na, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_maic, ipd_negative, ald, scale = "log_odds"))
+  expect_error(calc_IPD_stats(strategy_maic, ipd, ald_na, scale = "log_odds"))
 })

tests/testthat/test-gcomp.R

@@ -76,7 +76,8 @@ test_that("compare with stdReg2 package for continuous outcome", {
     select(qsmk, sex, age, wt82_71) |> 
     rename(trt = qsmk,
            y = wt82_71) |> 
-    mutate(sex = as.numeric(sex) - 1)
+    mutate(sex = as.numeric(sex) - 1,
+           trt = factor(trt, labels = c("C", "A")))
 
   lin_form <- as.formula(y ~ trt * (sex + age))
 
@@ -146,8 +147,9 @@ test_that("compare with stdReg2 package for binary outcome", {
   data <- data.frame(
     age = rnorm(n, mean = 50, sd = 10),
     sex = rbinom(n, 1, 0.5),
-    trt = rbinom(n, 1, 0.5)
-  )
+    trt = rbinom(n, 1, 0.5))
+  
+  data$trt <- factor(data$trt, labels = c("C", "A"))
 
   # generate a binary outcome with logit link
   logit_p <- -1 + data$trt * (0.03 * data$age + 0.2 * data$sex)
@@ -236,9 +238,10 @@ test_that("compare with marginaleffects package for binary outcome", {
   data <- data.frame(
     age = rnorm(n, mean = 50, sd = 10),
     sex = rbinom(n, 1, 0.5),
-    trt = rbinom(n, 1, 0.5)
-  )
+    trt = rbinom(n, 1, 0.5))
 
+  data$trt <- factor(data$trt, labels = c("C", "A"))
+
   # generate a binary outcome with logit link
   logit_p <- -1 + data$trt * (0.03 * data$age + 0.2 * data$sex)
   prob <- 1 / (1 + exp(-logit_p))
@@ -311,7 +314,8 @@ test_that("compare with marginaleffects package for continuous outcome", {
     select(qsmk, sex, age, wt82_71) |> 
     rename(trt = qsmk,
            y = wt82_71) |> 
-    mutate(sex = as.numeric(sex) - 1)
+    mutate(sex = as.numeric(sex) - 1,
+           trt = factor(trt, labels = c("C", "A")))
 
   lin_form <- as.formula(y ~ trt * (sex + age))