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