reformat tests

tests/testthat/test-nullify.R

@@ -1,47 +1,44 @@
-
-
 exper <- demo_joy() |>
     mediation_data("PHQ", "treatment", starts_with("ASV"))
 fit <- multimedia(exper) |>
     estimate(exper)
 
 test_that("Can nullify treatment to mediator path", {
-  nullified <- nullify(fit, "T->M")
-  edges <- nullified@edges |>
-      tidygraph::activate(edges) |>
-      as.data.frame()
-  expect_contains(edges$state, c("active", "inactive"))
-  expect_equal(as.integer(table(edges$state)), c(12, 5))
-
+    nullified <- nullify(fit, "T->M")
+    edges <- nullified@edges |>
+        tidygraph::activate(edges) |>
+        as.data.frame()
+    expect_contains(edges$state, c("active", "inactive"))
+    expect_equal(as.integer(table(edges$state)), c(12, 5))
 })
 
 test_that("Can nullify the mediator to outcome path.", {
-  nullified <- nullify(fit, "T->Y")
-  edges <- nullified@edges |>
-      tidygraph::activate(edges) |>
-      as.data.frame()
-  expect_contains(edges$state, c("active", "inactive"))
-  expect_equal(as.integer(table(edges$state)), c(16, 1))
+    nullified <- nullify(fit, "T->Y")
+    edges <- nullified@edges |>
+        tidygraph::activate(edges) |>
+        as.data.frame()
+    expect_contains(edges$state, c("active", "inactive"))
+    expect_equal(as.integer(table(edges$state)), c(16, 1))
 })
 
 
 test_that("Can contrast data simulated from real and synthetic.", {
-  contrast_data <- fit |>
-    null_contrast(exper)
-  expect_named(
-    contrast_data, 
-    c("source", "outcome", "indirect_setting", "contrast", "direct_effect")
-  )
-  expect_equal(unique(contrast_data$source), c("real", "synthetic"))
+    contrast_data <- fit |>
+        null_contrast(exper)
+    expect_named(
+        contrast_data,
+        c("source", "outcome", "indirect_setting", "contrast", "direct_effect")
+    )
+    expect_equal(unique(contrast_data$source), c("real", "synthetic"))
 })
 
 test_that("Can compute false discovery rates given contrast data.", {
-  fdr_data <- fit |>
-    null_contrast(exper) |>
-    fdr_summary("direct_effect")
-  expect_named(
-    fdr_data, 
-    c("source", "outcome", "direct_effect", "rank", "fdr_hat", "keep")
-  ) 
-  expect_equal(fdr_data$source, c("real", "synthetic"))
-})
+    fdr_data <- fit |>
+        null_contrast(exper) |>
+        fdr_summary("direct_effect")
+    expect_named(
+        fdr_data,
+        c("source", "outcome", "direct_effect", "rank", "fdr_hat", "keep")
+    )
+    expect_equal(sort(fdr_data$source), c("real", "synthetic"))
+})

tests/testthat/test-plot.R

@@ -1,4 +1,3 @@
-
 exper <- demo_joy() |>
     mediation_data("PHQ", "treatment", starts_with("ASV"))
 ie <- multimedia(exper) |>
@@ -7,39 +6,39 @@ ie <- multimedia(exper) |>
     effect_summary()
 
 test_that("Plot mediators returns on standard pathwise output.", {
-  g <- plot_mediators(ie, exper)
-  expect_s3_class(g, "patchwork")
+    g <- plot_mediators(ie, exper)
+    expect_s3_class(g, "patchwork")
 })
 
 test_that("Can customize number of digits in plot_mediators output.", {
-  g <- plot_mediators(ie, exper, n_digit = 1)
-  expect_s3_class(g, "patchwork")
-  g <- plot_mediators(ie, exper, n_digit = 3)
-  expect_s3_class(g, "patchwork")
+    g <- plot_mediators(ie, exper, n_digit = 1)
+    expect_s3_class(g, "patchwork")
+    g <- plot_mediators(ie, exper, n_digit = 3)
+    expect_s3_class(g, "patchwork")
 })
 
 test_that("We can plot the sensitivity data.", {
-  xy_data <- demo_spline()
-  exper <- mediation_data(
-    xy_data, 
-    starts_with("outcome"), 
-    "treatment", 
-    "mediator"
-  )
-  model <- multimedia(exper, outcome_estimator = glmnet_model(lambda = 1e-2)) |>
-    estimate(exper)
-  overall <- indirect_overall(model)
-
-  subset_indices <- expand.grid(
-    mediator = n_mediators(model), 
-    outcome = n_outcomes(model)
-  )
-  rho_seq <- c(-0.2, 0.2)
-  sensitivity_curve <- sensitivity(
-    model, exper, subset_indices, rho_seq, n_bootstrap = 2
-  )
-
-  g <- plot_sensitivity(sensitivity_curve)
-  expect_s3_class(g, "gg")
-})
+    xy_data <- demo_spline()
+    exper <- mediation_data(
+        xy_data,
+        starts_with("outcome"),
+        "treatment",
+        "mediator"
+    )
+    model <- multimedia(exper, outcome_estimator = glmnet_model(lambda = 1e-2)) |>
+        estimate(exper)
+    overall <- indirect_overall(model)
 
+    subset_indices <- expand.grid(
+        mediator = n_mediators(model),
+        outcome = n_outcomes(model)
+    )
+    rho_seq <- c(-0.2, 0.2)
+    sensitivity_curve <- sensitivity(
+        model, exper, subset_indices, rho_seq,
+        n_bootstrap = 2
+    )
+
+    g <- plot_sensitivity(sensitivity_curve)
+    expect_s3_class(g, "gg")
+})

tests/testthat/test-print.R

@@ -1,4 +1,3 @@
-
 test_that("ANSI handler converts R code to HTML tagged version", {
     output <- ansi_aware_handler("test")
     expect_equal(output, "<pre class=\"r-output\"><code>test</code></pre>")
@@ -25,4 +24,4 @@ test_that("Show methods give expected output for a fitted multimedia object.", {
     expect_output(print(model), "\\[Models\\]")
     expect_output(print(model), "mediation: A fitted")
     expect_output(print(model), "outcome: A fitted")
-})
+})

tests/testthat/test-sensitivity.R

@@ -28,3 +28,11 @@ test_that("Sensitivity at rho = 0 agrees with original indirect effect", {
         mutate(difference = abs(indirect_effect.x - 2 * indirect_effect.y))
     expect_true(all(indirect_diff$difference < 0.05))
 })
+
+test_that("Raises error on inappropriate model input.", {
+    model <- multimedia(exper, lnm_model())
+    expect_error(check_supported(model))
+
+    model <- multimedia(exper, brms_model())
+    expect_error(check_supported(model))
+})