tests/testthat/test-fps_weighting.R

In FPScausal: Functional Propensity Score for Causal Inference

dat_small <- simulate_fps_data(n = 80, setting = "LL",
                               include_functional_cov = TRUE, seed = 10)

test_that("fps_weighting runs with scalar covariates only", {
  w <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                      covariates = dat_small$C)
  expect_s3_class(w, "fps_weighting")
  expect_length(w$weights, 80)
  expect_true(all(w$weights > 0))
  expect_equal(sum(w$weights), 1, tolerance = 1e-6)
})

test_that("fps_weighting runs with scalar + functional covariates", {
  w <- fps_weighting(
    dat_small$X, dat_small$t_grid, c(0, 1),
    covariates  = list(scalar = dat_small$C, functional = list(dat_small$D)),
    cov_grids   = list(dat_small$t_grid),
    cov_domains = list(c(0, 1))
  )
  expect_s3_class(w, "fps_weighting")
  expect_length(w$fpca_covariates, 1)
  expect_length(w$weights, 80)
})

test_that("fps_weighting stores expected fpca_treatment fields", {
  w <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                      covariates = dat_small$C)
  ft <- w$fpca_treatment
  expect_true(!is.null(ft$scr))
  expect_true(!is.null(ft$efn))
  expect_true(!is.null(ft$mean))
  expect_equal(length(ft$mean), 51)
  expect_equal(nrow(ft$scr), 80)
})

test_that("print.fps_weighting runs without error", {
  w <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                      covariates = dat_small$C)
  expect_output(print(w), "Functional Propensity Score Weighting")
})

test_that("summary.fps_weighting runs without error", {
  w <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                      covariates = dat_small$C)
  expect_output(summary(w), "Covariate balance")
})

test_that("plot.fps_weighting type = 'balance' returns ggplot", {
  w <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                      covariates = dat_small$C)
  p <- plot(w, type = "balance")
  expect_s3_class(p, "gg")
})

test_that("plot.fps_weighting type = 'fpca_treatment' returns patchwork", {
  w <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                      covariates = dat_small$C)
  p <- plot(w, type = "fpca_treatment")
  expect_true(inherits(p, "patchwork") || inherits(p, "gg"))
})

test_that("plot.fps_weighting type = 'weights' returns ggplot", {
  w <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                      covariates = dat_small$C)
  p <- plot(w, type = "weights")
  expect_s3_class(p, "gg")
})

test_that("fps_weighting accepts pve argument", {
  w95 <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                        covariates = dat_small$C, pve = 0.95)
  w99 <- fps_weighting(dat_small$X, dat_small$t_grid, c(0, 1),
                        covariates = dat_small$C, pve = 0.99)
  expect_true(w99$fpca_treatment$L >= w95$fpca_treatment$L)
})