From 413fd1c7f5307cf7b8e86000ba4910f22974d65b Mon Sep 17 00:00:00 2001 From: Matt Secrest Date: Thu, 11 Apr 2024 14:16:54 -0700 Subject: [PATCH 1/4] failing test w/ bug --- tests/testthat/test-simulate_data.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-simulate_data.R b/tests/testthat/test-simulate_data.R index c9acb078..b2ebb337 100644 --- a/tests/testthat/test-simulate_data.R +++ b/tests/testthat/test-simulate_data.R @@ -177,10 +177,19 @@ 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) + ) + test_data$caltime <- test_data$eventtime + test_data$enrollment # for n = 2, 2nd event is at 5 time units: pts 1 and 5 cutoff_data <- result@fun(test_data) 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) }) From 03c8575e0f7d610472a13687aeda029101f17829 Mon Sep 17 00:00:00 2001 From: Matt Secrest Date: Thu, 11 Apr 2024 14:29:04 -0700 Subject: [PATCH 2/4] was failing for wrong reasons --- tests/testthat/test-simulate_data.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-simulate_data.R b/tests/testthat/test-simulate_data.R index b2ebb337..90e11125 100644 --- a/tests/testthat/test-simulate_data.R +++ b/tests/testthat/test-simulate_data.R @@ -183,15 +183,18 @@ test_that("cut_off_after_events works as expected", { eventtime = rep(1:4, each = 2), enrollment = rep(2:5, length.out = 8) ) - test_data$caltime <- test_data$eventtime + test_data$enrollment # for n = 2, 2nd event is at 5 time units: pts 1 and 5 + 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 = 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 -------- From fca6fc3a02017cbf40f307dffff27196e087b34e Mon Sep 17 00:00:00 2001 From: Matt Secrest Date: Thu, 11 Apr 2024 14:29:09 -0700 Subject: [PATCH 3/4] fun fix --- R/simulate_data.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) 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) From b67791d657479e437dc72d3be8e313884e75ddad Mon Sep 17 00:00:00 2001 From: Matt Secrest Date: Thu, 11 Apr 2024 14:29:58 -0700 Subject: [PATCH 4/4] vbump --- DESCRIPTION | 2 +- README.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) 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/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)