/
modeOf.R
120 lines (106 loc) · 4.42 KB
/
modeOf.R
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
# modeOf() returns the sample mode: the value that has highest observed frequency
#' Sample mode
#'
#' @description Calculate the mode of a sample: both modal value(s) and
#' the corresponding frequency
#'
#' @param x A vector containing the observations.
#' @param na.rm Logical value indicating whether NA values should be removed.
#'
#' @details These two functions can be used to calculate the mode (most
#' frequently observed value) of a sample, and the actual frequency of the
#' modal value. The only complication is in respect to missing data. If
#' \code{na.rm = FALSE}, then there are multiple possibilities for how to
#' calculate the mode. One possibility is to treat \code{NA} as another
#' possible value for the elements of \code{x}, and therefore if \code{NA}
#' is more frequent than any other value, then \code{NA} is the mode; and
#' the modal frequency is equal to the number of missing values. This is
#' the version that is currently implemented.
#'
#' Another possibility is to treat \code{NA} as meaning "true value unknown",
#' and to the mode of \code{x} is itself known only if the number of missing
#' values is small enough that -- regardless of what value they have -- they
#' cannot alter the sample mode. For instance, if \code{x} were
#' \code{c(1,1,1,1,2,2,NA)}, we know that the mode of \code{x} is \code{1}
#' regardless of what the true value is for the one missing datum; and we
#' know that the modal frequency is between 4 and 5. This is also a valid
#' interpretation, depending on what precisely it is the user wants, but
#' is not currently implemented.
#'
#' Because of the ambiguity of how \code{na.rm = FALSE} should be interpreted,
#' the default value has been set to \code{na.rm = TRUE}, which differs from
#' the default value used elsewhere in the package.
#'
#' @return The \code{modeOf} function returns the mode of \code{x}. If there
#' are ties, it returns a vector containing all values of \code{x} that have
#' the modal frequency. The \code{maxFreq} function returns the modal
#' frequency as a numeric value.
#'
#' @name mode
#'
#' @seealso
#' \code{\link{mean}},
#' \code{\link{median}},
#' \code{\link{table}}
#'
#' @examples
#' # simple example
#' eyes <- c("green","green","brown","brown","blue")
#' modeOf(eyes)
#' maxFreq(eyes)
#'
#' # vector with missing data
#' eyes <- c("green","green","brown","brown","blue",NA,NA,NA)
#'
#' # returns NA as the modal value.
#' modeOf(eyes, na.rm = FALSE)
#' maxFreq(eyes, na.rm = FALSE)
#'
#' # returns c("green", "brown") as the modes, as before
#' modeOf(eyes, na.rm = TRUE)
#' maxFreq(eyes, na.rm = TRUE)
NULL
#' @rdname mode
#' @export
modeOf <- function(x, na.rm = TRUE) {
if( !is.vector(x) & !is.factor(x) ) {
stop( '"x" must be a vector or a factor')
}
if( !methods::is(na.rm,"logical") | length(na.rm) !=1 ) {
stop( '"na.rm" must be a single logical value')
}
na.freq <- 0
if (na.rm == FALSE) { na.freq <- sum( is.na(x) ) } # count the NAs if needed
x <- x[!is.na(x)] # delete NAs
obs.val <- unique(x) # find unique values
valFreq <- function(x, y){ sum(y == x) }
freq <- unlist((lapply( obs.val, valFreq, x ))) # apply for all unique values
max.freq <- max(freq) # modal frequency
if (na.rm == FALSE & na.freq > max.freq) {
modal.values <- NA # mode is NA if appropriate...
} else {
modal.cases <- freq == max.freq # otherwise find modal cases
modal.values <- obs.val[modal.cases] # and corresponding values
}
if(class(x)=="factor") modal.values <- as.character(modal.values)
return( modal.values )
}
# maxFreq() returns the frequency of the sample mode.
#' @rdname mode
#' @export
maxFreq <- function(x, na.rm = TRUE) {
if( !is.vector(x) & !is.factor(x) ) {
stop( '"x" must be a vector or a factor')
}
if( !methods::is(na.rm,"logical") | length(na.rm) !=1 ) {
stop( '"na.rm" must be a single logical value')
}
na.freq <- 0
if (na.rm == FALSE) { na.freq <- sum( is.na(x) ) } # count the NAs if needed
x <- x[!is.na(x)] # delete NAs
obs.val <- unique(x) # find unique values
valFreq <- function(x, y){ sum(y == x) }
freq <- unlist((lapply( obs.val, valFreq, x ))) # apply for all unique values
max.freq <- max(freq, na.freq) # modal frequency
return( max.freq )
}