1library("matrixStats") 2 3nrow <- 6L 4ncol <- 5L 5data <- matrix(0:4, nrow = nrow, ncol = ncol) 6 7# To check names attribute 8dimnames <- list(letters[1:6], LETTERS[1:5]) 9 10modes <- c("integer", "logical", "raw") 11for (mode in modes) { 12 cat(sprintf("Mode: %s...\n", mode)) 13 14 x <- data 15 if (mode == "logical") x <- x - 2L 16 if (mode != "raw") x[c(2,5,7)] <- NA_integer_ 17 storage.mode(x) <- mode 18 print(x) 19 20 unique_values <- unique(as.vector(x)) 21 nbr_of_unique_values <- length(unique_values) 22 23 y <- rowTabulates(x) 24 print(y) 25 stopifnot( 26 identical(dim(y), c(nrow, nbr_of_unique_values)), 27 all(y >= 0) 28 ) 29 if (mode != "raw") { 30 y0 <- t(table(x, row(x), useNA = "always")[, seq_len(nrow(x))]) 31 stopifnot(all(y == y0)) 32 } 33 # Check names attribute 34 dimnames(x) <- dimnames 35 y1 <- rowTabulates(x, useNames = FALSE) 36 y2 <- rowTabulates(x, useNames = NA) 37 stopifnot(all.equal(y1, y)) 38 stopifnot(all.equal(y2, y)) 39 y <- rowTabulates(x, useNames = TRUE) 40 stopifnot(identical(rownames(y), rownames(x))) 41 dimnames(x) <- NULL 42 43 y <- colTabulates(x) 44 print(y) 45 stopifnot( 46 identical(dim(y), c(ncol, nbr_of_unique_values)), 47 all(y >= 0) 48 ) 49 if (mode != "raw") { 50 y0 <- t(table(x, col(x), useNA = "always")[, seq_len(ncol(x))]) 51 stopifnot(all(y == y0)) 52 } 53 # Check names attribute 54 dimnames(x) <- dimnames 55 y1 <- colTabulates(x, useNames = FALSE) 56 y2 <- colTabulates(x, useNames = NA) 57 stopifnot(all.equal(y1, y)) 58 stopifnot(all.equal(y2, y)) 59 y <- colTabulates(x, useNames = TRUE) 60 stopifnot(identical(rownames(y), colnames(x))) 61 dimnames(x) <- NULL 62 63 # Count only certain values 64 if (mode == "integer") { 65 subset <- c(0:2, NA_integer_) 66 } else if (mode == "logical") { 67 subset <- c(TRUE, FALSE, NA) 68 } else { 69 subset <- c(0:2) 70 } 71 y <- rowTabulates(x, values = subset) 72 print(y) 73 stopifnot(identical(dim(y), c(nrow, length(subset)))) 74 # Check names attribute 75 dimnames(x) <- dimnames 76 y1 <- rowTabulates(x, values = subset, useNames = FALSE) 77 y2 <- rowTabulates(x, values = subset, useNames = NA) 78 stopifnot(all.equal(y1, y)) 79 stopifnot(all.equal(y2, y)) 80 y <- rowTabulates(x, values = subset, useNames = TRUE) 81 stopifnot(identical(rownames(y), rownames(x))) 82 dimnames(x) <- NULL 83 84 y <- colTabulates(x, values = subset) 85 print(y) 86 stopifnot(identical(dim(y), c(ncol, length(subset)))) 87 # Check names attribute 88 dimnames(x) <- dimnames 89 y1 <- colTabulates(x, values = subset, useNames = FALSE) 90 y2 <- colTabulates(x, values = subset, useNames = NA) 91 stopifnot(all.equal(y1, y)) 92 stopifnot(all.equal(y2, y)) 93 y <- colTabulates(x, values = subset, useNames = TRUE) 94 stopifnot(identical(rownames(y), colnames(x))) 95 dimnames(x) <- NULL 96 97 # Raw 98 if (mode %in% c("integer", "raw")) { 99 subset <- c(0:2) 100 101 y <- rowTabulates(x, values = as.raw(subset)) 102 print(y) 103 stopifnot(identical(dim(y), c(nrow, length(subset)))) 104 # Check names attribute 105 dimnames(x) <- dimnames 106 y1 <- rowTabulates(x, values = as.raw(subset), useNames = FALSE) 107 y2 <- rowTabulates(x, values = as.raw(subset), useNames = NA) 108 stopifnot(all.equal(y1, y)) 109 stopifnot(all.equal(y2, y)) 110 y3 <- rowTabulates(x, values = as.raw(subset), useNames = TRUE) 111 stopifnot(identical(rownames(y3), rownames(x))) 112 dimnames(x) <- NULL 113 114 y2 <- colTabulates(t(x), values = as.raw(subset)) 115 print(y2) 116 stopifnot( 117 identical(dim(y2), c(nrow, length(subset))), 118 identical(y2, y) 119 ) 120 # Check names attribute 121 dimnames(x) <- dimnames 122 y1 <- colTabulates(t(x), values = as.raw(subset), useNames = FALSE) 123 y2 <- colTabulates(t(x), values = as.raw(subset), useNames = NA) 124 stopifnot(all.equal(y1, y)) 125 stopifnot(all.equal(y2, y)) 126 y <- colTabulates(t(x), values = as.raw(subset), useNames = TRUE) 127 stopifnot(identical(rownames(y), colnames(t(x)))) 128 dimnames(x) <- NULL 129 } 130 131 cat(sprintf("Mode: %s...done\n", mode)) 132} # for (mode ...) 133