-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathcomparison_replace.R
81 lines (74 loc) · 1.9 KB
/
comparison_replace.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
#' Replacing Values by Comparison
#'
#' Operators for replacing values using the standard comparison operators.
#'
#' Thanks to these operators :
#' * `x == y <- value` is equivalent to `x[x == y] <- value`
#' * `x != y <- value` is equivalent to `x[x != y] <- value`
#' * `x <= y <- value` is equivalent to `x[x <= y] <- value`
#' * `x >= y <- value` is equivalent to `x[x >= y] <- value`
#' * `x < y <- value` is equivalent to `x[x < y] <- value`
#' * `x > y <- value` is equivalent to `x[x > y] <- value`
#'
#' @param x first element of the operation.
#' @param y second element of the operation.
#' @param value replacement value.
#'
#' @return \code{x} with values for which the comparisons evaluate to TRUE replaced with \code{value}.
#'
#' @examples
#' ages <- c(130, 10, 1996, 21, 39, 74, -2, 0)
#'
#' ages == 1996 <- as.numeric(format(Sys.Date(), "%Y")) - 1986
#' ages
#'
#' ages > 100 <- NA
#' ages
#'
#' ages <= 0 <- NA
#' ages
#'
#' @seealso \code{`==`}
#' @name comparison_replace
NULL
#' @rdname comparison_replace
#' @usage x >= y <- value
#' @export
`>=<-` <- function(x, y, value) {
replace(x, x >= y, value)
}
#' @rdname comparison_replace
#' @usage x > y <- value
#' @export
`><-` <- function(x, y, value) {
replace(x, x > y, value)
}
#' @rdname comparison_replace
#' @usage x <= y <- value
#' @export
`<=<-` <- function(x, y, value) {
replace(x, x <= y, value)
}
#' @rdname comparison_replace
#' @usage x < y <- value
#' @export
`<<-` <- function(x, y, value) {
# this one needs extra care so standard base::`<<-` still works
if (missing(value)) {
eval.parent(substitute(.Primitive("<<-")(x, y)))
} else {
replace(x, x < y, value)
}
}
#' @rdname comparison_replace
#' @usage x == y <- value
#' @export
`==<-` <- function(x, y, value) {
replace(x, x == y, value)
}
#' @rdname comparison_replace
#' @usage x != y <- value
#' @export
`!=<-` <- function(x, y, value) {
replace(x, x != y, value)
}