3.0.1 fix bug in restriction (#11)

bozenne · Sep 28, 2023 · 99a7ed4 · 99a7ed4
1 parent 6344f33
commit 99a7ed4
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 6 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: BuyseTest
 Type: Package
 Title: Generalized Pairwise Comparisons
-Version: 3.0.0
-Date: 2023-09-27
+Version: 3.0.1
+Date: 2023-09-28
 Authors@R: c(
     person("Brice", "Ozenne", role = c("aut", "cre"), email = "brice.mh.ozenne@gmail.com", comment = c(ORCID = "0000-0001-9694-2956")),
     person("Julien", "Peron", role = "ctb"),

diff --git a/NEWS b/NEWS
@@ -15,6 +15,7 @@
   specific seeds. Results are now identical whether one or more CPUs
   are used, and reproducible when multiple CPUs are used.
 - add some support for paired data via strata argument in BuyseTest
+- fix bug when using restriction with multiple endpoints (#11)
 
 ** Internal change
 - more uniform effect of the strata argument

diff --git a/R/BuyseTest.R b/R/BuyseTest.R
@@ -548,15 +548,16 @@ BuyseTest <- function(formula,
                                    which(duplicated(envir$outArgs$index.endpoint))) ## not already visitied
         for(iE in index.rendpoint){ ## iE <- 1
             iRestriction <- envir$outArgs$restriction[iE]
+            iStatus <- envir$outArgs$index.status[iE]+1
 
             if(envir$outArgs$operator[iE]==1){ ## ">0"
                 if(envir$outArgs$method.score[iE] %in% c("TTEgehan","SurvPeron","CRPeron")){ ## right censoring
-                    envir$outArgs$M.status[envir$outArgs$M.endpoint[,iE]>iRestriction,iE] <- 1/2
+                    envir$outArgs$M.status[envir$outArgs$M.endpoint[,iE]>iRestriction,iStatus] <- 1/2
                 }
                 envir$outArgs$M.endpoint[envir$outArgs$M.endpoint[,iE]>iRestriction,iE] <- iRestriction
             }else if(envir$outArgs$operator[iE]==-1){ ## "<0"
                 if(envir$outArgs$method.score[iE] %in% c("TTEgehan2")){ ## left censoring
-                    envir$outArgs$M.status[envir$outArgs$M.endpoint[,iE]<iRestriction,iE] <- 1/2
+                    envir$outArgs$M.status[envir$outArgs$M.endpoint[,iE]<iRestriction,iStatus] <- 1/2
                 }
                 envir$outArgs$M.endpoint[envir$outArgs$M.endpoint[,iE]<iRestriction,iE] <- iRestriction
             }

diff --git a/tests/testthat/test-BuyseTest-previousBug.R b/tests/testthat/test-BuyseTest-previousBug.R
@@ -3,9 +3,9 @@
 ## Author: Brice Ozenne
 ## Created: apr 17 2018 (16:46) 
 ## Version: 
-## Last-Updated: jul 17 2023 (17:07) 
+## Last-Updated: sep 28 2023 (14:52) 
 ##           By: Brice Ozenne
-##     Update #: 222
+##     Update #: 231
 ##----------------------------------------------------------------------
 ## 
 ### Commentary: 
@@ -20,6 +20,7 @@ if(FALSE){
     library(BuyseTest)
     library(data.table)
     library(survival)
+    library(prodlim)
 }
 
 context("Check that bugs that have been reported are fixed \n")
@@ -600,6 +601,41 @@ test_that("number of pairs with add.halfNeutral",{
     expect_equal(100,model.tables(BT)$total, tol = 0.0001)
 })
 
+## * SamSalvaggio: (issue #2 on Github): 27 september 2023 restriction with multiple endpoint
+test_that("restriction with multiple endpoints",{
+
+    set.seed(1)
+    dt <- simBuyseTest(n.T = 50, n.C = 50,
+                       names.strata = "strat_column", n.strata = 2,
+                       argsTTE = list(name = c("tte1"), 
+                                      name.censoring = c("cnsr1"),
+                                      scale.T = c(200), scale.censoring.T = c(10^5),
+                                      scale.C = c(200), scale.censoring.C = c(10^5)),
+                       argsBin = list(p.T = list(c(0.4,0.6))),
+                       argsCont = list(mu.T = c(0.3), sigma.T = 1)
+                       )
+
+    formula1 <- treatment ~ strat_column +
+        bin(toxicity, operator = "<0") +
+        cont(score, threshold = 0.5) +
+        tte(tte1, status = cnsr1, threshold = 10, restriction = 365)
+
+    GPC <- BuyseTest(formula1,
+                     data = dt,
+                     trace = FALSE,
+                     method.inference = "u-statistic")
+
+    test <- confint(GPC)
+    rownames(test) <- NULL
+    GS <- data.frame("estimate" = c(-0.04265403, -0.00552923, -0.00592417), 
+                     "se" = c(0.09983531, 0.1159374, 0.11753888), 
+                     "lower.ci" = c(-0.2342771, -0.22865458, -0.23200199), 
+                     "upper.ci" = c(0.15215946, 0.21814805, 0.22076088), 
+                     "null" = c(0, 0, 0), 
+                     "p.value" = c(0.66957926, 0.9619629, 0.95980315))
+
+    expect_equivalent(test,GS,tol = 1e-6)
+})