279 data sim bug (#289)

* failing test w/ bug

* was failing for wrong reasons

* fun fix

* vbump

Author: mattsecrest

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",

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)

README.md

@@ -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 -->

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 --------