1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
library("matrixStats")
count_R <- function(x, value = TRUE, na.rm = FALSE, ...) {
if (is.na(value)) {
counts <- sum(is.na(x))
} else {
counts <- sum(x == value, na.rm = na.rm)
}
as.integer(counts)
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Data type: integer and numeric
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
for (mode in c("integer", "double")) {
x <- runif(20 * 5, min = -3, max = 3)
x[sample.int(length(x), size = 7)] <- 0
storage.mode(x) <- mode
for (na.rm in c(FALSE, TRUE)) {
# Count zeros
n0 <- count_R(x, value = 0, na.rm = na.rm)
n1 <- count(x, value = 0, na.rm = na.rm)
stopifnot(identical(n1, n0))
all <- allValue(x, value = 0, na.rm = na.rm)
any <- anyValue(x, value = 0, na.rm = na.rm)
# Count NAs
n0 <- count_R(x, value = NA, na.rm = na.rm)
n1 <- count(x, value = NA, na.rm = na.rm)
stopifnot(identical(n1, n0))
all <- allValue(x, value = NA, na.rm = na.rm)
any <- anyValue(x, value = NA, na.rm = na.rm)
if (mode == "integer") {
ux <- unique(as.vector(x))
n0 <- n1 <- integer(length(x))
for (value in ux) {
n0 <- n0 + count_R(x, value = value, na.rm = na.rm)
n1 <- n1 + count(x, value = value, na.rm = na.rm)
stopifnot(identical(n1, n0))
}
stopifnot(all(n0 == ncol(x)))
} # if (mode == "integer")
} # for (na.rm ...)
} # for (mode ...)
# All NAs
na_list <- list(NA_integer_, NA_real_, NaN)
for (na_value in na_list) {
x <- rep(na_value, times = 10L)
for (na.rm in c(FALSE, TRUE)) {
n0 <- count_R(x, na.rm = na.rm)
n1 <- count(x, na.rm = na.rm)
stopifnot(identical(n1, n0))
# Count NAs
n0 <- count_R(x, value = NA, na.rm = na.rm)
n1 <- count(x, value = NA, na.rm = na.rm)
stopifnot(identical(n1, n0))
any <- anyValue(x, value = NA, na.rm = na.rm)
all <- allValue(x, value = NA, na.rm = na.rm)
stopifnot(any)
stopifnot(all)
}
} # for (na_value ...)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Data type: logical
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
x <- logical(length = 10L)
x[3:7] <- TRUE
# Row/column counts
for (na.rm in c(FALSE, TRUE)) {
n0 <- count_R(x, na.rm = na.rm)
n1 <- count(x, na.rm = na.rm)
stopifnot(identical(n1, n0))
n_true <- count(x, value = TRUE, na.rm = na.rm)
n_false <- count(x, value = FALSE, na.rm = na.rm)
stopifnot(n_true + n_false == ncol(x))
# Count NAs
n0 <- count_R(x, value = NA, na.rm = na.rm)
n1 <- count(x, value = NA, na.rm = na.rm)
stopifnot(identical(n1, n0))
}
|
