R Under development (unstable) (2023-12-09 r85665 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 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") > > signTabulate0 <- function(x, ...) { + nneg <- sum(x < 0, na.rm = TRUE) + nzero <- sum(x == 0, na.rm = TRUE) + npos <- sum(x > 0, na.rm = TRUE) + nna <- sum(is.na(x)) + nneginf <- sum(is.infinite(x) & x < 0, na.rm = TRUE) + nposinf <- sum(is.infinite(x) & x > 0, na.rm = TRUE) + res <- c(nneg, nzero, npos, nna, nneginf, nposinf) + res <- as.double(res) + names(res) <- c("-1", "0", "+1", "NA", "-Inf", "+Inf") + if (is.integer(x)) res <- res[1:4] + res + } # signTabulate0() > > > # Simulate data > set.seed(0xBEEF) > n <- 100L > x <- runif(n) > x[sample(n, size = 0.1 * n)] <- 0 > x[sample(n, size = 0.1 * n)] <- NA_real_ > x[sample(n, size = 0.1 * n)] <- -Inf > x[sample(n, size = 0.1 * n)] <- +Inf > > # Doubles > message("Doubles:") Doubles: > counts0 <- signTabulate0(x) > print(counts0) -1 0 +1 NA -Inf +Inf 9 7 77 7 9 10 > counts1 <- signTabulate(x) > print(counts1) -1 0 +1 NA -Inf +Inf 9 7 77 7 9 10 > stopifnot(identical(counts1, counts0)) > > # Integers > message("Integers:") Integers: > x <- suppressWarnings(as.integer(x)) > counts0 <- signTabulate0(x) > print(counts0) -1 0 +1 NA 0 74 0 26 > counts1 <- signTabulate(x) > print(counts1) -1 0 +1 NA 0 74 0 26 > stopifnot(identical(counts1, counts0)) > > proc.time() user system elapsed 0.12 0.06 0.17