R Under development (unstable) (2024-09-06 r87103 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library("matrixStats")
> library("stats")
> 
> asWhich <- function(probs, max) {
+   idx <- as.integer(round(probs * max))
+   if (idx < 1L) {
+     idx <- 1L
+   } else if (idx > max) {
+     idx <- max
+   }
+   idx
+ } # asWhich()
> 
> rowOrderStats_R <- function(x, probs, ..., useNames = NA) {
+   ans <- apply(x, MARGIN = 1L, FUN = quantile, probs = probs, type = 3L)
+   
+   # Remove Attributes
+   if (is.na(useNames) || !useNames || length(ans) == 0L) attributes(ans) <- NULL
+   ans
+ } # rowOrderStats_R()
> 
> 
> set.seed(1)
> 
> 
> # Simulate data in a matrix of any shape
> nrow <- 60L
> ncol <- 30L
> x <- rnorm(nrow * ncol)
> dim(x) <- c(nrow, ncol)
> probs <- 0.3
> which <- asWhich(probs, max = ncol)
> 
> y0 <- rowOrderStats_R(x, probs = probs)
> y1 <- rowOrderStats(x, which = which)
> stopifnot(all.equal(y1, y0))
> y2 <- colOrderStats(t(x), which = which)
> stopifnot(all.equal(y2, y0))
> 
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Consistency checks
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> for (mode in c("integer", "double")) {
+   cat("Consistency checks without NAs:\n")
+   for (kk in 1:3) {
+     cat("Random test #", kk, "\n", sep = "")
+ 
+     # Simulate data in a matrix of any shape
+     nrow <- sample(20L, size = 1L)
+     ncol <- sample(20L, size = 1L)
+     x <- rnorm(nrow * ncol)
+     dim(x) <- c(nrow, ncol)
+ 
+     cat("mode: ", mode, "\n", sep = "")
+     storage.mode(x) <- mode
+     str(x)
+ 
+     probs <- runif(1)
+     which <- asWhich(probs, max = ncol)
+ 
+     y0 <- rowOrderStats_R(x, probs = probs)
+     y1 <- rowOrderStats(x, which = which)
+     stopifnot(all.equal(y1, y0))
+     y2 <- colOrderStats(t(x), which = which)
+     stopifnot(all.equal(y2, y0))
+   } # for (kk in ...)
+ } # for (mode ...)
Consistency checks without NAs:
Random test #1
mode: integer
 int [1:14, 1:6] 0 0 1 0 2 -1 1 0 0 0 ...
Random test #2
mode: integer
 int [1:8, 1:13] 0 0 1 -2 0 0 0 0 1 0 ...
Random test #3
mode: integer
 int [1:20, 1:17] 0 0 0 0 1 0 1 0 0 -1 ...
Consistency checks without NAs:
Random test #1
mode: double
 num [1:9, 1:5] -1.4286 -0.00386 -0.70456 -0.29242 -0.49607 ...
Random test #2
mode: double
 num [1:11, 1:20] -0.796 0.482 -0.952 0.5 1.242 ...
Random test #3
mode: double
 num [1:7, 1:18] 1.553 -2.405 0.167 -0.403 -1.746 ...
> 
> 
> # Check names attribute
> x <- matrix(1:9 + 0.1, nrow = 3L, ncol = 3L)
> 
> probs <- runif(1)
> which <- asWhich(probs, max = ncol(x))
> 
> dimnames <- list(letters[1:3], LETTERS[1:3])
> 
> # Test with and without dimnames on x
> for (setDimnames in c(TRUE, FALSE)) {
+   if (setDimnames) dimnames(x) <- dimnames
+   else dimnames(x) <- NULL
+   # Check names attribute
+   for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) {
+     y0 <- rowOrderStats_R(x, probs = probs, useNames = useNames)
+     y1 <- rowOrderStats(x, which = which, useNames = useNames)
+     stopifnot(all.equal(y1, y0))
+     y2 <- colOrderStats(t(x), which = which, useNames = useNames)
+     stopifnot(all.equal(y2, y0))    
+   }
+ }
> 
> proc.time()
   user  system elapsed 
   0.31    0.06    0.37