Skip to content

Commit

Permalink
279 data sim bug (#289)
Browse files Browse the repository at this point in the history
* failing test w/ bug

* was failing for wrong reasons

* fun fix

* vbump
  • Loading branch information
mattsecrest authored Apr 12, 2024
1 parent 0717586 commit edb4762
Show file tree
Hide file tree
Showing 4 changed files with 19 additions and 6 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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",
Expand Down
3 changes: 2 additions & 1 deletion R/simulate_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion README.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@

<!-- badges: start -->

[![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)

<!-- badges: end -->
Expand Down
18 changes: 15 additions & 3 deletions tests/testthat/test-simulate_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -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 --------
Expand Down

0 comments on commit edb4762

Please sign in to comment.