Last active
January 6, 2021 09:30
-
-
Save moodymudskipper/aeb4643c93f78fc9d85f56865fa63f9a to your computer and use it in GitHub Desktop.
This file contains hidden or 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
mutate2 <- function(.data, ...) { | |
dots <- rlang::enquos(...) | |
has_tilde_lgl <- sapply(dots, function(x) { | |
expr <- rlang::quo_get_expr(x) | |
is.call(expr) && identical(expr[[1]], quote(`~`)) | |
}) | |
inds <- which(has_tilde_lgl) | |
nms <- names(dots)[inds] | |
exprs <- vector("list", length(inds)) | |
for(i in seq_along(inds)) { | |
env <- attr(dots[[inds[i]]], ".Environment") | |
exprs[[i]] <- rlang::quo_get_expr(dots[[inds[i]]])[[2]] | |
dots[[inds[i]]] <- rlang::as_quosure(exprs[[i]], env = env) | |
} | |
res <- dplyr::mutate(.data, !!!dots) | |
for(i in seq_along(inds)) { | |
attr(res[[nms[i]]],"expr") <- exprs[[i]] | |
class(res[[nms[i]]]) <- | |
c(paste0("~",pillar::type_sum(res[[nms[i]]])), | |
"refreshable_column", class(res[[nms[i]]])) | |
} | |
res | |
} | |
refresh <- function(x) { | |
pf <- parent.frame() | |
for(i in seq_along(x)) { | |
if(inherits(x[[i]], "refreshable_column")) { | |
cl <- class(x[[i]]) | |
expr <- attr(x[[i]],"expr") | |
x[[i]] <- eval(expr, x, pf) | |
attr(x[[i]],"expr") <- expr | |
class(x[[i]]) <- | |
c(paste0("~", pillar::type_sum(col)), | |
"refreshable_column", class(col)) | |
} | |
} | |
x | |
} | |
# convert so headers are displayed | |
cars <- tibble::as_tibble(cars) | |
# mutate2 is like mutate but we use a `~` prefix for refreshable columns | |
df1 <- mutate2(cars, time1 = dist/speed, time2 = ~dist/speed) | |
# we see these cols have a header prefixed with "~" | |
print(df1, n = 2) | |
#> # A tibble: 50 x 4 | |
#> speed dist time1 time2 | |
#> <dbl> <dbl> <dbl> <~dbl> | |
#> 1 4 2 0.5 0.5 | |
#> 2 4 10 2.5 2.5 | |
#> # ... with 48 more rows | |
# let's change the dist column, the time2 column won't update but... | |
df2 <- dplyr::mutate(df1, dist = dist*2) | |
print(df2, n = 2) | |
#> # A tibble: 50 x 4 | |
#> speed dist time1 time2 | |
#> <dbl> <dbl> <dbl> <~dbl> | |
#> 1 4 4 0.5 0.5 | |
#> 2 4 20 2.5 2.5 | |
#> # ... with 48 more rows | |
# ... if I refresh it will | |
df3 <- refresh(df2) | |
print(df3, n = 2) | |
#> # A tibble: 50 x 4 | |
#> speed dist time1 time2 | |
#> <dbl> <dbl> <dbl> <~dbl> | |
#> 1 4 4 0.5 1 | |
#> 2 4 20 2.5 5 | |
#> # ... with 48 more rows | |
# str() can be used to see the expr, note that it is a standard tibble | |
str(df3) | |
#> tibble [50 x 4] (S3: tbl_df/tbl/data.frame) | |
#> $ speed: num [1:50] 4 4 7 7 8 9 10 10 10 11 ... | |
#> $ dist : num [1:50] 4 20 8 44 32 20 36 52 68 34 ... | |
#> $ time1: num [1:50] 0.5 2.5 0.571 3.143 2 ... | |
#> $ time2: '~dbl' num [1:50] 1 5 1.14 6.29 4 ... | |
#> ..- attr(*, "expr")= language dist/speed |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment