Skip to content

Instantly share code, notes, and snippets.

View activeBindingFunction.R
makeDelayedBinding <- function(sym,
expr,
eval.env = parent.frame(1),
assign.env = parent.frame(1)) {
expr <- substitute(expr)
value <- NULL
forced <- FALSE
forceDelayed <- function() {
@lionel-
lionel- / recode.R
Created Jul 22, 2019
Recoding values
View recode.R
# The general idea is to supply a recoding specification through a
# data frame of keys and values. They keys are a generalisation of
# names, they can be any type.
keys <- function(key, value) {
tibble::tibble(.key = key, .value = value)
}
dribbleys <- function(...) {
tibble::tribble(~ .key, ~ .value, ...)
View wrapping-dt.R
# Simple DT wrapper
summarise <- function(data, j, by) {
data <- data.table::as.data.table(data)
data[
i = ,
j = eval(substitute(j)),
by = eval(substitute(by))
]
}
@lionel-
lionel- / starts-with.R
Created Apr 9, 2019
Does a vector start with the same values as another vector
View starts-with.R
truncate_len <- function(x, n) {
if (length(x) < n) {
stop("Can't truncate vector to the given length because it is already shorter")
}
x[seq_len(n)]
}
truncate_along <- function(x, y) {
truncate_len(x, length(y))
@lionel-
lionel- / magrittr-tidy-eval.R
Last active Dec 17, 2017
Unquoting RHS of magrittr pipe with quosure support
View magrittr-tidy-eval.R
# Actually does not work because quosured magrittr pronouns are not
# evaluated in the right environment
library("magrittr")
library("rlang")
# Anticipate renaming of `quo_is_lang()` in rlang
quo_is_call <- quo_is_lang
@lionel-
lionel- / depend.R
Last active Dec 2, 2017
Handle hard dependencies in library()
View depend.R
depend <- function(..., character.only = FALSE) {
# Mimic library()'s UI
if (character.only) {
packages <- c(...)
} else {
packages <- substitute(c(...))[-1]
if (!all(vapply(packages, is.symbol, logical(1)))) {
stop("Can't supply expressions if `character.only` is FALSE")
}
View pipe.R
library("rlang")
#' @import rlang
`%>%` <- function(x, y) {
lhs <- rlang:::captureArg(x)
lhs_value <- eval_bare(lhs$expr, lhs$env)
View monads.R
### Install monad-aware magrittr
devtools::dev_mode(TRUE)
devtools::install_github("lionel-/magrittr", ref = "monads")
### Monadic Infrastructure
bind <- function(x, fun, ...) {
UseMethod("bind")
@lionel-
lionel- / by-group.R
Last active Aug 29, 2015
Making lowliner better understand data frames
View by-group.R
set_groups <- function(.d, .cols = NULL) {
stopifnot(is.data.frame(.d))
if (is.null(.cols)) {
return(group_by_(.d, .dots = list()))
}
if (is.numeric(.cols)) {
.cols <- names(.d)[.cols]
}
.cols %>% map_call(dplyr::group_by_, .data = .d)
@lionel-
lionel- / remap.R
Last active Aug 29, 2015
Preserving version of lowliner's map()
View remap.R
remap <- function(.x, .f, ...) {
.f <- lowliner:::as_function(.f)
if (inherits(.f, "fseq")) {
# Handle magrittr's functional sequences
f_env <- environment(.f)
f_env$`_function_list` <- map(f_env$`_function_list`, ~ {
env <- new.env(parent = environment(.))
environment(.) <- env
.