From 3ad6948ff5f8da63edb9ff38ffe4ae7f02a9a5b7 Mon Sep 17 00:00:00 2001 From: John Blischak Date: Thu, 26 Oct 2023 14:45:38 -0400 Subject: [PATCH 1/2] Update script to generate MBdelayed.rda --- R/MBdelayed.R | 2 +- data-raw/DATASET.R | 30 ++++++++++++++++-------------- data/MBdelayed.rda | Bin 10425 -> 2270 bytes man/MBdelayed.Rd | 2 +- 4 files changed, 18 insertions(+), 16 deletions(-) diff --git a/R/MBdelayed.R b/R/MBdelayed.R index ef50c913..dab61fc9 100644 --- a/R/MBdelayed.R +++ b/R/MBdelayed.R @@ -28,7 +28,7 @@ #' under the above scenario. #' #' @format -#' A tibble with 200 rows and xx columns: +#' A tibble with 200 rows and 4 columns: #' - `tte`: Time to event. #' #' @references diff --git a/data-raw/DATASET.R b/data-raw/DATASET.R index da826a7d..ea010c70 100644 --- a/data-raw/DATASET.R +++ b/data-raw/DATASET.R @@ -1,22 +1,24 @@ -## code to prepare `DATASET` dataset goes here +## code to prepare `MBdelayed` dataset goes here +library(simtrial) library(tibble) set.seed(6671) -ds <- simPWSurv( +ds <- sim_pw_surv( n = 200, - enrollRates = tibble(rate = 200 / 12, duration = 12), - failRates = tribble( - ~Stratum, ~Period, ~Treatment, ~duration, ~rate, - "All", 1, "Control", 42, log(2) / 15, - "All", 1, "Experimental", 6, log(2) / 15, - "All", 2, "Experimental", 36, log(2) / 15 * 0.6 + block = c(rep("control", 2), rep("experimental", 2)), + enroll_rate = tibble(rate = 200 / 12, duration = 12), + fail_rate = tribble( + ~stratum, ~period, ~treatment, ~duration, ~rate, + "All", 1, "control", 42, log(2) / 15, + "All", 1, "experimental", 6, log(2) / 15, + "All", 2, "experimental", 36, log(2) / 15 * 0.6 ), - dropoutRates = tribble( - ~Stratum, ~Period, ~Treatment, ~duration, ~rate, - "All", 1, "Control", 42, 0, - "All", 1, "Experimental", 42, 0 + dropout_rate = tribble( + ~stratum, ~period, ~treatment, ~duration, ~rate, + "All", 1, "control", 42, 0, + "All", 1, "experimental", 42, 0 ) ) # cut data at 24 months after final enrollment -MBdelayed <- ds %>% cutData(max(ds$enrollTime) + 24) +MBdelayed <- ds %>% cut_data_by_date(max(ds$enroll_time) + 24) -usethis::use_data("MBdelayed") +usethis::use_data(MBdelayed, overwrite = TRUE) diff --git a/data/MBdelayed.rda b/data/MBdelayed.rda index 5716c95ea8abd8dbf70c2b4ffd16ccb122a5f9f2..9a8f42b9e90c7f9357cc7fb285568aaee5471461 100644 GIT binary patch literal 2270 zcmV<42qE`ET4*^jL0KkKS+^Ud=l}{P|NsC0|NsC0|NsC0|NsC0|NsC0|NsAg|NsC0 z|NsC0|Nqbh{sY{kIqt>hknV@GEsT(0rfM*lnr11qh9;hdjS+-BCIr!wYH5Jfz=JZF zOcO@Y88q}GCXYfIGBjb5X`|CqPbq+z8%cs~O&dvw$)NHH>TMC|hSc>4rkaS;Nwo}( z28|kMX{L`t9+1;&G|Bp&sp+CJdTBiqN2#MtJq<<^C#FIkf;1XzpxHwR4K}7g&;T?I z03M;HMokR^LrnuFn3)h74FtxTOw&<@kkd`6jR4eonV<%yn4XD=jRI)FFluc~(ii}Y z00h8{OpP(3dTKBUk)zN6CJBH{CI)~28hWIZ4Gj$d0000000006fB*mh4FEI%00000 zXaEC10000001W^DNhwbtl>JQ7p3tYJr>ONjqZuKlH8g3mjf#4nr>W{Tr=-aBHlgZm zM#_4Oo}uYIG>xb<4=4t3gO&VO&(zE1=;ziBRh-SQAFN)>cc1c6J{QPeuP z4r|%Q*W#=wU?c^fqfHUG!L)>BOu2}NI^#OHZ^uXMG z=MB)qLBkkp0ZR(vFqPioYh>z%0SORDY3sWc)3fW)*t311iFg(rm2B(to~gvl12xQX zAl;07u`op=iDNG8k|&^@#tSB2#@L9J{4znDO0SORzJ__}iexj@0->h!tnMx~G>9%QImUg?r=oe^1Rs+usu3I4UH$XzP1WI4GB zXy$k7#s~#4CkTfjj6{EEo{CVVg-(syU7i!wE;Y}i9T=X3MLjeL*wZ9NXlZybCRK=l z_=?=hfreOVsUsVBHE55{+_rJ2BBbP$a7!jt#H%vTtJx8tp`6z7tbD1*f%8U&*9*&5 z)p#E&;nm;gK2We9IUD`$AV9#7fCYvb!bk%;GH{-AlcY|0;pdq=B!`^H0nT%r=134B zfMBNyI1s`T7=PtmrqdH^aHK(FYc64xKsq$n8j|c=NTyrt)8!_w)rG*(q`a=@uge~o z6NI?iJvQ7oG^*CF3(NA%9TB|zKj~D1&yGa5Zs4M}n=>LFPfvS%@7I55zKu6rB9$=W z3oY|U?ADJMxI@m7g-}o&3;>!>%BRnuBEpnzEa7Prk((Itl|r)-#x+pWv<>Lbs-p}z z9#F8M?ERf5KCV*EIQ^THI;?rUxz1JX;SI_~SeMwl$clw9kun0c44Oo!$EquVl&DV8{K{Vx;k+gPda$x{Y4V0Ob~GJc!g@=py7r zFPo1Tvy6EC86G`Lwsv|JvGRqjjxbXjb6eKrI7&~2c}Jm;gIVZe zO;~*y1GPu_Lt&;0k5FUNt`SvgC}((b%8;6Hb_UIehhA99UAx#FRbk1ALad{X5_wpJ zb#CHYl3|_2QI$0x+E73c072@Iv60@Gc`=xZl>IB!o7^_V03cK`n+w_ro9Vub$*lRf zyE)n{e%f1GEpaCHxq$+B5GEwKtGhkT4)jz=0$n5Rkyh2m~-P1dxyeAV@%gl0bo&7(z${Fw8R{nKKM9y)H9s z0tGe5dvEanxFAj#X&LwQoUFzoFh~?IK%!};z4=f;qyYkGHM~c4b_f^OOy5ofzLrZB zdpp9CK!GqIU8ODix<;#*qwxIR57vieIg}~yKgdpk1s>!$_dx=*cB+?W1Gci^`#r~j zDeM0imc8#A9VsI;`{T2O2o+4AeVf;yR_cRD_&{P1%gU7pe~c4V8x_ZCfWwsS(r~G1 zi`m5wjER;N81r=V5JI5os)Sa}#|m5~F{k3?HLYuQu##q!C;4LRI;!Lujrn1Isf|dN zpSEDy_+6~?CbLj7?t@z-t;LcU>=6g2m}KJB46tKVZ@IsXj12AR2Gm|g1Q-}3#itBL z1J3qc9NKALTryN~Q;EdP&f7OCHeA)VhGXc<==F6TC-mVoBd5Zuhq#7lts35Bg1nxP zYX8$&HRkwQ!Y;`^(P~4*s^wWYmW3s&xT#9``>7Q)SmF@9+q*(D%yF)+u6_3E^(+5+ zP_PGTPi3&bm8aV14oVC;>9&_g40dB(9v{BG=scRI|B|!?F-dZQbmE95p z&D0P`9AntN)T%!0($Of%G_UPH->0G8^iMvkY?on_LP7f(Vp+ z75lp!5OdEEWfR^6Bq_$JK~7ar(8xwYj}>O%sb4>P6fH(;V`&ulNEHtIQV5u1;QhrEfTGaJ5-U8Z3o+J} s7Hcc800Le18UJ2ha{A_20}=lhaz!{$khdG9=yb0)a{vGU literal 10425 zcmeI&2~<_p8VB&ha3K&8kx9HbFwcU3aN)}R5M)pxGa=BFK#)NYx?B_#4V=}pKpJApK}K| z*FD`Y+(k27lVKPYMpa3PQ4!!FBM6=0@8H2Os>%qI7*$3Ctw!*~nAoJK%-9$t4?~A4 zXhRL@R=gcvI`$eF)r5Ux_4XC=IjVCe^liyPhX`W zxi41Ldp47;^yaBr^mn{;j#->lMwV7jq-Pl=^4V52IleQS2Bqj6dx2p{#mM(Y#q3tH zzvL=8bN&JOBqm*Sco;?|iTOo_U)Yh4v!?9f%4sBy-TYfYu@VW#m0#M_*-5%F?+!kz zpGZDdYfbN7C`N0L-y&}i#Esla5ux1AT6Px>wE+{QSfyh7c1pT9ynF6J{w<2o1}ol_Km^YU;Io-g|Gu#S=^7gijkQP}eEvdi+AflKQHU zbD1KtHD1;3o4$}-+)LJYHX4(qwlJn{(~6Tv+?9jKyV`JOz%{Blp%bv`j&FUog0O)yrr5qd|{1S8FeD{eM4)a_JE8lG>HYpoCK(YhO) z9V5W`S?_+7vPwUYoWH5xy+B^?n_&C1@s5aF6H2C$b^V}d%Pp(O z;8ehfshCgXzUk3U-BwB4{QSC*ul-1z`R^xf!j&|BMU~0Y#%vNUZ~rNyw2eHh{pW8y z5J5H_XLBntPW?gdi8!~bq}JqSeQ{|LiEYA#+V2~XSl@3(Zh0PwHH_OAuii&u#_Hl~ z*9tNV+vgFpY6p4!7(CZd*Mn^J4y`LPo~5s5_8m@SNlgh^;O}|B_&EiUe)DCKMv}%y-__C=I2d%~x*)A~v_lo$On3fIKrs z1;5wOL9XkTtaQCMjT{eJY<+~|LpOeL&L+c8(yDDJwi7mymF6dHZ+aak&yd@n)QLBf z-I&pOr%gU0Pal_)dK%GWxWC}kieD2YKMG62bi#=&KMy^*-Y$+TEPmJ3Cl7o5~n9pubR(AaZRT5pBQygLPDh)GOdNEinii$%!-5tykVlia@;~dXNn|~2R#KrYnVXib%h@(pa%{1+Q22f}xf);Hda~V^ zY<8au3~c;>G_QD!IbXSwZ1uGhTtm#rW39uapv&Y$(ZTa@IdEB#=#gwcLDe+}rrxj`y`5 zo6ojveQw-aKYP5VmRpZUtb?4I?i&^rpQNOLhqzfAxDH)6umjiO>5crrbr`q~10MkKl>=(ITYpf zy>j12D4LgVU*Birj8HUD-&1&u=%0yrRN=9f|N9gkC)ht%l1G*PN$H<6>YueJs-mcm zvt~}nV}zmp@vKv8zqz9adKu?>pBHY-L2o6Cpd;+ELDU?Au9EZ>0B%Fe3_zG%(eO{FCSQP}I27^EgGUG2G&9@tb=#pUDyQg z!DjdXw!??;5$u9|*aro001m>(a2Sq22^@uE@EKIV38;iGpbEZ()10@bAXS!`DnBv# zlYxKojd{wQcp!gbuye2LO*DAnT$wa2GASWV7Ma3+5@|l|l>h8bQ Date: Fri, 3 Nov 2023 13:47:11 -0400 Subject: [PATCH 2/2] Fail early for mismatched treatment names --- R/sim_pw_surv.R | 7 +++++ .../test-double_programming_simPWSurv.R | 27 +++++++++++++++++++ 2 files changed, 34 insertions(+) diff --git a/R/sim_pw_surv.R b/R/sim_pw_surv.R index a9c604fc..6d4b3a69 100644 --- a/R/sim_pw_surv.R +++ b/R/sim_pw_surv.R @@ -142,6 +142,13 @@ sim_pw_surv <- function( duration = rep(100, 2), rate = rep(.001, 2) )) { + # Enforce consistent treatment names + treatments <- unique(c(block, fail_rate$treatment, dropout_rate$treatment)) + stopifnot( + treatments %in% block, + treatments %in% fail_rate$treatment, + treatments %in% dropout_rate$treatment + ) # Start table by generating stratum and enrollment times x <- data.table(stratum = sample( x = stratum$stratum, diff --git a/tests/testthat/test-double_programming_simPWSurv.R b/tests/testthat/test-double_programming_simPWSurv.R index ef7fa4d6..d8460b62 100644 --- a/tests/testthat/test-double_programming_simPWSurv.R +++ b/tests/testthat/test-double_programming_simPWSurv.R @@ -127,3 +127,30 @@ zevent <- dplyr::bind_rows(rate00, rate01, rate10, rate11) testthat::test_that("The actual number of events changes by changing total sample size", { expect_false(unique(xevent$event == zevent$event)) }) + +testthat::test_that("sim_pw_surv() fails early with mismatched treatment names", { + block <- c(rep("x", 2), rep("y", 2)) + fail_rate <- data.frame( + stratum = rep("All", 4), + period = rep(1:2, 2), + treatment = c(rep("x", 2), rep("y", 2)), + duration = rep(c(3, 1), 2), + rate = log(2) / c(9, 9, 9, 18) + ) + dropout_rate <- data.frame( + stratum = rep("All", 2), + period = rep(1, 2), + treatment = c("x", "y"), + duration = rep(100, 2), + rate = rep(0.001, 2) + ) + + expect_error(sim_pw_surv(block = block)) + expect_error(sim_pw_surv(fail_rate = fail_rate)) + expect_error(sim_pw_surv(dropout_rate = dropout_rate)) + # works as long as treatment names are consistent + expect_silent( + xy <- sim_pw_surv(block = block, fail_rate = fail_rate, dropout_rate = dropout_rate) + ) + expect_identical(sort(unique(xy$treatment)), c("x", "y")) +})