support for n_permu > combo/permuteCount cases

qddyy · Sep 14, 2023 · 473302b · 473302b
1 parent 10f3d9a
commit 473302b
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 6 deletions.
diff --git a/R/auxiliary_funcs.R b/R/auxiliary_funcs.R
@@ -39,12 +39,14 @@ get_arrangement <- function(
 
     args <- list(v = v, m = m, repetition = replace)
 
+    n_possible <- do.call(paste0(which, "Count"), args)
+
     if (!isFALSE(progress)) {
         progress <- interactive()
     }
     if (progress) {
-        if (is.null(count <- n_sample)) {
-            count <- do.call(paste0(which, "Count"), args)
+        if (isTRUE((count <- n_possible) > n_sample)) {
+            count <- n_sample
         }
         assign(
             "pb", ProgressBar$new(count),
@@ -59,12 +61,15 @@ get_arrangement <- function(
 
     args <- c(args, list(FUN = func, FUN.VALUE = func_value))
 
-    if (is.null(n_sample)) {
-        do.call(paste0(which, "General"), args)
-    } else {
+    if (isTRUE(n_sample < n_possible)) {
         args$n <- n_sample
         args$seed <- getOption("pmt_seed")
         do.call(paste0(which, "Sample"), args)
+    } else {
+        possible <- do.call(paste0(which, "General"), args)
+        if (is.null(n_sample)) possible else {
+            possible[sample.int(n_possible, n_sample, replace = TRUE)]
+        }
     }
 }
 

diff --git a/vignettes/examples.Rmd b/vignettes/examples.Rmd
@@ -211,7 +211,7 @@ t$p_value
 ```{r}
 # See ?KolmogorovSmirnov or ?twosample.ks
 t <- pmt(
-    "twosample.ks"
+    "twosample.ks", n_permu <- 5000
 )
 
 # See ?Table2.8.1
@@ -362,6 +362,9 @@ t$feed(Table4.1.1)
 
 t$statistic
 t$p_value
+
+t$n_permu <- 4000
+t$p_value
 ```
 
 ## Example 4.1.1
@@ -401,6 +404,9 @@ t$feed(Table4.1.1)
 t$statistic
 t$p_value
 
+t$n_permu <- 4000
+t$p_value
+
 t$type <- "approx"
 t$p_value
 ```
@@ -421,6 +427,9 @@ t$feed(data.frame(
 
 t$statistic
 t$p_value
+
+t$n_permu <- 4000
+t$p_value
 ```
 
 ## Example 4.3.1