-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
0 parents
commit 75fa42b
Showing
18 changed files
with
1,665 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,5 @@ | ||
^infixer\.Rproj$ | ||
^\.Rproj\.user$ | ||
^exclude$ | ||
^LICENSE\.md$ | ||
^setops\.Rproj$ |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,3 @@ | ||
.Rproj.user | ||
.Rhistory | ||
.RData |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,12 @@ | ||
Package: rangeops | ||
Title: What the Package Does (one line, title case) | ||
Version: 0.0.0.9000 | ||
Authors@R: person("First", "Last", email = "first.last@example.com", role = c("aut", "cre")) | ||
Description: What the package does (one paragraph). | ||
Depends: R (>= 3.6.0) | ||
License: GPL-3 | ||
Encoding: UTF-8 | ||
LazyData: true | ||
RoxygenNote: 6.1.1 | ||
Suggests: | ||
rlang |
Large diffs are not rendered by default.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,51 @@ | ||
# Generated by roxygen2: do not edit by hand | ||
|
||
export("!=<-") | ||
export("%!in%") | ||
export("%!in%<-") | ||
export("%!in()%") | ||
export("%!in()%<-") | ||
export("%!in(]%") | ||
export("%!in(]%<-") | ||
export("%!in[)%") | ||
export("%!in[)%<-") | ||
export("%!in[]%") | ||
export("%!in[]%<-") | ||
export("%!in{}%") | ||
export("%!in{}%<-") | ||
export("%!like%") | ||
export("%!like%<-") | ||
export("%!subset()%") | ||
export("%!subset(]%") | ||
export("%!subset[)%") | ||
export("%!subset[]%") | ||
export("%!subset{}%") | ||
export("%in%<-") | ||
export("%in()%") | ||
export("%in()%<-") | ||
export("%in(]%") | ||
export("%in(]%<-") | ||
export("%in[)%") | ||
export("%in[)%<-") | ||
export("%in[]%") | ||
export("%in[]%<-") | ||
export("%in{}%") | ||
export("%in{}%<-") | ||
export("%like%") | ||
export("%like%<-") | ||
export("%subset!=%") | ||
export("%subset()%") | ||
export("%subset(]%") | ||
export("%subset<%") | ||
export("%subset<=%") | ||
export("%subset==%") | ||
export("%subset>%") | ||
export("%subset>=%") | ||
export("%subset[)%") | ||
export("%subset[]%") | ||
export("%subset{}%") | ||
export("<<-") | ||
export("<=<-") | ||
export("==<-") | ||
export("><-") | ||
export(">=<-") |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,98 @@ | ||
#' in variants | ||
#' | ||
#' @inheritParams base::match | ||
#' @param value replacement value | ||
#' | ||
#' @name in_variants | ||
NULL | ||
|
||
#' @rdname in_variants | ||
#' @export | ||
`%in%<-` <- function (x, table, value) { | ||
if(is.factor(x)){ | ||
# if factor we replace levels not values | ||
lvls <- levels(x) | ||
cond <- lvls %in% table | ||
if(any(cond)){ | ||
# if value is function we apply it on relevant subset | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(lvls[cond]) | ||
# replace relevant levels | ||
levels(x)[cond] <- value | ||
} | ||
} else { | ||
cond <- x %in% table | ||
if(any(cond)){ | ||
# if value is function we apply it on relevant subset | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(x[cond]) | ||
# replace relevant elements | ||
x <- replace(x, cond, value) | ||
} | ||
} | ||
x | ||
} | ||
|
||
#' @rdname in_variants | ||
#' @export | ||
`%!in%` <- function(x, table) !x %in% table | ||
|
||
# copy and paste from `%in%`, adding `!` to `cond` definition | ||
#' @rdname in_variants | ||
#' @export | ||
`%!in%<-` <- function (x, table, value) { | ||
if(is.factor(x)){ | ||
# if factor we replace levels not values | ||
lvls <- levels(x) | ||
cond <- !lvls %in% table | ||
if(any(cond)){ | ||
# if value is function we apply it on relevant subset | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(lvls[cond]) | ||
# replace relevant levels | ||
levels(x)[cond] <- value | ||
} | ||
} else { | ||
cond <- !x %in% table | ||
if(any(cond)){ | ||
# if value is function we apply it on relevant subset | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(x[cond]) | ||
# replace relevant elements | ||
x <- replace(x, cond, value) | ||
} | ||
} | ||
x | ||
} | ||
|
||
# vec <- c(0, 10, 100 ,1000) | ||
# vec %in% 5:500 <- 42 | ||
# vec | ||
# #> [1] 0 42 42 1000 | ||
# vec %in% 42 <- c(10, 100) | ||
# vec | ||
# #> [1] 0 10 100 1000 | ||
# vec %!in% 5:100 <- 42 | ||
# vec | ||
# #> [1] 42 10 100 42 | ||
# vec <- letters[1:4] | ||
# vec %in% c("a","c") <- toupper | ||
# vec | ||
# #> [1] "A" "b" "C" "d" | ||
# vec %in% c("A","C") <- ~paste0(.,"!!!") | ||
# #> Loading required namespace: rlang | ||
# vec | ||
# #> [1] "A!!!" "b" "C!!!" "d" | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,140 @@ | ||
#' Comparison Operators | ||
#' | ||
#' | ||
#' | ||
#' @param e1 lhs | ||
#' @param e2 rhs | ||
#' @param value replacement value | ||
#' | ||
#' @name comparison_ops | ||
NULL | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`>=<-` <- function(e1, e2, value){ | ||
cond <- e1 >= e2 | ||
if(any(cond)) { | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(e1[cond]) | ||
replace(e1, cond, value) | ||
} else e1 | ||
} | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`><-` <- function(e1, e2, value){ | ||
cond <- e1 > e2 | ||
if(any(cond)) { | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(e1[cond]) | ||
replace(e1, cond, value) | ||
} else e1 | ||
} | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`<=<-` <- function(e1, e2, value){ | ||
cond <- e1 <= e2 | ||
if(any(cond)) { | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(e1[cond]) | ||
replace(e1, cond, value) | ||
} else e1 | ||
} | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`<<-` <- function(e1, e2, value){ | ||
# this one needs extra care so standard base::`<<-` still works | ||
if (missing(value)) | ||
eval.parent(substitute(.Primitive("<<-")(e1, e2))) | ||
else { | ||
cond <- e1 < e2 | ||
if(any(cond)) { | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(e1[cond]) | ||
replace(e1, cond, value) | ||
} else e1 | ||
} | ||
} | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`==<-` <- function(e1, e2, value){ | ||
cond <- e1 == e2 | ||
if(any(cond)) { | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(e1[cond]) | ||
replace(e1, cond, value) | ||
} else e1 | ||
} | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`!=<-` <- function(e1, e2, value){ | ||
cond <- e1 != e2 | ||
if(any(cond)) { | ||
if(inherits(value,"formula")) { | ||
if (requireNamespace("rlang")) value <- rlang::as_function(value) | ||
else stop("install package rlang to use `%in<-` with formula notation") | ||
} | ||
if(is.function(value)) value <- value(e1[cond]) | ||
replace(e1, cond, value) | ||
} else e1 | ||
} | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`%subset>=%` <- function(e1, e2) e1[e1 >= e2] | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`%subset>%` <- function(e1, e2) e1[e1 > e2] | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`%subset<=%` <- function(e1, e2) e1[e1 <= e2] | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`%subset<%` <- function(e1, e2) e1[e1 < e2] | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`%subset==%` <- function(e1, e2) e1[e1 == e2] | ||
|
||
#' @rdname comparison_ops | ||
#' @export | ||
`%subset!=%` <- function(e1, e2) e1[e1 != e2] | ||
|
||
# vec <- c(0, 3, 6 ,9) | ||
# vec >= 5 <- 10 | ||
# vec | ||
# #> [1] 0 3 10 10 | ||
# vec == 10 <- ~.*7 | ||
# vec | ||
# #> [1] 0 3 70 70 | ||
# # no value above 1000, so no stop | ||
# vec >= 1000 <- ~ stop() | ||
# # stops if condition verified | ||
# vec >= 5 <- ~ stop("found value superior to 5!") | ||
# #> Error in value(e1[cond]): found value superior to 5! | ||
# vec %v>=% 3 | ||
# #> [1] 3 70 70 | ||
# vec %v==% 70 | ||
# #> [1] 70 70 |
Oops, something went wrong.