diff --git a/DESCRIPTION b/DESCRIPTION index a878c2d8..2a7749d1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: psborrow2 Title: Bayesian Dynamic Borrowing Analysis and Simulation -Version: 0.0.3.2 +Version: 0.0.3.3 Authors@R: c( person( given = "Matt", diff --git a/R/simulate_data.R b/R/simulate_data.R index cfcfccac..2b8ffc5e 100644 --- a/R/simulate_data.R +++ b/R/simulate_data.R @@ -325,7 +325,8 @@ cut_off_after_last <- function(time) { cut_off_after_events <- function(n) { .datasim_cut_off( fun = function(data) { - cut_time <- sort(data$enrollment + data$eventtime)[n] + data_s1 <- data[data$status == 1, ] + cut_time <- sort(data_s1$enrollment + data_s1$eventtime)[n] after_cut_off <- data$enrollment + data$eventtime > cut_time data$status <- ifelse(after_cut_off, 0, data$status) data$eventtime <- ifelse(after_cut_off, cut_time - data$enrollment, data$eventtime) diff --git a/README.md b/README.md index 7018af34..b079d28b 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ -[![Version](https://img.shields.io/static/v1.svg?label=github.com/genentech&message=v.0.0.3.2&color=DC0073)](https://github.com/Genentech/psborrow2) +[![Version](https://img.shields.io/static/v1.svg?label=github.com/genentech&message=v.0.0.3.3&color=DC0073)](https://github.com/Genentech/psborrow2) [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-green.svg)](https://www.tidyverse.org/lifecycle/#stable) diff --git a/tests/testthat/test-simulate_data.R b/tests/testthat/test-simulate_data.R index c9acb078..90e11125 100644 --- a/tests/testthat/test-simulate_data.R +++ b/tests/testthat/test-simulate_data.R @@ -177,12 +177,24 @@ test_that("cut_off_after_last works as expected", { test_that("cut_off_after_events works as expected", { result <- cut_off_after_events(n = 2) expect_class(result, "DataSimCutOff") - test_data <- data.frame(id = 1:4, eventtime = c(2, 5, 2, 4), enrollment = c(1, 2, 3, 7), status = c(1, 0, 1, 1)) + test_data <- data.frame( + id = 1:8, + status = rep(c(1, 0), length.out = 8), + eventtime = rep(1:4, each = 2), + enrollment = rep(2:5, length.out = 8) + ) + cutoff_data <- result@fun(test_data) + + # for n = 2, 2nd event is at 5 time units: pts 1 and 5 expected_data <- data.frame( - id = 1:3, eventtime = c(2, 3, 2), enrollment = 1:3, status = c(1, 0, 1) + id = c(1, 2, 3, 5, 6, 7), # Lose pts who enroll on/after 5 time units + status = c(1, 0, 0, 1, 0, 0), # Reassign pts who have events > 5 time units (enroll+event) + eventtime = c(1, 1, 1, 3, 2, 1), # Max follow-up is 5 units, + enrollment = rep(c(2,3,4), length.out = 6) ) - expect_equal(cutoff_data, expected_data) + + expect_equal(cutoff_data, expected_data, ignore_attr = TRUE) }) # set_cut_off --------