Merge branch 'main' into 79-add-binary-endpoints-to-wrapper-anchored-…

…function
hta-pharma · Jul 18, 2024 · d398b9b · d398b9b
2 parents 0824ad0 + 88f7c55
commit d398b9b
Show file tree

Hide file tree

Showing 9 changed files with 4,915 additions and 8 deletions.
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -43,7 +43,8 @@ repos:
           .*\.rds|
           .*\.Rds|
           .*\.sh|
-          .*\.RData
+          .*\.RData|
+          .*\.svg
           )$
       - id: lintr
       - id: readme-rmd-rendered

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -32,7 +32,8 @@ Suggests:
     dplyr,
     survminer,
     flexsurv,
-    tibble
+    tibble,
+    vdiffr
 VignetteBuilder:
     knitr
 biocViews:

diff --git a/R/plot_km2.R b/R/plot_km2.R
@@ -106,7 +106,7 @@ kmplot2 <- function(weights_object,
       kmlist_1_2 <- list(
         setNames(
           all_km[c(4, 1, 3, 5)],
-          c(trt_ipd, trt_common, paste0(trt_ipd, " (weighted)"), paste0(trt_common, " (weighted)"))
+          c(trt_common, trt_ipd, paste0(trt_ipd, " (weighted)"), paste0(trt_common, " (weighted)"))
         ),
         setNames(all_km[c(6, 2)], c(trt_common, trt_agd))
       )
@@ -119,7 +119,7 @@ kmplot2 <- function(weights_object,
     if (km_layout %in% c("by_arm", "all")) {
       kmlist_3_4 <- list(
         setNames(all_km[c(2, 1, 3)], c(trt_agd, trt_ipd, paste0(trt_ipd, " (weighted)"))),
-        setNames(all_km[c(6, 4, 4)], paste(trt_common, c("(AgD)", "(IPD)", "(IPD,weighted)")))
+        setNames(all_km[c(6, 4, 5)], paste(trt_common, c("(AgD)", "(IPD)", "(IPD,weighted)")))
       )
       names(kmlist_3_4) <- c(
         paste0("Kaplan-Meier Curves \n(", trt_ipd, " vs ", trt_agd, ")"),

diff --git a/tests/testthat/_snaps/plot_km/kmplot2-all.svg b/tests/testthat/_snaps/plot_km/kmplot2-all.svg
diff --git a/tests/testthat/_snaps/plot_km/kmplot2-by-am.svg b/tests/testthat/_snaps/plot_km/kmplot2-by-am.svg
diff --git a/tests/testthat/_snaps/plot_km/kmplot2-by-trial.svg b/tests/testthat/_snaps/plot_km/kmplot2-by-trial.svg
diff --git a/tests/testthat/_snaps/plot_km/ph-diagplot-lch.svg b/tests/testthat/_snaps/plot_km/ph-diagplot-lch.svg
diff --git a/tests/testthat/_snaps/plot_km/ph-diagplot-schoenfeld.svg b/tests/testthat/_snaps/plot_km/ph-diagplot-schoenfeld.svg
diff --git a/tests/testthat/test-plot_km.R b/tests/testthat/test-plot_km.R
@@ -2,23 +2,132 @@ test_that("ph_diagplot_lch works without error", {
   original_par <- par()
   load(system.file("extdata", "combined_data_tte.rda", package = "maicplus", mustWork = TRUE))
   kmobj <- survfit(Surv(TIME, EVENT) ~ ARM, combined_data_tte, conf.type = "log-log")
-  ph_diagplot_lch(kmobj,
-    time_scale = "month", log_time = TRUE,
-    endpoint_name = "OS", subtitle = "(Before Matching)"
+  expect_no_error(
+    ph_diagplot_lch(
+      kmobj,
+      time_scale = "month", log_time = TRUE,
+      endpoint_name = "OS", subtitle = "(Before Matching)"
+    )
   )
 
   expect_equal(original_par, par())
+
+  skip_if_not_installed("vdiffr")
+  vdiffr::expect_doppelganger(
+    title = "ph_diagplot_lch",
+    fig = function() {
+      ph_diagplot_lch(
+        kmobj,
+        time_scale = "month", log_time = TRUE,
+        endpoint_name = "OS", subtitle = "(Before Matching)"
+      )
+    }
+  )
 })
 
 test_that("ph_diagplot_schoenfeld works without error", {
   original_par <- par()
   load(system.file("extdata", "combined_data_tte.rda", package = "maicplus", mustWork = TRUE))
   unweighted_cox <- coxph(Surv(TIME, EVENT == 1) ~ ARM, data = combined_data_tte)
   expect_no_error(
-    ph_diagplot_schoenfeld(unweighted_cox,
+    ph_diagplot_schoenfeld(
+      unweighted_cox,
       time_scale = "month", log_time = TRUE,
       endpoint_name = "OS", subtitle = "(Before Matching)"
     )
   )
   expect_equal(original_par, par())
+
+  skip_if_not_installed("vdiffr")
+  vdiffr::expect_doppelganger(
+    title = "ph_diagplot_schoenfeld",
+    fig = function() {
+      ph_diagplot_schoenfeld(
+        unweighted_cox,
+        time_scale = "month", log_time = TRUE,
+        endpoint_name = "OS", subtitle = "(Before Matching)"
+      )
+    }
+  )
+})
+
+test_that("kmplot2 works", {
+  skip_if_not_installed("vdiffr")
+
+  data(weighted_twt)
+  data(adtte_twt)
+  data(pseudo_ipd_twt)
+
+  # plot by trial
+  expect_warning(
+    vdiffr::expect_doppelganger(
+      title = "kmplot2_by_trial",
+      fig = function() {
+        kmplot2(
+          weights_object = weighted_twt,
+          tte_ipd = adtte_twt,
+          tte_pseudo_ipd = pseudo_ipd_twt,
+          trt_ipd = "A",
+          trt_agd = "B",
+          trt_common = "C",
+          trt_var_ipd = "ARM",
+          trt_var_agd = "ARM",
+          endpoint_name = "Overall Survival",
+          km_conf_type = "log-log",
+          km_layout = "by_trial",
+          time_scale = "month",
+          break_x_by = 2
+        )
+      }
+    ),
+    "select_"
+  )
+
+
+
+  # plot by arm
+  vdiffr::expect_doppelganger(
+    title = "kmplot2_by_am",
+    fig = function() {
+      kmplot2(
+        weights_object = weighted_twt,
+        tte_ipd = adtte_twt,
+        tte_pseudo_ipd = pseudo_ipd_twt,
+        trt_ipd = "A",
+        trt_agd = "B",
+        trt_common = "C",
+        trt_var_ipd = "ARM",
+        trt_var_agd = "ARM",
+        endpoint_name = "Overall Survival",
+        km_conf_type = "log-log",
+        km_layout = "by_arm",
+        time_scale = "month",
+        break_x_by = 2
+      )
+    }
+  )
+
+  # plot all
+  vdiffr::expect_doppelganger(
+    title = "kmplot2_all",
+    fig = function() {
+      kmplot2(
+        weights_object = weighted_twt,
+        tte_ipd = adtte_twt,
+        tte_pseudo_ipd = pseudo_ipd_twt,
+        trt_ipd = "A",
+        trt_agd = "B",
+        trt_common = "C",
+        trt_var_ipd = "ARM",
+        trt_var_agd = "ARM",
+        endpoint_name = "Overall Survival",
+        km_conf_type = "log-log",
+        km_layout = "all",
+        time_scale = "month",
+        break_x_by = 2,
+        xlim = c(0, 20),
+        show_risk_set = FALSE
+      )
+    }
+  )
 })