1library("matrixStats") 2 3rowCounts_R <- function(x, value = TRUE, na.rm = FALSE, ..., useNames = NA) { 4 if (is.na(value)) { 5 counts <- apply(x, MARGIN = 1L, FUN = function(x) 6 sum(is.na(x)) 7 ) 8 } else { 9 counts <- apply(x, MARGIN = 1L, FUN = function(x) 10 sum(x == value, na.rm = na.rm) 11 ) 12 } 13 # Preserve names attribute 14 names <- names(counts) 15 counts <- as.integer(counts) 16 if (isTRUE(useNames) && !is.null(names)) names(counts) <- names 17 counts 18} # rowCounts_R() 19 20 21# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 22# Subsetted tests 23# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 24source("utils/validateIndicesFramework.R") 25x <- matrix(runif(6 * 6, min = -3, max = 3), nrow = 6, ncol = 6) 26x[2:3, 3:4] <- NA_real_ 27storage.mode(x) <- "integer" 28 29# To check names attribute 30dimnames <- list(letters[1:6], LETTERS[1:6]) 31 32# Test with and without dimnames on x 33for (setDimnames in c(TRUE, FALSE)) { 34 if (setDimnames) dimnames(x) <- dimnames 35 else dimnames(x) <- NULL 36 for (rows in index_cases) { 37 for (cols in index_cases) { 38 # Check names attribute 39 for (useNames in c(NA, TRUE, FALSE)) { 40 validateIndicesTestMatrix(x, rows, cols, 41 ftest = rowCounts, fsure = rowCounts_R, 42 value = 0, na.rm = TRUE, useNames = useNames) 43 validateIndicesTestMatrix(x, rows, cols, 44 fcoltest = colCounts, fsure = rowCounts_R, 45 value = 0, na.rm = TRUE, useNames = useNames) 46 for (value in c(0, NA_integer_)) { 47 validateIndicesTestMatrix(x, rows, cols, 48 ftest = rowCounts, fsure = rowCounts_R, 49 value = value, useNames = useNames) 50 validateIndicesTestMatrix(x, rows, cols, 51 fcoltest = colCounts, fsure = rowCounts_R, 52 value = value, useNames = useNames) 53 } 54 } 55 } 56 } 57} 58 59x <- matrix(rep(letters, length.out = 6 * 6), nrow = 6, ncol = 6) 60x[2:3, 3:4] <- NA_character_ 61# Test with and without dimnames on x 62for (setDimnames in c(TRUE, FALSE)) { 63 if (setDimnames) dimnames(x) <- dimnames 64 else dimnames(x) <- NULL 65 for (rows in index_cases) { 66 for (cols in index_cases) { 67 # Check names attribute 68 for (useNames in c(NA, TRUE, FALSE)) { 69 validateIndicesTestMatrix(x, rows, cols, 70 ftest = rowCounts, fsure = rowCounts_R, 71 value = "g", na.rm = TRUE, useNames = useNames) 72 validateIndicesTestMatrix(x, rows, cols, 73 fcoltest = colCounts, fsure = rowCounts_R, 74 value = "g", na.rm = TRUE, useNames = useNames) 75 for (value in c("g", NA_character_)) { 76 validateIndicesTestMatrix(x, rows, cols, 77 ftest = rowCounts, fsure = rowCounts_R, 78 value = value, useNames = useNames) 79 validateIndicesTestMatrix(x, rows, cols, 80 fcoltest = colCounts, fsure = rowCounts_R, 81 value = value, useNames = useNames) 82 } 83 } 84 } 85 } 86} 87