diff --git a/R/wlr.R b/R/wlr.R index e2fda4eb..808f48d5 100644 --- a/R/wlr.R +++ b/R/wlr.R @@ -97,21 +97,21 @@ wlr <- function(data, weight, return_variance = FALSE) { ans$parameter <- paste0("FH(rho=", weight$rho, ", gamma=", weight$gamma, ")") ans$estimate <- sum(x$weight * x$o_minus_e) ans$se <- sqrt(sum(x$weight^2 * x$var_o_minus_e)) - ans$z <- ans$estimate / ans$se + ans$z <- -ans$estimate / ans$se } else if (inherits(weight, "mb")) { x <- x |> mb_weight(delay = weight$delay, w_max = weight$w_max) ans$parameter <- paste0("MB(delay = ", weight$delay, ", max_weight = ", weight$w_max, ")") ans$estimate <- sum(x$o_minus_e * x$mb_weight) ans$se <- sqrt(sum(x$var_o_minus_e * x$mb_weight^2)) - ans$z <- ans$estimate / ans$se + ans$z <- -ans$estimate / ans$se } else if (inherits(weight, "early_period")) { x <- x |> early_zero_weight(early_period = weight$early_period, fail_rate = weight$fail_rate) ans$parameter <- paste0("Xu 2017 with first ", round(weight$early_period, 4), " months of 0 weights") ans$estimate <- sum(x$o_minus_e * x$weight) ans$se <- sqrt(sum(x$var_o_minus_e * x$weight^2)) - ans$z <- ans$estimate / ans$se + ans$z <- -ans$estimate / ans$se } return(ans) } diff --git a/tests/testthat/helper-simfix.R b/tests/testthat/helper-simfix.R deleted file mode 100644 index 5b9bf7f9..00000000 --- a/tests/testthat/helper-simfix.R +++ /dev/null @@ -1,47 +0,0 @@ -# Helper functions used by test-double_programming_simfix.R - -test_simfix <- function() { - # Study design using gsDesign - alpha <- 0.025 - gamma <- c(5, 5, 47) - R <- c(1, 1, 9) - median.c <- 7 - hr <- 0.65 - dropout <- 0.05 - # Set power = 0.9 with target events = 227 - PE <- gsDesign::nSurv( - alpha = alpha, beta = c(1 - 0.9), sided = 1, lambdaC = log(2) / median.c, hr = hr, - eta = -log(1 - dropout) / 12, gamma = gamma, R = R, T = 18 - ) - # Set power = 0.93 with duration = 18 - PE <- gsDesign::nSurv( - alpha = alpha, beta = c(1 - 0.93), sided = 1, lambdaC = log(2) / median.c, hr = hr, - eta = -log(1 - dropout) / 12, gamma = gamma, R = R, T = 18 - ) - - # Test for power comparing sim_fixed_n results with simple study design - set.seed(1234) - test2 <- sim_fixed_n( - n_sim = 100, - sample_size = 434, - target_event = 227, - stratum = data.frame(stratum = "All", p = 1), - enroll_rate = data.frame( - duration = c(1, 1, 9), - rate = c(5, 5, 47) - ), - fail_rate = data.frame( - stratum = "All", - duration = c(100), - fail_rate = log(2) / 7, - hr = 0.65, - dropout_rate = -log(1 - 0.05) / 12 - ), - total_duration = 18, - block = rep(c("experimental", "control"), 2), - timing_type = 1:5, - rho_gamma = data.frame(rho = 0, gamma = 0) - ) - - list("test2" = test2) -} diff --git a/tests/testthat/test-double_programming_sim_fixed_n.R b/tests/testthat/test-double_programming_sim_fixed_n.R index 369a0642..d73cf101 100644 --- a/tests/testthat/test-double_programming_sim_fixed_n.R +++ b/tests/testthat/test-double_programming_sim_fixed_n.R @@ -1,24 +1,57 @@ -test_that("test for sim_fixed_n power comparing to gsDesign results with fixed duration in timing_type=1", { +test_that("Double programming of sim_fixed_n", { skip_if_not_installed("gsDesign") - test2 <- test_simfix()$test2 - tt1test <- subset(test2, test2$cut == "Planned duration", select = c(event, ln_hr, z, duration, sim)) - expect_equal(object = sum(as.integer(tt1test$z < (-1.96))) / 100, expected = 0.94, tolerance = 0.02) -}) + # Study design using gsDesign + alpha <- 0.025 + gamma <- c(5, 5, 47) + R <- c(1, 1, 9) + median.c <- 7 + hr <- 0.65 + dropout <- 0.05 + # Set power = 0.9 with target events = 227 + PE <- gsDesign::nSurv( + alpha = alpha, beta = c(1 - 0.9), sided = 1, lambdaC = log(2) / median.c, hr = hr, + eta = -log(1 - dropout) / 12, gamma = gamma, R = R, T = 18 + ) + # Set power = 0.93 with duration = 18 + PE <- gsDesign::nSurv( + alpha = alpha, beta = c(1 - 0.93), sided = 1, lambdaC = log(2) / median.c, hr = hr, + eta = -log(1 - dropout) / 12, gamma = gamma, R = R, T = 18 + ) -test_that("test for sim_fixed_n power comparing to gsDesign results with target events in timing_type=2", { - skip_if_not_installed("gsDesign") + # Test for power comparing sim_fixed_n results with simple study design + set.seed(1234) + test2 <- sim_fixed_n( + n_sim = 100, + sample_size = 434, + target_event = 227, + stratum = data.frame(stratum = "All", p = 1), + enroll_rate = data.frame( + duration = c(1, 1, 9), + rate = c(5, 5, 47) + ), + fail_rate = data.frame( + stratum = "All", + duration = c(100), + fail_rate = log(2) / 7, + hr = 0.65, + dropout_rate = -log(1 - 0.05) / 12 + ), + total_duration = 18, + block = rep(c("experimental", "control"), 2), + timing_type = 1:5, + rho_gamma = data.frame(rho = 0, gamma = 0) + ) - test2 <- test_simfix()$test2 - tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim)) - expect_equal(object = sum(as.integer(tt2test$z < (-1.96))) / 100, expected = 0.93, tolerance = 0.02) -}) - -test_that("test for events in the correct directions in timing_type=3 comparing to timing_type=2", { - skip_if_not_installed("gsDesign") + # test for sim_fixed_n power comparing to gsDesign results with fixed duration in timing_type=1 + tt1test <- subset(test2, test2$cut == "Planned duration", select = c(event, ln_hr, z, duration, sim)) + expect_equal(object = sum(as.integer(tt1test$z > 1.96)) / 100, expected = 0.94, tolerance = 0.02) - test2 <- test_simfix()$test2 + # test for sim_fixed_n power comparing to gsDesign results with target events in timing_type=2 + tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim)) + expect_equal(object = sum(as.integer(tt2test$z > 1.96)) / 100, expected = 0.93, tolerance = 0.02) + # test for events in the correct directions in timing_type=3 comparing to timing_type=2 tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim)) tt3test <- subset(test2, test2$cut == "Minimum follow-up", select = c(event, ln_hr, z, duration, sim)) ttvalue <- 0 @@ -33,13 +66,8 @@ test_that("test for events in the correct directions in timing_type=3 comparing } expect_equal(object = unique(ttvalue), expected = 1) -}) - -test_that("test for timing_type=4 outputs using timing_type 1 and 2 output", { - skip_if_not_installed("gsDesign") - - test2 <- test_simfix()$test2 + # test for timing_type=4 outputs using timing_type 1 and 2 output tt1test <- subset(test2, test2$cut == "Planned duration", select = c(event, ln_hr, z, duration, sim)) tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim)) tt4test <- subset(test2, test2$cut == "Max(planned duration, event cut)", select = c(event, ln_hr, z, duration, sim)) @@ -53,13 +81,8 @@ test_that("test for timing_type=4 outputs using timing_type 1 and 2 output", { } expect_equal(object = tt4event, expected = tt4test$event) -}) - -test_that("test for timing_type=5 outputs using timing_type 2 and 3 output", { - skip_if_not_installed("gsDesign") - - test2 <- test_simfix()$test2 + # test for timing_type=5 outputs using timing_type 2 and 3 output tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim)) tt3test <- subset(test2, test2$cut == "Minimum follow-up", select = c(event, ln_hr, z, duration, sim)) tt5test <- subset(test2, test2$cut == "Max(min follow-up, event cut)", select = c(event, ln_hr, z, duration, sim)) diff --git a/tests/testthat/test-independent_test_fh_weight.R b/tests/testthat/test-independent_test_fh_weight.R index 0f897118..f8a85c91 100644 --- a/tests/testthat/test-independent_test_fh_weight.R +++ b/tests/testthat/test-independent_test_fh_weight.R @@ -25,7 +25,7 @@ test_that("the z values match with the correspondings in fh_weight", { aa3 <- y |> wlr(weight = fh(rho = 1, gamma = 0)) aa4 <- y |> wlr(weight = fh(rho = 1, gamma = 1)) - expect_equal(c(z1[1], z1[7:9]), c(aa1$z, aa2$z, aa3$z, aa4$z), tolerance = 0.00001) + expect_equal(c(z1[1], z1[7:9]), -c(aa1$z, aa2$z, aa3$z, aa4$z), tolerance = 0.00001) }) test_that("fh_weight calculated correct correlation value when input a sequence of rho and gamma", { diff --git a/tests/testthat/test-independent_test_wlr.R b/tests/testthat/test-independent_test_wlr.R index b710326b..e8495050 100644 --- a/tests/testthat/test-independent_test_wlr.R +++ b/tests/testthat/test-independent_test_wlr.R @@ -17,7 +17,7 @@ test_that("wlr() with FH weight on unstratified data", { observed[i] <- output$z 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)) + z <- -sum(basec$o_minus_e * basec$weight) / sqrt(sum(basec$weight^2 * basec$var_o_minus_e)) expected[i] <- z } @@ -74,7 +74,7 @@ test_that("wlr() with FH weight on stratified data", { observed[i] <- output$z 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)) + z <- -sum(basec$o_minus_e * basec$weight) / sqrt(sum(basec$weight^2 * basec$var_o_minus_e)) expected[i] <- z } @@ -106,7 +106,7 @@ test_that("wlr() with MB weight on unstratified data", { 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)) + z <- -sum(tmp$o_minus_e * tmp$weight) / sqrt(sum(tmp$weight^2 * tmp$var_o_minus_e)) expected[i] <- z } @@ -170,7 +170,7 @@ test_that("wlr() with MB weight on stratified data", { 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)) + z <- -sum(tmp$o_minus_e * tmp$weight) / sqrt(sum(tmp$weight^2 * tmp$var_o_minus_e)) expected[i] <- z } @@ -196,7 +196,7 @@ test_that("wlr() with early_zero_weight on unstratified data", { # WLR using early_zero_weight yields the same results as directly removing the events happening earlier than `early_period` tmp <- basec |> dplyr::filter(tte >= early_period[i]) # tmp <- basec |> mutate(weight=if_else(tte wlr(weight = mb(delay = 6)) # Compute p-value of modestly weighted logrank of Magirr-Burman -pnorm(ZMB$z) +pnorm(ZMB$z, lower.tail = FALSE) ``` Now we set the maximum weight to be 2 as in @Magirr2021 and set the `delay=Inf` so that the maximum weight begins at the observed median of the observed combined treatment Kaplan-Meier curve. @@ -100,7 +100,7 @@ Now we set the maximum weight to be 2 as in @Magirr2021 and set the `delay=Inf` ZMB <- MBdelay |> wlr(weight = mb(delay = Inf, w_max = 2)) # Compute p-value of modestly weighted logrank of Magirr-Burman -pnorm(ZMB$z) +pnorm(ZMB$z, lower.tail = FALSE) ``` Another way this can be done is with a generalized Fleming-Harrington test with @@ -185,7 +185,7 @@ ZMB <- FHwn |> wlr(weight = mb(delay = 6, w_max = 2)) # Compute p-value of modestly weighted logrank of Magirr-Burman -pnorm(ZMB$z) +pnorm(ZMB$z, lower.tail = FALSE) ``` Finally, we consider weighted logrank tests with less down-weighting. diff --git a/vignettes/parallel.Rmd b/vignettes/parallel.Rmd index d475bcdf..9016ff82 100644 --- a/vignettes/parallel.Rmd +++ b/vignettes/parallel.Rmd @@ -220,7 +220,7 @@ Because these resources are not commonly available, we will not execute the belo Consider that you have two accessible nodes, each with three cores (shown in the diagram below). ```{r schema, echo=FALSE, fig.cap="Available resource schematic.", fig.align="center", out.width="90%"} -knitr::include_graphics("schema.png") +knitr::include_graphics("./figures/schema.png") ``` Ideally, all available resources will be used when executing the simulations. diff --git a/vignettes/workflow.Rmd b/vignettes/workflow.Rmd index 85a7cdf4..cd3ee1e6 100644 --- a/vignettes/workflow.Rmd +++ b/vignettes/workflow.Rmd @@ -68,7 +68,7 @@ Group sequential design simulation flow: - Summarize across simulated trials. ```{r, echo=FALSE, fig.align="center", out.width="85%"} -knitr::include_graphics("workflow.png") +knitr::include_graphics("./figures/workflow.png") ``` ```{r, echo=FALSE, eval=FALSE}