From 43efc43ad417bdaa5f346562251af97ac30ab95e Mon Sep 17 00:00:00 2001 From: Wenjuan Zhang <37557214+User-zwj@users.noreply.github.com> Date: Tue, 23 Apr 2024 15:12:12 +0800 Subject: [PATCH 1/5] Independent test for wlr.R is added --- tests/testthat/test-independent_test_wlr.R | 245 +++++++++++++++++++++ 1 file changed, 245 insertions(+) create mode 100644 tests/testthat/test-independent_test_wlr.R diff --git a/tests/testthat/test-independent_test_wlr.R b/tests/testthat/test-independent_test_wlr.R new file mode 100644 index 00000000..6ddd448d --- /dev/null +++ b/tests/testthat/test-independent_test_wlr.R @@ -0,0 +1,245 @@ +#### unstratified, FH (Fleming-Harrington) ---- +# Check value when Fleming-Harrington weight is used +test_that("wlr() with FH weight on unstratified data", { + # Example 1: Unstratified + set.seed(123456) + base <- sim_pw_surv(n = 200) |> + cut_data_by_event(125) #|> + output <- base |> + wlr(weight = fh(rho = c(0, 0, 1, 1), gamma = c(0, 1, 0, 1))) + + observed <- output$z + base <- base |> counting_process(arm = "experimental") + expected <- c() + for (i in 1:length(observed)) { + base <- base |> mutate(weight=s^(output$rho[i])*(1-s)^(output$gamma[i])) + z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) + expected <- c(expected,z) + } + expect_equal(observed, expected) +}) + + +#### stratified, FH (Fleming-Harrington) ---- +# Check value when Fleming-Harrington weight is used +test_that("wlr() with FH weight on stratified data", { + # Example 1: Stratified + set.seed(123456) + n <- 500 + # Two strata + stratum <- c("Biomarker-positive", "Biomarker-negative") + prevalence_ratio <- c(0.6, 0.4) + enroll_rate <- gsDesign2::define_enroll_rate( + stratum = rep(stratum, each = 2), + duration = c(2, 10, 2, 10), + rate = c(c(1, 4) * prevalence_ratio[1], c(1, 4) * prevalence_ratio[2]) + ) + enroll_rate$rate <- enroll_rate$rate * n / sum(enroll_rate$duration * enroll_rate$rate) #?? + # Failure rate + med_pos <- 10 # Median of the biomarker positive population + med_neg <- 8 # Median of the biomarker negative population + hr_pos <- c(1, 0.7) # Hazard ratio of the biomarker positive population + hr_neg <- c(1, 0.8) # Hazard ratio of the biomarker negative population + fail_rate <- gsDesign2::define_fail_rate( + stratum = rep(stratum, each = 2), + duration = c(3, 1000, 4, 1000), + fail_rate = c(log(2) / c(med_pos, med_pos, med_neg, med_neg)), + hr = c(hr_pos, hr_neg), + dropout_rate = 0.01 + ) + temp <- to_sim_pw_surv(fail_rate) # Convert the failure rate + set.seed(123456) + base <- sim_pw_surv( + n = n, # Sample size + # Stratified design with prevalence ratio of 6:4 + stratum = tibble(stratum = stratum, p = prevalence_ratio), + # Randomization ratio + block = c("control", "control", "experimental", "experimental"), + enroll_rate = enroll_rate, # Enrollment rate + fail_rate = temp$fail_rate, # Failure rate + dropout_rate = temp$dropout_rate # Dropout rate + ) |> + cut_data_by_event(125) + + output <- base |> + wlr(weight = fh(rho = c(0, 0, 1, 1), gamma = c(0, 1, 0, 1))) + + observed <- output$z + base <- base |> counting_process(arm = "experimental") + expected <- c() + for (i in 1:length(observed)) { + base <- base |> mutate(weight=s^(output$rho[i])*(1-s)^(output$gamma[i])) + z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) + expected <- c(expected,z) + } + expect_equal(observed, expected) +}) + + +#### unstratified, MB (Magirr and Burman) ---- +# Check value when Magirr and Burman weight is used +test_that("wlr() with MB weight on unstratified data", { + # Example 1: Unstratified + set.seed(123456) + delay <- 4 + w_max <- 2 + base <- sim_pw_surv(n = 200) |> + cut_data_by_event(125) + output <- base |> + wlr(weight = mb(delay = delay, w_max = w_max)) + + observed <- output$z + base <- base |> counting_process(arm = "experimental") + base2 <- base |> filter(tte<=delay) + expected <- c() + for (i in 1:length(observed)) { + wht <- base2 |> group_by(stratum) %>% summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max)) + base <- base |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) + z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) + expected <- c(expected,z) + } + expect_equal(observed, expected) +}) + + +#### stratified, MB (Magirr and Burman) ---- +# Check value when Magirr and Burman weight is used +test_that("wlr() with MB weight on stratified data", { + # Example 2: Stratified + set.seed(123456) + delay <- 4 + w_max <- 2 + n <- 500 + # Two strata + stratum <- c("Biomarker-positive", "Biomarker-negative") + prevalence_ratio <- c(0.6, 0.4) + enroll_rate <- gsDesign2::define_enroll_rate( + stratum = rep(stratum, each = 2), + duration = c(2, 10, 2, 10), + rate = c(c(1, 4) * prevalence_ratio[1], c(1, 4) * prevalence_ratio[2]) + ) + enroll_rate$rate <- enroll_rate$rate * n / sum(enroll_rate$duration * enroll_rate$rate) #?? + # Failure rate + med_pos <- 10 # Median of the biomarker positive population + med_neg <- 8 # Median of the biomarker negative population + hr_pos <- c(1, 0.7) # Hazard ratio of the biomarker positive population + hr_neg <- c(1, 0.8) # Hazard ratio of the biomarker negative population + fail_rate <- gsDesign2::define_fail_rate( + stratum = rep(stratum, each = 2), + duration = c(3, 1000, 4, 1000), + fail_rate = c(log(2) / c(med_pos, med_pos, med_neg, med_neg)), + hr = c(hr_pos, hr_neg), + dropout_rate = 0.01 + ) + temp <- to_sim_pw_surv(fail_rate) # Convert the failure rate + set.seed(123456) + base <- sim_pw_surv( + n = n, # Sample size + # Stratified design with prevalence ratio of 6:4 + stratum = tibble(stratum = stratum, p = prevalence_ratio), + # Randomization ratio + block = c("control", "control", "experimental", "experimental"), + enroll_rate = enroll_rate, # Enrollment rate + fail_rate = temp$fail_rate, # Failure rate + dropout_rate = temp$dropout_rate # Dropout rate + ) |> + cut_data_by_event(125) + + output <- base |> + wlr(weight = mb(delay = delay, w_max = w_max)) + + observed <- output$z + base <- base |> counting_process(arm = "experimental") + base2 <- base |> filter(tte<=delay) + expected <- c() + for (i in 1:length(observed)) { + wht <- base2 |> group_by(stratum) %>% summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max)) + base <- base |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) + z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) + expected <- c(expected,z) + } + expect_equal(observed, expected) +}) + + +#### unstratified, early_zero_weight ---- +# Check value when early_zero_weight is used +test_that("wlr() with early_zero_weight on unstratified data", { + # Example 1: Unstratified + set.seed(123456) + early_period = 4 + base <- sim_pw_surv(n = 200) |> + cut_data_by_event(125) + output <- base |> + wlr(weight = early_zero(early_period = early_period)) + + observed <- output$z + # WLR using early_zero_weight yields the same results as directly removing the events happening earlier than `early_period` + base <- base |> counting_process(arm = "experimental") %>% filter(tte>=early_period) + expected <- c() + for (i in 1:length(observed)) { + # base <- base |> mutate(weight=if_else(tte + cut_data_by_event(125) + + output <- base |> + wlr(weight = early_zero(early_period = early_period)) + + observed <- output$z + # WLR using early_zero_weight yields the same results as directly removing the events happening earlier than `early_period` + base <- base |> counting_process(arm = "experimental") %>% filter(tte>=early_period) + expected <- c() + for (i in 1:length(observed)) { + # base <- base |> mutate(weight=if_else(tte Date: Wed, 24 Apr 2024 21:59:25 -0400 Subject: [PATCH 2/5] add a testing line of codes for demo --- tests/testthat/test-independent_test_wlr.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-independent_test_wlr.R b/tests/testthat/test-independent_test_wlr.R index 6ddd448d..7a55c2a7 100644 --- a/tests/testthat/test-independent_test_wlr.R +++ b/tests/testthat/test-independent_test_wlr.R @@ -99,6 +99,7 @@ test_that("wlr() with MB weight on unstratified data", { expected <- c(expected,z) } expect_equal(observed, expected) + expect_equal(1+1, 2) }) From af0c2580e1c9e04b3199e083dff1bd710427ef91 Mon Sep 17 00:00:00 2001 From: "Zhao, Yujie" Date: Wed, 24 Apr 2024 22:07:19 -0400 Subject: [PATCH 3/5] uncommit --- tests/testthat/test-independent_test_wlr.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-independent_test_wlr.R b/tests/testthat/test-independent_test_wlr.R index 7a55c2a7..6ddd448d 100644 --- a/tests/testthat/test-independent_test_wlr.R +++ b/tests/testthat/test-independent_test_wlr.R @@ -99,7 +99,6 @@ test_that("wlr() with MB weight on unstratified data", { expected <- c(expected,z) } expect_equal(observed, expected) - expect_equal(1+1, 2) }) From 083aaabe3c4f906c4dfa931d9463df6d9aeaa555 Mon Sep 17 00:00:00 2001 From: Wenjuan Zhang Date: Fri, 26 Apr 2024 00:16:08 -0400 Subject: [PATCH 4/5] Add library and update the code in wlr testing --- tests/testthat/test-independent_test_wlr.R | 159 ++++++++++++--------- 1 file changed, 88 insertions(+), 71 deletions(-) diff --git a/tests/testthat/test-independent_test_wlr.R b/tests/testthat/test-independent_test_wlr.R index 6ddd448d..ad4218ea 100644 --- a/tests/testthat/test-independent_test_wlr.R +++ b/tests/testthat/test-independent_test_wlr.R @@ -1,21 +1,32 @@ +library(dplyr) +library(gsDesign2) +library(tibble) + + #### unstratified, FH (Fleming-Harrington) ---- # Check value when Fleming-Harrington weight is used test_that("wlr() with FH weight on unstratified data", { # Example 1: Unstratified set.seed(123456) base <- sim_pw_surv(n = 200) |> - cut_data_by_event(125) #|> - output <- base |> - wlr(weight = fh(rho = c(0, 0, 1, 1), gamma = c(0, 1, 0, 1))) + cut_data_by_event(125) + basec <- base |> + counting_process(arm = "experimental") - observed <- output$z - base <- base |> counting_process(arm = "experimental") + rho <- c(0, 0, 1, 1) + gamma <- c(0, 1, 0, 1) + observed <- c() expected <- c() - for (i in 1:length(observed)) { - base <- base |> mutate(weight=s^(output$rho[i])*(1-s)^(output$gamma[i])) - z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) - expected <- c(expected,z) + for (i in 1:length(rho)) { + output <- base |> + wlr(weight = fh(rho = rho[i], gamma = gamma[i])) + observed[i] <- output$z + + basec <- basec |> mutate(weight=s^(rho[i])*(1-s)^(gamma[i])) + z <- sum(basec$o_minus_e*basec$weight)/sqrt(sum(basec$weight^2*basec$var_o_minus_e)) + expected[i] <- z } + expect_equal(observed, expected) }) @@ -34,7 +45,7 @@ test_that("wlr() with FH weight on stratified data", { duration = c(2, 10, 2, 10), rate = c(c(1, 4) * prevalence_ratio[1], c(1, 4) * prevalence_ratio[2]) ) - enroll_rate$rate <- enroll_rate$rate * n / sum(enroll_rate$duration * enroll_rate$rate) #?? + enroll_rate$rate <- enroll_rate$rate * n / sum(enroll_rate$duration * enroll_rate$rate) # Failure rate med_pos <- 10 # Median of the biomarker positive population med_neg <- 8 # Median of the biomarker negative population @@ -48,7 +59,6 @@ test_that("wlr() with FH weight on stratified data", { dropout_rate = 0.01 ) temp <- to_sim_pw_surv(fail_rate) # Convert the failure rate - set.seed(123456) base <- sim_pw_surv( n = n, # Sample size # Stratified design with prevalence ratio of 6:4 @@ -60,18 +70,23 @@ test_that("wlr() with FH weight on stratified data", { dropout_rate = temp$dropout_rate # Dropout rate ) |> cut_data_by_event(125) + basec <- base |> + counting_process(arm = "experimental") - output <- base |> - wlr(weight = fh(rho = c(0, 0, 1, 1), gamma = c(0, 1, 0, 1))) - - observed <- output$z - base <- base |> counting_process(arm = "experimental") + rho <- c(0, 0, 1, 1) + gamma <- c(0, 1, 0, 1) + observed <- c() expected <- c() - for (i in 1:length(observed)) { - base <- base |> mutate(weight=s^(output$rho[i])*(1-s)^(output$gamma[i])) - z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) - expected <- c(expected,z) + for (i in 1:length(rho)) { + output <- base |> + wlr(weight = fh(rho = rho[i], gamma = gamma[i])) + observed[i] <- output$z + + basec <- basec |> mutate(weight=s^(rho[i])*(1-s)^(gamma[i])) + z <- sum(basec$o_minus_e*basec$weight)/sqrt(sum(basec$weight^2*basec$var_o_minus_e)) + expected[i] <- z } + expect_equal(observed, expected) }) @@ -81,23 +96,25 @@ test_that("wlr() with FH weight on stratified data", { test_that("wlr() with MB weight on unstratified data", { # Example 1: Unstratified set.seed(123456) - delay <- 4 - w_max <- 2 base <- sim_pw_surv(n = 200) |> cut_data_by_event(125) - output <- base |> - wlr(weight = mb(delay = delay, w_max = w_max)) + basec <- base |> counting_process(arm = "experimental") - observed <- output$z - base <- base |> counting_process(arm = "experimental") - base2 <- base |> filter(tte<=delay) + delay <- c(4,4,7,7) + w_max <- c(2,3,2,3) + observed <- c() expected <- c() - for (i in 1:length(observed)) { - wht <- base2 |> group_by(stratum) %>% summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max)) - base <- base |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) - z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) - expected <- c(expected,z) + for (i in 1:length(delay)) { + output <- base |> + wlr(weight = mb(delay = delay[i], w_max = w_max[i])) + observed[i] <- output$z + + wht <- basec |> filter(tte<=delay[i]) |> group_by(stratum) |> summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max[i])) + tmp <- basec |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) + z <- sum(tmp$o_minus_e*tmp$weight)/sqrt(sum(tmp$weight^2*tmp$var_o_minus_e)) + expected[i] <- z } + expect_equal(observed, expected) }) @@ -107,8 +124,6 @@ test_that("wlr() with MB weight on unstratified data", { test_that("wlr() with MB weight on stratified data", { # Example 2: Stratified set.seed(123456) - delay <- 4 - w_max <- 2 n <- 500 # Two strata stratum <- c("Biomarker-positive", "Biomarker-negative") @@ -118,7 +133,7 @@ test_that("wlr() with MB weight on stratified data", { duration = c(2, 10, 2, 10), rate = c(c(1, 4) * prevalence_ratio[1], c(1, 4) * prevalence_ratio[2]) ) - enroll_rate$rate <- enroll_rate$rate * n / sum(enroll_rate$duration * enroll_rate$rate) #?? + enroll_rate$rate <- enroll_rate$rate * n / sum(enroll_rate$duration * enroll_rate$rate) # Failure rate med_pos <- 10 # Median of the biomarker positive population med_neg <- 8 # Median of the biomarker negative population @@ -132,7 +147,6 @@ test_that("wlr() with MB weight on stratified data", { dropout_rate = 0.01 ) temp <- to_sim_pw_surv(fail_rate) # Convert the failure rate - set.seed(123456) base <- sim_pw_surv( n = n, # Sample size # Stratified design with prevalence ratio of 6:4 @@ -144,20 +158,23 @@ test_that("wlr() with MB weight on stratified data", { dropout_rate = temp$dropout_rate # Dropout rate ) |> cut_data_by_event(125) + basec <- base |> counting_process(arm = "experimental") - output <- base |> - wlr(weight = mb(delay = delay, w_max = w_max)) - - observed <- output$z - base <- base |> counting_process(arm = "experimental") - base2 <- base |> filter(tte<=delay) + delay <- c(4,4,7,7) + w_max <- c(2,3,2,3) + observed <- c() expected <- c() - for (i in 1:length(observed)) { - wht <- base2 |> group_by(stratum) %>% summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max)) - base <- base |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) - z <- sum(base$o_minus_e*base$weight)/sqrt(sum(base$weight^2*base$var_o_minus_e)) - expected <- c(expected,z) + for (i in 1:length(delay)) { + output <- base |> + wlr(weight = mb(delay = delay[i], w_max = w_max[i])) + observed[i] <- output$z + + wht <- basec |> filter(tte<=delay[i]) |> group_by(stratum) |> summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max[i])) + tmp <- basec |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) + z <- sum(tmp$o_minus_e*tmp$weight)/sqrt(sum(tmp$weight^2*tmp$var_o_minus_e)) + expected[i] <- z } + expect_equal(observed, expected) }) @@ -167,19 +184,22 @@ test_that("wlr() with MB weight on stratified data", { test_that("wlr() with early_zero_weight on unstratified data", { # Example 1: Unstratified set.seed(123456) - early_period = 4 base <- sim_pw_surv(n = 200) |> cut_data_by_event(125) - output <- base |> - wlr(weight = early_zero(early_period = early_period)) + basec <- base |> counting_process(arm = "experimental") - observed <- output$z - # WLR using early_zero_weight yields the same results as directly removing the events happening earlier than `early_period` - base <- base |> counting_process(arm = "experimental") %>% filter(tte>=early_period) + early_period = c(2,4,6) + observed <- c() expected <- c() - for (i in 1:length(observed)) { - # base <- base |> mutate(weight=if_else(tte + wlr(weight = early_zero(early_period = early_period[i])) + observed[i] <- output$z + + # WLR using early_zero_weight yields the same results as directly removing the events happening earlier than `early_period` + tmp <- basec |> filter(tte>=early_period[i]) + # tmp <- basec |> mutate(weight=if_else(tte cut_data_by_event(125) + basec <- base |> counting_process(arm = "experimental") + early_period <- 2 #except being the input, not actually used output <- base |> - wlr(weight = early_zero(early_period = early_period)) - + wlr(weight = early_zero(early_period = early_period,fail_rate = fail_rate)) observed <- output$z - # WLR using early_zero_weight yields the same results as directly removing the events happening earlier than `early_period` - base <- base |> counting_process(arm = "experimental") %>% filter(tte>=early_period) - expected <- c() - for (i in 1:length(observed)) { - # base <- base |> mutate(weight=if_else(tte mutate( + weight = if_else(stratum=='Biomarker-negative',if_else(tte<4,0,log(0.8)),if_else(tte<3,0,log(0.7))) + ) + z <- sum(tmp$o_minus_e*tmp$weight)/sqrt(sum(tmp$weight^2*tmp$var_o_minus_e)) + expected<- z + expect_equal(observed, expected) }) - From f7bd4049b762a10a273eabeadca8c773a91ea673 Mon Sep 17 00:00:00 2001 From: Nan Xiao Date: Mon, 29 Apr 2024 23:10:57 -0400 Subject: [PATCH 5/5] Use `data.frame()`, qualify namespace, run styler --- tests/testthat/test-independent_test_wlr.R | 135 ++++++++++----------- 1 file changed, 67 insertions(+), 68 deletions(-) diff --git a/tests/testthat/test-independent_test_wlr.R b/tests/testthat/test-independent_test_wlr.R index ad4218ea..b710326b 100644 --- a/tests/testthat/test-independent_test_wlr.R +++ b/tests/testthat/test-independent_test_wlr.R @@ -1,17 +1,11 @@ -library(dplyr) -library(gsDesign2) -library(tibble) - - -#### unstratified, FH (Fleming-Harrington) ---- +# Unstratified, FH (Fleming-Harrington) ---- # Check value when Fleming-Harrington weight is used test_that("wlr() with FH weight on unstratified data", { # Example 1: Unstratified set.seed(123456) - base <- sim_pw_surv(n = 200) |> - cut_data_by_event(125) - basec <- base |> - counting_process(arm = "experimental") + + base <- sim_pw_surv(n = 200) |> cut_data_by_event(125) + basec <- base |> counting_process(arm = "experimental") rho <- c(0, 0, 1, 1) gamma <- c(0, 1, 0, 1) @@ -22,20 +16,20 @@ test_that("wlr() with FH weight on unstratified data", { wlr(weight = fh(rho = rho[i], gamma = gamma[i])) observed[i] <- output$z - basec <- basec |> mutate(weight=s^(rho[i])*(1-s)^(gamma[i])) - z <- sum(basec$o_minus_e*basec$weight)/sqrt(sum(basec$weight^2*basec$var_o_minus_e)) + basec <- basec |> dplyr::mutate(weight = s^(rho[i]) * (1 - s)^(gamma[i])) + z <- sum(basec$o_minus_e * basec$weight) / sqrt(sum(basec$weight^2 * basec$var_o_minus_e)) expected[i] <- z } expect_equal(observed, expected) }) - -#### stratified, FH (Fleming-Harrington) ---- +# Stratified, FH (Fleming-Harrington) ---- # Check value when Fleming-Harrington weight is used test_that("wlr() with FH weight on stratified data", { # Example 1: Stratified set.seed(123456) + n <- 500 # Two strata stratum <- c("Biomarker-positive", "Biomarker-negative") @@ -62,68 +56,69 @@ test_that("wlr() with FH weight on stratified data", { base <- sim_pw_surv( n = n, # Sample size # Stratified design with prevalence ratio of 6:4 - stratum = tibble(stratum = stratum, p = prevalence_ratio), + stratum = data.frame(stratum = stratum, p = prevalence_ratio), # Randomization ratio block = c("control", "control", "experimental", "experimental"), enroll_rate = enroll_rate, # Enrollment rate fail_rate = temp$fail_rate, # Failure rate dropout_rate = temp$dropout_rate # Dropout rate - ) |> - cut_data_by_event(125) - basec <- base |> - counting_process(arm = "experimental") + ) |> cut_data_by_event(125) + basec <- base |> counting_process(arm = "experimental") rho <- c(0, 0, 1, 1) gamma <- c(0, 1, 0, 1) observed <- c() expected <- c() for (i in 1:length(rho)) { - output <- base |> - wlr(weight = fh(rho = rho[i], gamma = gamma[i])) + output <- base |> wlr(weight = fh(rho = rho[i], gamma = gamma[i])) observed[i] <- output$z - basec <- basec |> mutate(weight=s^(rho[i])*(1-s)^(gamma[i])) - z <- sum(basec$o_minus_e*basec$weight)/sqrt(sum(basec$weight^2*basec$var_o_minus_e)) + basec <- basec |> dplyr::mutate(weight = s^(rho[i]) * (1 - s)^(gamma[i])) + z <- sum(basec$o_minus_e * basec$weight) / sqrt(sum(basec$weight^2 * basec$var_o_minus_e)) expected[i] <- z } expect_equal(observed, expected) }) - -#### unstratified, MB (Magirr and Burman) ---- +# Unstratified, MB (Magirr and Burman) ---- # Check value when Magirr and Burman weight is used test_that("wlr() with MB weight on unstratified data", { # Example 1: Unstratified set.seed(123456) - base <- sim_pw_surv(n = 200) |> - cut_data_by_event(125) + + base <- sim_pw_surv(n = 200) |> cut_data_by_event(125) basec <- base |> counting_process(arm = "experimental") - delay <- c(4,4,7,7) - w_max <- c(2,3,2,3) + delay <- c(4, 4, 7, 7) + w_max <- c(2, 3, 2, 3) observed <- c() expected <- c() for (i in 1:length(delay)) { - output <- base |> - wlr(weight = mb(delay = delay[i], w_max = w_max[i])) + output <- base |> wlr(weight = mb(delay = delay[i], w_max = w_max[i])) observed[i] <- output$z - wht <- basec |> filter(tte<=delay[i]) |> group_by(stratum) |> summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max[i])) - tmp <- basec |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) - z <- sum(tmp$o_minus_e*tmp$weight)/sqrt(sum(tmp$weight^2*tmp$var_o_minus_e)) + wht <- basec |> + dplyr::filter(tte <= delay[i]) |> + dplyr::group_by(stratum) |> + dplyr::summarise(mx = max(1 / s)) |> + dplyr::mutate(mx = pmin(mx, w_max[i])) + tmp <- basec |> + dplyr::full_join(wht, by = c("stratum")) |> + dplyr::mutate(weight = pmin(1 / s, mx)) + z <- sum(tmp$o_minus_e * tmp$weight) / sqrt(sum(tmp$weight^2 * tmp$var_o_minus_e)) expected[i] <- z } expect_equal(observed, expected) }) - -#### stratified, MB (Magirr and Burman) ---- +# Stratified, MB (Magirr and Burman) ---- # Check value when Magirr and Burman weight is used test_that("wlr() with MB weight on stratified data", { # Example 2: Stratified set.seed(123456) + n <- 500 # Two strata stratum <- c("Biomarker-positive", "Biomarker-negative") @@ -150,67 +145,69 @@ test_that("wlr() with MB weight on stratified data", { base <- sim_pw_surv( n = n, # Sample size # Stratified design with prevalence ratio of 6:4 - stratum = tibble(stratum = stratum, p = prevalence_ratio), + stratum = data.frame(stratum = stratum, p = prevalence_ratio), # Randomization ratio block = c("control", "control", "experimental", "experimental"), enroll_rate = enroll_rate, # Enrollment rate fail_rate = temp$fail_rate, # Failure rate dropout_rate = temp$dropout_rate # Dropout rate - ) |> - cut_data_by_event(125) + ) |> cut_data_by_event(125) basec <- base |> counting_process(arm = "experimental") - delay <- c(4,4,7,7) - w_max <- c(2,3,2,3) + delay <- c(4, 4, 7, 7) + w_max <- c(2, 3, 2, 3) observed <- c() expected <- c() for (i in 1:length(delay)) { - output <- base |> - wlr(weight = mb(delay = delay[i], w_max = w_max[i])) + output <- base |> wlr(weight = mb(delay = delay[i], w_max = w_max[i])) observed[i] <- output$z - wht <- basec |> filter(tte<=delay[i]) |> group_by(stratum) |> summarise(mx = max(1/s)) |> mutate(mx = pmin(mx,w_max[i])) - tmp <- basec |> full_join(wht, by=c('stratum')) |> mutate(weight=pmin(1/s,mx)) - z <- sum(tmp$o_minus_e*tmp$weight)/sqrt(sum(tmp$weight^2*tmp$var_o_minus_e)) + wht <- basec |> + dplyr::filter(tte <= delay[i]) |> + dplyr::group_by(stratum) |> + dplyr::summarise(mx = max(1 / s)) |> + dplyr::mutate(mx = pmin(mx, w_max[i])) + tmp <- basec |> + dplyr::full_join(wht, by = c("stratum")) |> + dplyr::mutate(weight = pmin(1 / s, mx)) + z <- sum(tmp$o_minus_e * tmp$weight) / sqrt(sum(tmp$weight^2 * tmp$var_o_minus_e)) expected[i] <- z } expect_equal(observed, expected) }) - -#### unstratified, early_zero_weight ---- +# Unstratified, early_zero_weight ---- # Check value when early_zero_weight is used test_that("wlr() with early_zero_weight on unstratified data", { # Example 1: Unstratified set.seed(123456) - base <- sim_pw_surv(n = 200) |> - cut_data_by_event(125) + + base <- sim_pw_surv(n = 200) |> cut_data_by_event(125) basec <- base |> counting_process(arm = "experimental") - early_period = c(2,4,6) + early_period <- c(2, 4, 6) observed <- c() expected <- c() for (i in 1:length(early_period)) { - output <- base |> - wlr(weight = early_zero(early_period = early_period[i])) + output <- base |> wlr(weight = early_zero(early_period = early_period[i])) observed[i] <- output$z # WLR using early_zero_weight yields the same results as directly removing the events happening earlier than `early_period` - tmp <- basec |> filter(tte>=early_period[i]) + tmp <- basec |> dplyr::filter(tte >= early_period[i]) # tmp <- basec |> mutate(weight=if_else(tte - cut_data_by_event(125) + ) |> cut_data_by_event(125) basec <- base |> counting_process(arm = "experimental") - early_period <- 2 #except being the input, not actually used - output <- base |> - wlr(weight = early_zero(early_period = early_period,fail_rate = fail_rate)) + early_period <- 2 # Except being the input, not actually used + output <- base |> wlr(weight = early_zero(early_period = early_period, fail_rate = fail_rate)) observed <- output$z - tmp <- basec |> mutate( - weight = if_else(stratum=='Biomarker-negative',if_else(tte<4,0,log(0.8)),if_else(tte<3,0,log(0.7))) + tmp <- basec |> dplyr::mutate( + weight = dplyr::if_else( + stratum == "Biomarker-negative", + dplyr::if_else(tte < 4, 0, log(0.8)), + dplyr::if_else(tte < 3, 0, log(0.7)) + ) ) - z <- sum(tmp$o_minus_e*tmp$weight)/sqrt(sum(tmp$weight^2*tmp$var_o_minus_e)) - expected<- z + z <- sum(tmp$o_minus_e * tmp$weight) / sqrt(sum(tmp$weight^2 * tmp$var_o_minus_e)) + expected <- z expect_equal(observed, expected) })