support for n_permu > combo/permuteCount cases

Author: qddyy

R/auxiliary_funcs.R

@@ -39,15 +39,17 @@ 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((n_step <- n_possible) > n_sample)) {
+            n_step <- n_sample
         }
         assign(
-            "pb", ProgressBar$new(count),
+            "pb", ProgressBar$new(n_step),
             envir = environment(func)
         )
         body(func) <- as.call(c(
@@ -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)]
+        }
     }
 }
 

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