From 4c0629ec9dbc16c348803e78254c2c57ea75ca14 Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Wed, 31 Jul 2024 16:21:16 -0400 Subject: [PATCH 01/10] correct the denominator of the z-score of milestone tests --- R/milestone.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/milestone.R b/R/milestone.R index 21f145d1..9675b03c 100644 --- a/R/milestone.R +++ b/R/milestone.R @@ -84,10 +84,10 @@ milestone <- function(data, ms_time, test_type = c("log-log", "naive")) { } else { if (test_type == "naive") { z_numerator <- surv_diff - z_denominator <- surv_exp * sqrt(sigma2_exp) + surv_ctrl * sqrt(sigma2_ctrl) + z_denominator <- sqrt(surv_exp^2 * sigma2_exp + surv_ctrl^2 * sigma2_ctrl) } else if (test_type == "log-log") { z_numerator <- log(-log(surv_exp)) - log(-log(surv_ctrl)) - z_denominator <- sqrt(sigma2_exp) / log(surv_exp) + sqrt(sigma2_ctrl) / log(surv_ctrl) + z_denominator <- sqrt(sigma2_exp^2 / log(surv_exp)^2 + sigma2_ctrl / log(surv_ctrl)^2) } } From 2ad246f40e93ea2de3e19c3b34d9c2db8e99c737 Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Wed, 31 Jul 2024 16:29:03 -0400 Subject: [PATCH 02/10] comment 2 tests in `test-unvalidated-sim_gs_n` --- tests/testthat/test-unvalidated-sim_gs_n.R | 160 ++++++++++----------- 1 file changed, 80 insertions(+), 80 deletions(-) diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index b8b34735..c4f8cb4a 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -273,46 +273,46 @@ test_that("Milestone", { expect_equal(observed, expected) }) -test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and milestone test at FA", { - ia1_test <- create_test(wlr, weight = fh(rho = 0, gamma = 0.5)) - ia2_test <- create_test(wlr, weight = mb(delay = 6, w_max = Inf)) - fa_test <- create_test(milestone, ms_time = 10, test_type = "naive") - - set.seed(2024) - observed <- sim_gs_n( - n_sim = 3, - sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), - test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), - cut = test_cutting() - ) - expected <- data.frame( - sim_id = rep(1:3, each = 3L), - method = rep(c("WLR", "WLR", "milestone"), 3), - parameter = rep(c("FH(rho=0, gamma=0.5)", "MB(delay = 6, max_weight = Inf)", "10"), 3), - analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), - n = rep(400L, 9L), - event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), - estimate = c( - -11.5775033174745, -36.9093856541259, 0.055, - -8.44736378922731, -25.8424460996795, 0.0995332208091276, - -9.95948396485636, -32.6844032640339, 0.047591242749346 - ), - se = c( - 4.34496240294236, 12.4451486506265, 0.0705956555729631, - 4.16899365283586, 12.0591010341806, 0.070488618189222, - 3.99084589541075, 11.6181044782549, 0.0705189167423676 - ), - z = c( - -2.66458078201881, -2.96576494908061, 0.779084768795093, - -2.02623570402444, -2.14298279999738, 1.41204670152474, - -2.49558219632314, -2.81323027566226, 0.674872005241018 - ) - ) - expect_equal(observed, expected) -}) +# test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and milestone test at FA", { +# ia1_test <- create_test(wlr, weight = fh(rho = 0, gamma = 0.5)) +# ia2_test <- create_test(wlr, weight = mb(delay = 6, w_max = Inf)) +# fa_test <- create_test(milestone, ms_time = 10, test_type = "naive") +# +# set.seed(2024) +# observed <- sim_gs_n( +# n_sim = 3, +# sample_size = 400, +# enroll_rate = test_enroll_rate(), +# fail_rate = test_fail_rate(), +# test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), +# cut = test_cutting() +# ) +# expected <- data.frame( +# sim_id = rep(1:3, each = 3L), +# method = rep(c("WLR", "WLR", "milestone"), 3), +# parameter = rep(c("FH(rho=0, gamma=0.5)", "MB(delay = 6, max_weight = Inf)", "10"), 3), +# analysis = rep(1:3, 3), +# cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), +# n = rep(400L, 9L), +# event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), +# estimate = c( +# -11.5775033174745, -36.9093856541259, 0.055, +# -8.44736378922731, -25.8424460996795, 0.0995332208091276, +# -9.95948396485636, -32.6844032640339, 0.047591242749346 +# ), +# se = c( +# 4.34496240294236, 12.4451486506265, 0.0705956555729631, +# 4.16899365283586, 12.0591010341806, 0.070488618189222, +# 3.99084589541075, 11.6181044782549, 0.0705189167423676 +# ), +# z = c( +# -2.66458078201881, -2.96576494908061, 0.779084768795093, +# -2.02623570402444, -2.14298279999738, 1.41204670152474, +# -2.49558219632314, -2.81323027566226, 0.674872005241018 +# ) +# ) +# expect_equal(observed, expected) +# }) test_that("MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", { set.seed(2024) @@ -415,46 +415,46 @@ test_that("sim_gs_n() requires a test for each cutting", { ) }) -test_that("sim_gs_n() can combine wlr(), rmst(), and milestone() tests", { - test_cut1 <- create_test(wlr, weight = fh(rho = 0, gamma = 0)) - test_cut2 <- create_test(rmst, tau = 20) - test_cut3 <- create_test(milestone, ms_time = 10, test_type = "naive") - - set.seed(2024) - observed <- sim_gs_n( - n_sim = 3, - sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), - test = list(test_cut1, test_cut2, test_cut3), - cut = test_cutting() - ) - expected <- data.frame( - sim_id = rep(1:3, each = 3L), - method = rep(c("WLR", "RMST", "milestone"), 3), - parameter = rep(c("FH(rho=0, gamma=0)", "20", "10"), 3), - analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), - n = rep(400L, 9L), - event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), - estimate = c( - -14.8967761757316, 1.03579407229687, 0.055, - -13.3530329578349, 1.34542683554887, 0.0995332208091276, - -15.7016927028295, 1.33389386467127, 0.047591242749346 - ), - se = c( - 7.79986198971421, 0.738409622827227, 0.0705956555729631, - 7.65165409688827, 0.738351348672298, 0.070488618189222, - 7.44263362582829, 0.739072978624375, 0.0705189167423676 - ), - z = c( - -1.90987689210094, 1.40273642200249, 0.779084768795093, - -1.74511717188905, 1.82220407393879, 1.41204670152474, - -2.10969577332675, 1.80482023189919, 0.674872005241018 - ) - ) - expect_equal(observed, expected) -}) +# test_that("sim_gs_n() can combine wlr(), rmst(), and milestone() tests", { +# test_cut1 <- create_test(wlr, weight = fh(rho = 0, gamma = 0)) +# test_cut2 <- create_test(rmst, tau = 20) +# test_cut3 <- create_test(milestone, ms_time = 10, test_type = "naive") +# +# set.seed(2024) +# observed <- sim_gs_n( +# n_sim = 3, +# sample_size = 400, +# enroll_rate = test_enroll_rate(), +# fail_rate = test_fail_rate(), +# test = list(test_cut1, test_cut2, test_cut3), +# cut = test_cutting() +# ) +# expected <- data.frame( +# sim_id = rep(1:3, each = 3L), +# method = rep(c("WLR", "RMST", "milestone"), 3), +# parameter = rep(c("FH(rho=0, gamma=0)", "20", "10"), 3), +# analysis = rep(1:3, 3), +# cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), +# n = rep(400L, 9L), +# event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), +# estimate = c( +# -14.8967761757316, 1.03579407229687, 0.055, +# -13.3530329578349, 1.34542683554887, 0.0995332208091276, +# -15.7016927028295, 1.33389386467127, 0.047591242749346 +# ), +# se = c( +# 7.79986198971421, 0.738409622827227, 0.0705956555729631, +# 7.65165409688827, 0.738351348672298, 0.070488618189222, +# 7.44263362582829, 0.739072978624375, 0.0705189167423676 +# ), +# z = c( +# -1.90987689210094, 1.40273642200249, 0.779084768795093, +# -1.74511717188905, 1.82220407393879, 1.41204670152474, +# -2.10969577332675, 1.80482023189919, 0.674872005241018 +# ) +# ) +# expect_equal(observed, expected) +# }) test_that("convert_list_to_df_w_list_cols() is robust to diverse input", { x <- list( From ab16a8affcad04b317117fe9246cdeaf2929af5c Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Wed, 31 Jul 2024 16:32:25 -0400 Subject: [PATCH 03/10] comment 1 more test --- tests/testthat/test-unvalidated-sim_gs_n.R | 76 +++++++++++----------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index c4f8cb4a..14d48146 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -234,44 +234,44 @@ test_that("RMST", { expect_equal(observed, expected) }) -test_that("Milestone", { - set.seed(2024) - observed <- sim_gs_n( - n_sim = 3, - sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), - test = milestone, - cut = test_cutting(), - ms_time = 10, - test_type = "naive" - ) - expected <- data.frame( - sim_id = rep(1:3, each = 3L), - method = rep("milestone", 9L), - parameter = rep(10, 9L), - analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), - n = rep(400L, 9L), - event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), - estimate = c( - 0.0570882489260027, 0.055, 0.055, - 0.0982363112856928, 0.0995332208091276, 0.0995332208091276, - 0.0314033376239697, 0.047591242749346, 0.047591242749346 - ), - se = c( - 0.0711607062867438, 0.0705956555729631, 0.0705956555729631, - 0.0707139642597667, 0.070488618189222, 0.070488618189222, - 0.0725290309676113, 0.0705189167423676, 0.0705189167423676 - ), - z = c( - 0.802243989765422, 0.779084768795093, 0.779084768795093, - 1.38920667670141, 1.41204670152474, 1.41204670152474, - 0.432976109083731, 0.674872005241018, 0.674872005241018 - ) - ) - expect_equal(observed, expected) -}) +# test_that("Milestone", { +# set.seed(2024) +# observed <- sim_gs_n( +# n_sim = 3, +# sample_size = 400, +# enroll_rate = test_enroll_rate(), +# fail_rate = test_fail_rate(), +# test = milestone, +# cut = test_cutting(), +# ms_time = 10, +# test_type = "naive" +# ) +# expected <- data.frame( +# sim_id = rep(1:3, each = 3L), +# method = rep("milestone", 9L), +# parameter = rep(10, 9L), +# analysis = rep(1:3, 3), +# cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), +# n = rep(400L, 9L), +# event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), +# estimate = c( +# 0.0570882489260027, 0.055, 0.055, +# 0.0982363112856928, 0.0995332208091276, 0.0995332208091276, +# 0.0314033376239697, 0.047591242749346, 0.047591242749346 +# ), +# se = c( +# 0.0711607062867438, 0.0705956555729631, 0.0705956555729631, +# 0.0707139642597667, 0.070488618189222, 0.070488618189222, +# 0.0725290309676113, 0.0705189167423676, 0.0705189167423676 +# ), +# z = c( +# 0.802243989765422, 0.779084768795093, 0.779084768795093, +# 1.38920667670141, 1.41204670152474, 1.41204670152474, +# 0.432976109083731, 0.674872005241018, 0.674872005241018 +# ) +# ) +# expect_equal(observed, expected) +# }) # test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and milestone test at FA", { # ia1_test <- create_test(wlr, weight = fh(rho = 0, gamma = 0.5)) From 866b68ba4874237346b45ca2184901894ed4f309 Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Thu, 1 Aug 2024 11:01:30 -0400 Subject: [PATCH 04/10] change sign of z --- R/milestone.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/milestone.R b/R/milestone.R index 9675b03c..ac0b82be 100644 --- a/R/milestone.R +++ b/R/milestone.R @@ -86,7 +86,7 @@ milestone <- function(data, ms_time, test_type = c("log-log", "naive")) { z_numerator <- surv_diff z_denominator <- sqrt(surv_exp^2 * sigma2_exp + surv_ctrl^2 * sigma2_ctrl) } else if (test_type == "log-log") { - z_numerator <- log(-log(surv_exp)) - log(-log(surv_ctrl)) + z_numerator <- -(log(-log(surv_exp)) - log(-log(surv_ctrl))) z_denominator <- sqrt(sigma2_exp^2 / log(surv_exp)^2 + sigma2_ctrl / log(surv_ctrl)^2) } } From bbdfb96ae30f67de455133c2ae4f072c88afef4e Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Thu, 1 Aug 2024 11:20:00 -0400 Subject: [PATCH 05/10] uncomment test codes --- tests/testthat/test-unvalidated-sim_gs_n.R | 230 ++++++++++----------- 1 file changed, 112 insertions(+), 118 deletions(-) diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index 14d48146..65616541 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -234,85 +234,79 @@ test_that("RMST", { expect_equal(observed, expected) }) -# test_that("Milestone", { -# set.seed(2024) -# observed <- sim_gs_n( -# n_sim = 3, -# sample_size = 400, -# enroll_rate = test_enroll_rate(), -# fail_rate = test_fail_rate(), -# test = milestone, -# cut = test_cutting(), -# ms_time = 10, -# test_type = "naive" -# ) -# expected <- data.frame( -# sim_id = rep(1:3, each = 3L), -# method = rep("milestone", 9L), -# parameter = rep(10, 9L), -# analysis = rep(1:3, 3), -# cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), -# n = rep(400L, 9L), -# event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), -# estimate = c( -# 0.0570882489260027, 0.055, 0.055, -# 0.0982363112856928, 0.0995332208091276, 0.0995332208091276, -# 0.0314033376239697, 0.047591242749346, 0.047591242749346 -# ), -# se = c( -# 0.0711607062867438, 0.0705956555729631, 0.0705956555729631, -# 0.0707139642597667, 0.070488618189222, 0.070488618189222, -# 0.0725290309676113, 0.0705189167423676, 0.0705189167423676 -# ), -# z = c( -# 0.802243989765422, 0.779084768795093, 0.779084768795093, -# 1.38920667670141, 1.41204670152474, 1.41204670152474, -# 0.432976109083731, 0.674872005241018, 0.674872005241018 -# ) -# ) -# expect_equal(observed, expected) -# }) +test_that("Milestone", { + set.seed(2024) + observed <- sim_gs_n( + n_sim = 3, + sample_size = 400, + enroll_rate = test_enroll_rate(), + fail_rate = test_fail_rate(), + test = milestone, + cut = test_cutting(), + ms_time = 10, + test_type = "naive" + ) + expected <- data.frame( + sim_id = rep(1:3, each = 3L), + method = rep("milestone", 9L), + parameter = rep(10, 9L), + analysis = rep(1:3, 3), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), + n = rep(400L, 9L), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), + estimate = c( + 0.05708825, 0.05500000, 0.05500000, 0.09823631, 0.09953322, 0.09953322, 0.03140334, 0.04759124, 0.04759124 + ), + se = c( + 0.05031828, 0.04991868, 0.04991868, 0.05000253, 0.04984352, 0.04984352, 0.05128704, 0.04986524, 0.04986524 + ), + z = c( + 1.1345429, 1.1017919, 1.1017919, 1.9646268, 1.9969141, 1.9969141, 0.6123055, 0.9543971, 0.9543971 + ) + ) + expect_equal(observed, expected) +}) -# test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and milestone test at FA", { -# ia1_test <- create_test(wlr, weight = fh(rho = 0, gamma = 0.5)) -# ia2_test <- create_test(wlr, weight = mb(delay = 6, w_max = Inf)) -# fa_test <- create_test(milestone, ms_time = 10, test_type = "naive") -# -# set.seed(2024) -# observed <- sim_gs_n( -# n_sim = 3, -# sample_size = 400, -# enroll_rate = test_enroll_rate(), -# fail_rate = test_fail_rate(), -# test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), -# cut = test_cutting() -# ) -# expected <- data.frame( -# sim_id = rep(1:3, each = 3L), -# method = rep(c("WLR", "WLR", "milestone"), 3), -# parameter = rep(c("FH(rho=0, gamma=0.5)", "MB(delay = 6, max_weight = Inf)", "10"), 3), -# analysis = rep(1:3, 3), -# cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), -# n = rep(400L, 9L), -# event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), -# estimate = c( -# -11.5775033174745, -36.9093856541259, 0.055, -# -8.44736378922731, -25.8424460996795, 0.0995332208091276, -# -9.95948396485636, -32.6844032640339, 0.047591242749346 -# ), -# se = c( -# 4.34496240294236, 12.4451486506265, 0.0705956555729631, -# 4.16899365283586, 12.0591010341806, 0.070488618189222, -# 3.99084589541075, 11.6181044782549, 0.0705189167423676 -# ), -# z = c( -# -2.66458078201881, -2.96576494908061, 0.779084768795093, -# -2.02623570402444, -2.14298279999738, 1.41204670152474, -# -2.49558219632314, -2.81323027566226, 0.674872005241018 -# ) -# ) -# expect_equal(observed, expected) -# }) +test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and milestone test at FA", { + ia1_test <- create_test(wlr, weight = fh(rho = 0, gamma = 0.5)) + ia2_test <- create_test(wlr, weight = mb(delay = 6, w_max = Inf)) + fa_test <- create_test(milestone, ms_time = 10, test_type = "naive") + + set.seed(2024) + observed <- sim_gs_n( + n_sim = 3, + sample_size = 400, + enroll_rate = test_enroll_rate(), + fail_rate = test_fail_rate(), + test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), + cut = test_cutting() + ) + expected <- data.frame( + sim_id = rep(1:3, each = 3L), + method = rep(c("WLR", "WLR", "milestone"), 3), + parameter = rep(c("FH(rho=0, gamma=0.5)", "MB(delay = 6, max_weight = Inf)", "10"), 3), + analysis = rep(1:3, 3), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), + n = rep(400L, 9L), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), + estimate = c( + -11.5775033174745, -36.9093856541259, 0.05500000, + -8.44736378922731, -25.8424460996795, 0.09953322, + -9.95948396485636, -32.6844032640339, 0.04759124 + ), + se = c( + 4.34496240294236, 12.4451486506265, 0.04991868, + 4.16899365283586, 12.0591010341806, 0.04984352, + 3.99084589541075, 11.6181044782549, 0.04986524 + ), + z = c( + -2.66458078201881, -2.96576494908061, 1.1017919, + -2.02623570402444, -2.14298279999738, 1.9969141, + -2.49558219632314, -2.81323027566226, 0.9543971 + ) + ) + expect_equal(observed, expected) +}) test_that("MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", { set.seed(2024) @@ -415,46 +409,46 @@ test_that("sim_gs_n() requires a test for each cutting", { ) }) -# test_that("sim_gs_n() can combine wlr(), rmst(), and milestone() tests", { -# test_cut1 <- create_test(wlr, weight = fh(rho = 0, gamma = 0)) -# test_cut2 <- create_test(rmst, tau = 20) -# test_cut3 <- create_test(milestone, ms_time = 10, test_type = "naive") -# -# set.seed(2024) -# observed <- sim_gs_n( -# n_sim = 3, -# sample_size = 400, -# enroll_rate = test_enroll_rate(), -# fail_rate = test_fail_rate(), -# test = list(test_cut1, test_cut2, test_cut3), -# cut = test_cutting() -# ) -# expected <- data.frame( -# sim_id = rep(1:3, each = 3L), -# method = rep(c("WLR", "RMST", "milestone"), 3), -# parameter = rep(c("FH(rho=0, gamma=0)", "20", "10"), 3), -# analysis = rep(1:3, 3), -# cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), -# n = rep(400L, 9L), -# event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), -# estimate = c( -# -14.8967761757316, 1.03579407229687, 0.055, -# -13.3530329578349, 1.34542683554887, 0.0995332208091276, -# -15.7016927028295, 1.33389386467127, 0.047591242749346 -# ), -# se = c( -# 7.79986198971421, 0.738409622827227, 0.0705956555729631, -# 7.65165409688827, 0.738351348672298, 0.070488618189222, -# 7.44263362582829, 0.739072978624375, 0.0705189167423676 -# ), -# z = c( -# -1.90987689210094, 1.40273642200249, 0.779084768795093, -# -1.74511717188905, 1.82220407393879, 1.41204670152474, -# -2.10969577332675, 1.80482023189919, 0.674872005241018 -# ) -# ) -# expect_equal(observed, expected) -# }) +test_that("sim_gs_n() can combine wlr(), rmst(), and milestone() tests", { + test_cut1 <- create_test(wlr, weight = fh(rho = 0, gamma = 0)) + test_cut2 <- create_test(rmst, tau = 20) + test_cut3 <- create_test(milestone, ms_time = 10, test_type = "naive") + + set.seed(2024) + observed <- sim_gs_n( + n_sim = 3, + sample_size = 400, + enroll_rate = test_enroll_rate(), + fail_rate = test_fail_rate(), + test = list(test_cut1, test_cut2, test_cut3), + cut = test_cutting() + ) + expected <- data.frame( + sim_id = rep(1:3, each = 3L), + method = rep(c("WLR", "RMST", "milestone"), 3), + parameter = rep(c("FH(rho=0, gamma=0)", "20", "10"), 3), + analysis = rep(1:3, 3), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), + n = rep(400L, 9L), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), + estimate = c( + -14.8967761757316, 1.03579407229687, 0.05500000, + -13.3530329578349, 1.34542683554887, 0.09953322, + -15.7016927028295, 1.33389386467127, 0.04759124 + ), + se = c( + 7.79986198971421, 0.738409622827227, 0.04991868, + 7.65165409688827, 0.738351348672298, 0.04984352, + 7.44263362582829, 0.739072978624375, 0.04986524 + ), + z = c( + -1.90987689210094, 1.40273642200249, 1.1017919, + -1.74511717188905, 1.82220407393879, 1.9969141, + -2.10969577332675, 1.80482023189919, 0.9543971 + ) + ) + expect_equal(observed, expected) +}) test_that("convert_list_to_df_w_list_cols() is robust to diverse input", { x <- list( From 98ccfd78165725d5aa970c325f2707516b7d7295 Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Thu, 1 Aug 2024 11:33:52 -0400 Subject: [PATCH 06/10] print more digits to the expected object --- tests/testthat/test-unvalidated-sim_gs_n.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index 65616541..412b3b57 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -255,13 +255,19 @@ test_that("Milestone", { n = rep(400L, 9L), event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - 0.05708825, 0.05500000, 0.05500000, 0.09823631, 0.09953322, 0.09953322, 0.03140334, 0.04759124, 0.04759124 + 0.0570882489260, 0.0550000000000, 0.0550000000000, + 0.0982363112857, 0.0995332208091, 0.0995332208091, + 0.0314033376240, 0.0475912427493, 0.0475912427493 ), se = c( - 0.05031828, 0.04991868, 0.04991868, 0.05000253, 0.04984352, 0.04984352, 0.05128704, 0.04986524, 0.04986524 + 0.0503182801363, 0.0499186838769, 0.0499186838769, + 0.0500025291675, 0.0498435166464, 0.0498435166464, + 0.0512870375551, 0.0498652399931, 0.0498652399931 ), z = c( - 1.1345429, 1.1017919, 1.1017919, 1.9646268, 1.9969141, 1.9969141, 0.6123055, 0.9543971, 0.9543971 + 1.1345429289596, 1.1017918688652, 1.1017918688652, + 1.9646268483073, 1.9969140924625, 1.9969140924625, + 0.6123055477761, 0.9543971463075, 0.9543971463075 ) ) expect_equal(observed, expected) From e46c6bad132949fc8ee5c182debf92dd43c84c65 Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Thu, 1 Aug 2024 11:38:31 -0400 Subject: [PATCH 07/10] delete `helper-sim_gs_n.R` --- tests/testthat/helper-sim_gs_n.R | 74 ----------- tests/testthat/test-unvalidated-sim_gs_n.R | 143 +++++++++++++++------ 2 files changed, 106 insertions(+), 111 deletions(-) delete mode 100644 tests/testthat/helper-sim_gs_n.R diff --git a/tests/testthat/helper-sim_gs_n.R b/tests/testthat/helper-sim_gs_n.R deleted file mode 100644 index 9dddbfcf..00000000 --- a/tests/testthat/helper-sim_gs_n.R +++ /dev/null @@ -1,74 +0,0 @@ -# Helper functions used by test-unvalidated-sim_gs_n.R - -test_enroll_rate <- function() { - # parameters for enrollment - enroll_rampup_duration <- 4 # duration for enrollment ramp up - enroll_duration <- 16 # total enrollment duration - enroll_rate <- gsDesign2::define_enroll_rate( - duration = c( - enroll_rampup_duration, - enroll_duration - enroll_rampup_duration - ), - rate = c(10, 30) - ) - return(enroll_rate) -} - -test_fail_rate <- function() { - # parameters for treatment effect - delay_effect_duration <- 3 # delay treatment effect in months - median_ctrl <- 9 # survival median of the control arm - median_exp <- c(9, 14) # survival median of the experimental arm - dropout_rate <- 0.001 - fail_rate <- gsDesign2::define_fail_rate( - duration = c(delay_effect_duration, 100), - fail_rate = log(2) / median_ctrl, - hr = median_ctrl / median_exp, - dropout_rate = dropout_rate - ) - return(fail_rate) -} - -test_cutting <- function() { - # other related parameters - alpha <- 0.025 # type I error - beta <- 0.1 # type II error - ratio <- 1 # randomization ratio (exp:ctrl) - # Define cuttings of 2 IAs and 1 FA - # IA1 - # The 1st interim analysis will occur at the later of the following 3 conditions: - # - At least 20 months have passed since the start of the study - # - At least 100 events have occurred - # - At least 20 months have elapsed after enrolling 200/400 subjects, with a - # minimum of 20 months follow-up - # However, if events accumulation is slow, we will wait for a maximum of 24 months. - ia1_cut <- create_cut( - planned_calendar_time = 20, - target_event_overall = 100, - max_extension_for_target_event = 24, - min_n_overall = 200, - min_followup = 20 - ) - # IA2 - # The 2nd interim analysis will occur at the later of the following 3 conditions: - # - At least 32 months have passed since the start of the study - # - At least 250 events have occurred - # - At least 10 months after IA1 - # However, if events accumulation is slow, we will wait for a maximum of 34 months. - ia2_cut <- create_cut( - planned_calendar_time = 32, - target_event_overall = 200, - max_extension_for_target_event = 34, - min_time_after_previous_analysis = 10 - ) - # FA - # The final analysis will occur at the later of the following 2 conditions: - # - At least 45 months have passed since the start of the study - # - At least 300 events have occurred - fa_cut <- create_cut( - planned_calendar_time = 45, - target_event_overall = 350 - ) - - return(list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut)) -} diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index 412b3b57..5c59aa63 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -1,17 +1,86 @@ # 2024-02-22: Converted `example("sim_gs_n")` to tests from commit 306de0d # https://github.com/Merck/simtrial/tree/306de0dbe380fdb1e906a59f34bf3871d3ee5312 -# See helper-sim_gs_n.R for helper functions +# parameters for enrollment +enroll_rampup_duration <- 4 # duration for enrollment ramp up +enroll_duration <- 16 # total enrollment duration +enroll_rate <- gsDesign2::define_enroll_rate( + duration = c( + enroll_rampup_duration, + enroll_duration - enroll_rampup_duration + ), + rate = c(10, 30) +) + + +# parameters for treatment effect +delay_effect_duration <- 3 # delay treatment effect in months +median_ctrl <- 9 # survival median of the control arm +median_exp <- c(9, 14) # survival median of the experimental arm +dropout_rate <- 0.001 +fail_rate <- gsDesign2::define_fail_rate( + duration = c(delay_effect_duration, 100), + fail_rate = log(2) / median_ctrl, + hr = median_ctrl / median_exp, + dropout_rate = dropout_rate +) + + + +# other related parameters +alpha <- 0.025 # type I error +beta <- 0.1 # type II error +ratio <- 1 # randomization ratio (exp:ctrl) +# Define cuttings of 2 IAs and 1 FA +# IA1 +# The 1st interim analysis will occur at the later of the following 3 conditions: +# - At least 20 months have passed since the start of the study +# - At least 100 events have occurred +# - At least 20 months have elapsed after enrolling 200/400 subjects, with a +# minimum of 20 months follow-up +# However, if events accumulation is slow, we will wait for a maximum of 24 months. +ia1_cut <- create_cut( + planned_calendar_time = 20, + target_event_overall = 100, + max_extension_for_target_event = 24, + min_n_overall = 200, + min_followup = 20 +) + +# IA2 +# The 2nd interim analysis will occur at the later of the following 3 conditions: +# - At least 32 months have passed since the start of the study +# - At least 250 events have occurred +# - At least 10 months after IA1 +# However, if events accumulation is slow, we will wait for a maximum of 34 months. +ia2_cut <- create_cut( + planned_calendar_time = 32, + target_event_overall = 200, + max_extension_for_target_event = 34, + min_time_after_previous_analysis = 10 +) + +# FA +# The final analysis will occur at the later of the following 2 conditions: +# - At least 45 months have passed since the start of the study +# - At least 300 events have occurred +fa_cut <- create_cut( + planned_calendar_time = 45, + target_event_overall = 350 +) + +cut <- list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut) + test_that("regular logrank test", { set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = wlr, - cut = test_cutting(), + cut = cut, weight = fh(rho = 0, gamma = 0) ) expected <- data.frame( @@ -47,10 +116,10 @@ test_that("regular logrank test parallel", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = wlr, - cut = test_cutting(), + cut = cut, weight = fh(rho = 0, gamma = 0) ) plan("sequential") @@ -87,10 +156,10 @@ test_that("weighted logrank test by FH(0, 0.5)", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = wlr, - cut = test_cutting(), + cut = cut, weight = fh(rho = 0, gamma = 0.5) ) expected <- data.frame( @@ -125,10 +194,10 @@ test_that("weighted logrank test by MB(3)", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = wlr, - cut = test_cutting(), + cut = cut, weight = mb(delay = 3) ) expected <- data.frame( @@ -163,10 +232,10 @@ test_that("weighted logrank test by early zero (6)", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = wlr, - cut = test_cutting(), + cut = cut, weight = early_zero(6) ) expected <- data.frame( @@ -201,10 +270,10 @@ test_that("RMST", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = rmst, - cut = test_cutting(), + cut = cut, tau = 20 ) expected <- data.frame( @@ -239,10 +308,10 @@ test_that("Milestone", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = milestone, - cut = test_cutting(), + cut = cut, ms_time = 10, test_type = "naive" ) @@ -282,10 +351,10 @@ test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and mile observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), - cut = test_cutting() + cut = cut ) expected <- data.frame( sim_id = rep(1:3, each = 3L), @@ -319,10 +388,10 @@ test_that("MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = maxcombo, - cut = test_cutting(), + cut = cut, rho = c(0, 0), gamma = c(0, 0.5) ) @@ -363,10 +432,10 @@ test_that("sim_gs_n() accepts different tests per cutting", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = list(wlr_cut1, wlr_cut2, wlr_cut3), - cut = test_cutting() + cut = cut ) expected <- data.frame( sim_id = rep(1:3, each = 3L), @@ -406,10 +475,10 @@ test_that("sim_gs_n() requires a test for each cutting", { sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = list(wlr_cut1, wlr_cut2), - cut = test_cutting() + cut = cut ), "If you want to run different tests at each cutting" ) @@ -424,10 +493,10 @@ test_that("sim_gs_n() can combine wlr(), rmst(), and milestone() tests", { observed <- sim_gs_n( n_sim = 3, sample_size = 400, - enroll_rate = test_enroll_rate(), - fail_rate = test_fail_rate(), + enroll_rate = enroll_rate, + fail_rate = fail_rate, test = list(test_cut1, test_cut2, test_cut3), - cut = test_cutting() + cut = cut ) expected <- data.frame( sim_id = rep(1:3, each = 3L), From 3e6fd6fd4da1df7679abd9e2a96967b151821f36 Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Thu, 1 Aug 2024 16:52:22 -0400 Subject: [PATCH 08/10] remove the square of square --- R/milestone.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/milestone.R b/R/milestone.R index ac0b82be..b0bff1ea 100644 --- a/R/milestone.R +++ b/R/milestone.R @@ -87,7 +87,7 @@ milestone <- function(data, ms_time, test_type = c("log-log", "naive")) { z_denominator <- sqrt(surv_exp^2 * sigma2_exp + surv_ctrl^2 * sigma2_ctrl) } else if (test_type == "log-log") { z_numerator <- -(log(-log(surv_exp)) - log(-log(surv_ctrl))) - z_denominator <- sqrt(sigma2_exp^2 / log(surv_exp)^2 + sigma2_ctrl / log(surv_ctrl)^2) + z_denominator <- sqrt(sigma2_exp / log(surv_exp)^2 + sigma2_ctrl / log(surv_ctrl)^2) } } From a6c2d5fea606673268c9cb7bd2cf50c85ca9ddea Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Tue, 13 Aug 2024 15:00:00 -0400 Subject: [PATCH 09/10] update pkg version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2f2374c6..fb649c1e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: simtrial Type: Package Title: Clinical Trial Simulation -Version: 0.4.1.6 +Version: 0.4.1.8 Authors@R: c( person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")), person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role = c("ctb","cre")), From f251d248f326023e0ae7e61ed36841925c3f346d Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Fri, 16 Aug 2024 10:49:19 -0400 Subject: [PATCH 10/10] change the sign of z since the another pr is merged first --- tests/testthat/test-unvalidated-sim_gs_n.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index 03b73d43..a9763aad 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -375,9 +375,9 @@ test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and mile 3.99084589541075, 11.6181044782549, 0.04986524 ), z = c( - -2.66458078201881, -2.96576494908061, 1.1017919, - -2.02623570402444, -2.14298279999738, 1.9969141, - -2.49558219632314, -2.81323027566226, 0.9543971 + 2.66458078201881, 2.96576494908061, 1.1017919, + 2.02623570402444, 2.14298279999738, 1.9969141, + 2.49558219632314, 2.81323027566226, 0.9543971 ) ) expect_equal(observed, expected) @@ -517,9 +517,9 @@ test_that("sim_gs_n() can combine wlr(), rmst(), and milestone() tests", { 7.44263362582829, 0.739072978624375, 0.04986524 ), z = c( - -1.90987689210094, 1.40273642200249, 1.1017919, - -1.74511717188905, 1.82220407393879, 1.9969141, - -2.10969577332675, 1.80482023189919, 0.9543971 + 1.90987689210094, 1.40273642200249, 1.1017919, + 1.74511717188905, 1.82220407393879, 1.9969141, + 2.10969577332675, 1.80482023189919, 0.9543971 ) ) expect_equal(observed, expected)