... add warning, method.inference rm - ...

bozenne · Jun 19, 2024 · 114e7af · 114e7af
1 parent 77c9a3c
commit 114e7af
Show file tree

Hide file tree

Showing 14 changed files with 65 additions and 63 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: BuyseTest
 Type: Package
 Title: Generalized Pairwise Comparisons
 Version: 3.0.4
-Date: 2024-06-18
+Date: 2024-06-19
 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/R/BuyseTest-check.R b/R/BuyseTest-check.R
@@ -3,9 +3,9 @@
 ## Author: Brice Ozenne
 ## Created: apr 27 2018 (23:32) 
 ## Version: 
-## Last-Updated: jun 18 2024 (18:36) 
+## Last-Updated: jun 19 2024 (12:17) 
 ##           By: Brice Ozenne
-##     Update #: 353
+##     Update #: 357
 ##----------------------------------------------------------------------
 ## 
 ### Commentary: 
@@ -353,13 +353,14 @@ testArgs <- function(name.call,
     if(length(method.inference)!=1){
         stop("Argument \'method.inference\' must have length 1. \n")
     }
-    if(method.inference %in% c("u-statistic-bebu","varexact-permutation") == FALSE){ ## asympototic bebu and varexact-permutation - hidden value only for debugging
+    if(method.inference %in% c("u statistic bebu","varexact permutation") == FALSE){ ## asympototic bebu and varexact-permutation - hidden value only for debugging
         validCharacter(method.inference,
                        valid.length = 1,
-                       valid.values = c("none","u-statistic","permutation","studentized permutation","bootstrap","studentized bootstrap"),
+                       valid.values = c("none","u statistic","permutation","studentized permutation","bootstrap","studentized bootstrap"),
                        method = "BuyseTest")
     }
-    if(pool.strata>3 && method.inference %in% c("u-statistic","studentized permutation","studentized bootstrap")){
+
+    if(pool.strata>3 && method.inference %in% c("u statistic","varexact permutation","studentized permutation","studentized bootstrap")){
         stop("Only bootstrap and permutation can be used to quantify uncertainty when weighting strata-specific effects by the inverse of the variance. \n")
     }
     if(method.inference != "none" && any(table(data[[treatment]])<2) ){

diff --git a/R/BuyseTest-initialization.R b/R/BuyseTest-initialization.R
@@ -280,17 +280,17 @@ initializeArgs <- function(status,
     }
 
     ## ** method.inference
-    method.inference <- tolower(method.inference)    
+    method.inference <- gsub("-"," ",tolower(method.inference),fixed = TRUE)
     attr(method.inference,"permutation") <- grepl("permutation",method.inference)
     attr(method.inference,"bootstrap") <- grepl("bootstrap",method.inference)
     attr(method.inference,"studentized") <- grepl("studentized",method.inference)
-    attr(method.inference,"ustatistic") <- grepl("u-statistic",method.inference)
+    attr(method.inference,"ustatistic") <- grepl("u statistic",method.inference)
     if(is.na(strata.resampling) || length(strata.resampling)== 0){
         attr(method.inference,"resampling-strata") <- as.character(NA)
     }else{
         attr(method.inference,"resampling-strata") <- strata.resampling
     }
-    if(method.inference == "varexact-permutation"){
+    if(method.inference == "varexact permutation"){
         n.resampling <- Inf
     }
 
@@ -324,7 +324,7 @@ initializeArgs <- function(status,
     }
 
     ## ** iid
-    iid <- attr(method.inference,"studentized") || (method.inference == "u-statistic")
+    iid <- attr(method.inference,"studentized") || (method.inference == "u statistic")
     if(iid){
         attr(method.inference,"hprojection") <- option$order.Hprojection
     }else{

diff --git a/R/BuyseTest-print.R b/R/BuyseTest-print.R
@@ -154,7 +154,7 @@ printInference <- function(method.inference, n.resampling, cpus, seed, ...){
             txt.type <- "moments of the U-statistic"
         }else if(attr(method.inference,"bootstrap")){
             txt.type <- paste0("non-parametric bootstrap with ",n.resampling," samples")
-        }else if(method.inference == "varexact-permutation"){
+        }else if(method.inference == "varexact permutation"){
             txt.type <- paste0("permutation test with all possible permutations")
         }else if(attr(method.inference,"permutation")){
             txt.type <- paste0("permutation test with ",n.resampling," permutations")

diff --git a/R/BuyseTest.R b/R/BuyseTest.R
@@ -441,9 +441,9 @@ BuyseTest <- function(formula,
     }
 
     outResampling <- NULL
-    if(outArgs$method.inference == "u-statistic"){
+    if(outArgs$method.inference == "u statistic"){
         ## done in the C++ code        
-    }else if(outArgs$method.inference == "u-statistic-bebu"){
+    }else if(outArgs$method.inference == "u statistic bebu"){
         if(outArgs$keep.pairScore == FALSE){
             stop("Argument \'keep.pairScore\' needs to be TRUE when argument \'method.inference\' is \"u-statistic-bebu\" \n")
         }
@@ -461,7 +461,7 @@ BuyseTest <- function(formula,
 
         outPoint$covariance <- outCovariance$Sigma
         attr(outArgs$method.inference,"Hprojection") <- option$order.Hprojection
-    }else if(outArgs$method.inference == "varexact-permutation"){
+    }else if(outArgs$method.inference == "varexact permutation"){
 
         if(!is.null(outArgs$weightObs) && any(abs(outArgs$weightObs-1)>1e-10)){
             warning("Argument \'weightObs\' is being ignored when computing the exact permutation variance. \n")
@@ -670,7 +670,7 @@ calcSample <- function(envir, method.inference){
         data = data.table::data.table()
     )
 
-    if(method.inference %in% c("none","u-statistic")){
+    if(method.inference %in% c("none","u statistic")){
 
         ## ** no resampling
         if(envir$outArgs$n.strata==1){        

diff --git a/R/CasinoTest.R b/R/CasinoTest.R
@@ -3,9 +3,9 @@
 ## Author: Brice Ozenne
 ## Created: mar 22 2023 (15:15) 
 ## Version: 
-## Last-Updated: jul 18 2023 (12:06) 
+## Last-Updated: jun 19 2024 (12:23) 
 ##           By: Brice Ozenne
-##     Update #: 111
+##     Update #: 114
 ##----------------------------------------------------------------------
 ## 
 ### Commentary: 
@@ -129,9 +129,9 @@ CasinoTest <- function(formula, data, type = "unweighted", add.halfNeutral = NUL
     }
     data <- as.data.frame(data)
     data$XXindexXX <- 1:NROW(data)
-    method.inference <- match.arg(method.inference, c("none","u-statistic","rank"))
+    method.inference <- match.arg(gsub("-"," ",tolower(method.inference), fixed = TRUE), c("none","u statistic","rank"))
     if(method.inference=="rank"){
-        method.inference <- "u-statistic"
+        method.inference <- "u statistic"
         ssc <- TRUE
     }else{
         ssc <- FALSE
@@ -172,7 +172,7 @@ CasinoTest <- function(formula, data, type = "unweighted", add.halfNeutral = NUL
     ## prepare to store output
     M.estimate <- matrix(NA, nrow = n.treatment, ncol = n.treatment,
                          dimnames = list(level.treatment, level.treatment))
-    if(method.inference == "u-statistic"){
+    if(method.inference == "u statistic"){
         M.iid <- array(0, dim = c(n.obs,n.treatment,n.treatment),
                        dimnames = list(NULL, level.treatment, level.treatment))
     }else{
@@ -201,7 +201,7 @@ CasinoTest <- function(formula, data, type = "unweighted", add.halfNeutral = NUL
         }
 
         ## store iid
-        if(method.inference == "u-statistic"){
+        if(method.inference == "u statistic"){
             if(iTreat1==iTreat2){
                 iIndex <- unique(sort(iData$XXindexXX))
                 M.iid[iIndex,iTreat1,iTreat1] <- getIid(grid.BT[[iGrid]], statistic = "favorable", scale = FALSE, center = TRUE, cluster = iData$XXindexXX)/n.group[iTreat1]
@@ -289,7 +289,7 @@ CasinoTest <- function(formula, data, type = "unweighted", add.halfNeutral = NUL
 
 
 ## alternative implementation 
-##     if(method.inference == "u-statistic"){
+##     if(method.inference == "u statistic"){
 ##         if(iTreat1==iTreat2){
 ##             iIndex <- unique(sort(iData$XXindexXX))
 ##             M.iid[iIndex,iTreat1,iTreat1] <- getIid(grid.BT[[iGrid]], statistic = "favorable", scale = FALSE, center = FALSE, cluster = iData$XXindexXX)

diff --git a/R/S4-BuysePower-model.tables.R b/R/S4-BuysePower-model.tables.R
@@ -3,9 +3,9 @@
 ## Author: Brice Ozenne
 ## Created: jun 27 2023 (14:29) 
 ## Version: 
-## Last-Updated: Jul  3 2023 (10:53) 
+## Last-Updated: jun 19 2024 (12:19) 
 ##           By: Brice Ozenne
-##     Update #: 46
+##     Update #: 47
 ##----------------------------------------------------------------------
 ## 
 ### Commentary: 
@@ -155,7 +155,7 @@ setMethod(f = "model.tables",
               }
 
               ## ** export
-              if(method.inference == "u-statistic"){                          
+              if(method.inference == "u statistic"){                          
                   if(transformation){
                       attr(dtS.res,"transformation") <- stats::setNames(dt.res[index.subset,.SD$transformation],dt.res[index.subset,.SD$statistic])[!duplicated(dt.res[index.subset,.SD$transformation])]
                   }

diff --git a/R/S4-BuyseTest-confint.R b/R/S4-BuyseTest-confint.R
@@ -4,7 +4,7 @@
 ## Created: maj 19 2018 (23:37) 
 ## Version: 
 ##           By: Brice Ozenne
-##     Update #: 1216
+##     Update #: 1224
 ##----------------------------------------------------------------------
 ## 
 ### Commentary: 
@@ -199,7 +199,7 @@ setMethod(f = "confint",
               ## method.ci
               if(attr(method.inference,"permutation") || attr(method.inference,"bootstrap")){
                   if(is.null(method.ci.resampling)){
-                      if(method.inference == "varexact-permutation"){
+                      if(method.inference == "varexact permutation"){
                           method.ci.resampling <- "gaussian"
                       }else if(attr(method.inference,"studentized")){
                           method.ci.resampling <- "studentized"
@@ -216,8 +216,8 @@ setMethod(f = "confint",
                                  refuse.NULL = FALSE,                             
                                  method = "confint[S4BuyseTest]")
 
-                  if(method.ci.resampling != "gaussian" && method.inference == "varexact-permutation"){
-                      stop("Argument \'method.ci.resampling\' must be set to \'gaussian\' if argument \'method.inference\' has been set to \"varexact-permutation\" when calling BuyseTest. \n")
+                  if(method.ci.resampling != "gaussian" && method.inference == "varexact permutation"){
+                      stop("Argument \'method.ci.resampling\' must be set to \'gaussian\' if argument \'method.inference\' has been set to \"varexact permutation\" when calling BuyseTest. \n")
                   }
                   if(method.ci.resampling == "studentized" && !attr(method.inference,"studentized")){
                       stop("Argument \'method.ci.resampling\' cannot be set to \'studentized\' unless a studentized bootstrap/permutation has been performed.\n",
@@ -230,15 +230,15 @@ setMethod(f = "confint",
                            "or set \'method.inference\' to \"studentized bootstrap\" or \"studentized permutation\" when calling BuyseTest. \n")
                   }
                   if(is.null(transformation)){
-                      if(method.ci.resampling=="percentile" || method.inference == "varexact-permutation"){
+                      if(method.ci.resampling=="percentile" || method.inference == "varexact permutation"){
                           transformation <- FALSE ## ensures consistency between p-values for different statistics as transformation may lead to numerical unaccuracies when comparing resampling to observed
                       }else{
                           transformation <- option$transformation
                       }
-                  }else if(transformation && method.inference == "varexact-permutation"){
+                  }else if(transformation && method.inference == "varexact permutation"){
                       transformation <- FALSE
                       message("Argument \'transformation\' has been set to FALSE. \n",
-                              "Transformation is not available if argument \'method.inference\' has been set to \"varexact-permutation\" when calling BuyseTest. \n")
+                              "Transformation is not available if argument \'method.inference\' has been set to \"varexact permutation\" when calling BuyseTest. \n")
                   }              
               }else{
                   if(is.null(transformation)){
@@ -322,7 +322,7 @@ setMethod(f = "confint",
 
               ## safety
               test.model.tte <- all(unlist(lapply(object@iidNuisance,dim))==0)
-              if(method.inference %in% c("u-statistic","u-statistic-bebu") && object@correction.uninf > 0){
+              if(method.inference %in% c("u statistic","u statistic bebu") && object@correction.uninf > 0){
                   warning("The current implementation of the asymptotic distribution is not valid when using a correction. \n",
                           "Standard errors / confidence intervals / p-values may not be correct. \n",
                           "Consider using a resampling approach or checking the control of the type 1 error with powerBuyseTest. \n")
@@ -344,7 +344,7 @@ setMethod(f = "confint",
                   Delta <- stats::setNames(DeltaL$statistic, paste(DeltaL$time, DeltaL$strata, sep = sep))
               }
 
-              if(((attr(method.inference,"permutation") && method.inference != "varexact-permutation")) || attr(method.inference,"bootstrap")){
+              if(((attr(method.inference,"permutation") && method.inference != "varexact permutation")) || attr(method.inference,"bootstrap")){
                   DeltaW.resampling <- coef(object, endpoint = endpoint, statistic = statistic, strata = strata, cumulative = cumulative, resampling = TRUE, simplify = FALSE)
                   if(length(strata)==1 && all(strata=="global")){
                       Delta.resampling <- matrix(DeltaW.resampling[,"global",], ncol = length(endpoint), dimnames = list(NULL, endpoint))
@@ -394,7 +394,7 @@ setMethod(f = "confint",
                       message("BuyseTest: argument \'cluster\' ignored when evaluating uncertainty with resampling methods. \n")
                   }
 
-                  if(method.inference == "varexact-permutation"){
+                  if(method.inference == "varexact permutation"){
                       if(statistic == "winRatio"){
                           stop("BuyseTest: cannot evaluate the exact variance of the permutation distribution for the win ratio. \n",
                                "Consider using the net benefit instead (argument statistic = \"netBenefit\"). \n")
@@ -437,7 +437,7 @@ setMethod(f = "confint",
               if(method.inference == "none"){
                   method.confint <- confint_none
                   transformation <- FALSE
-              }else if(method.inference == "varexact-permutation"){
+              }else if(method.inference == "varexact permutation"){
                   method.confint <- confint_varexactPermutation
               }else if(attr(method.inference,"ustatistic")){
                   method.confint <- confint_Ustatistic
@@ -605,7 +605,7 @@ setMethod(f = "confint",
               outConfint <- as.data.frame(outConfint)
 
               ## ** number of permutations
-              if(method.inference != "none" && ((attr(method.inference,"permutation") && (method.inference!="varexact-permutation")) || attr(method.inference,"bootstrap"))){
+              if(method.inference != "none" && ((attr(method.inference,"permutation") && (method.inference!="varexact permutation")) || attr(method.inference,"bootstrap"))){
                   attr(outConfint, "n.resampling")  <- colSums(!is.na(Delta.resampling))
               }else{
                   attr(outConfint, "n.resampling")  <- stats::setNames(rep(as.numeric(NA), D), all.endpoint)

diff --git a/R/S4-BuyseTest-get.R b/R/S4-BuyseTest-get.R
@@ -98,7 +98,7 @@ setMethod(f = "getIid",
               n.obs <- NROW(object@iidAverage$favorable)
 
               ## iid has been stored in object
-              if(object@method.inference != "u-statistic"){
+              if(object@method.inference != "u statistic"){
                   stop("No H-decomposition in the object \n",
                        "Set the argument \'method.inference\' to \"u-statistic\" when calling BuyseTest \n")
               }
@@ -178,9 +178,9 @@ setMethod(f = "getIid",
               indexT <- attr(object@level.treatment,"indexT")
 
               ## type
-              validCharacter(type,
+              validCharacter(gsub("-"," ",tolower(type), fixed = TRUE),
                              valid.length = 1,
-                             valid.values = c("all","nuisance","u-statistic"),
+                             valid.values = c("all","nuisance","u statistic"),
                              refuse.NULL = FALSE)
 
 
@@ -208,7 +208,7 @@ setMethod(f = "getIid",
               ## }
 
               ## ** extract H-decomposition
-              if(type %in% c("all","u-statistic")){
+              if(type %in% c("all","u statistic")){
                   object.iid <- object@iidAverage[c("favorable","unfavorable")]
               }else{
                   object.iid <- list(favorable = matrix(0, nrow = n.obs, ncol = n.endpoint,

diff --git a/R/S4-BuyseTest-sensitivity.R b/R/S4-BuyseTest-sensitivity.R
@@ -3,9 +3,9 @@
 ## Author: Brice Ozenne
 ## Created: mar 31 2021 (14:07) 
 ## Version: 
-## Last-Updated: okt  3 2023 (19:06) 
+## Last-Updated: jun 19 2024 (12:22) 
 ##           By: Brice Ozenne
-##     Update #: 346
+##     Update #: 347
 ##----------------------------------------------------------------------
 ## 
 ### Commentary: 
@@ -89,7 +89,7 @@ setMethod(f = "sensitivity",
 
               ## ** normalize user input
               ## band
-              if(object@method.inference!="u-statistic"){
+              if(object@method.inference!="u statistic"){
                   stop("Cannot compute confidence bands when \'method.inference\' used to obtain the object is not \"u-statistic\". \n")
               }
 
@@ -226,7 +226,7 @@ setMethod(f = "sensitivity",
 
                       iConfint <- confint(iBT, statistic = statistic, null = null, conf.level = conf.level, alternative = alternative, transformation = transformation)[n.endpoint,]
                       ls.confint[[iSe]] <- data.frame(c(gridRed.threshold[iSe,,drop=FALSE], iConfint))
-                      if(iBT@method.inference=="u-statistic"){
+                      if(iBT@method.inference=="u statistic"){
                           ls.iid[[iSe]] <- getIid(iBT, statistic = statistic,simplify=FALSE)$global[,n.endpoint]
                       }
                   }
@@ -257,7 +257,7 @@ setMethod(f = "sensitivity",
 
                                                      iConfint <- confint(iBT, statistic = statistic, null = null, conf.level = conf.level, alternative = alternative, transformation = transformation)[n.endpoint,]
                                                      iOut <- list(confint = data.frame(c(gridRed.threshold[i,,drop=FALSE], iConfint)))
-                                                     if(iBT@method.inference=="u-statistic"){
+                                                     if(iBT@method.inference=="u statistic"){
                                                          iOut[["iid"]] <- getIid(iBT, statistic = statistic)[,n.endpoint]
                                                      }
                                                      return(iOut)
@@ -267,13 +267,13 @@ setMethod(f = "sensitivity",
                   if(trace>0){close(pb)}
 
                   ls.confint <- lapply(ls.sensitivity,"[[","confint")
-                  if(object@method.inference=="u-statistic"){
+                  if(object@method.inference=="u statistic"){
                       ls.iid <- lapply(ls.sensitivity,"[[","iid")
                   }
               }
 
               df.confint <- as.data.frame(do.call(rbind,ls.confint))
-              if(object@method.inference=="u-statistic"){
+              if(object@method.inference=="u statistic"){
                   attr(df.confint, "iid") <- do.call(cbind,ls.iid)
               }