Skip to content

Instantly share code, notes, and snippets.

@burchill
Last active March 14, 2019 22:27
Show Gist options
  • Save burchill/6296df75059ef56026a0894eb6f9bcbf to your computer and use it in GitHub Desktop.
Save burchill/6296df75059ef56026a0894eb6f9bcbf to your computer and use it in GitHub Desktop.
library(dplyr)
# Copied from magrittr
is_pipe <- function (pipe) {
identical(pipe, quote(`%>%`)) || identical(pipe, quote(`%T>%`)) ||
identical(pipe, quote(`%<>%`)) || identical(pipe, quote(`%$%`))
}
get_og_lhs <- function(expr) {
# While the expression is a call and the first element is a pipe
while (is.call(expr) && (is_pipe(expr[[1L]]) || identical(expr[[1L]], quote(`%o%`)))) {
expr <- expr[[2L]]
}
expr
}
# Takes the end result of everything to the left and the original,
# most-left part of the chain, and puts those two values into
# the function on the right, in that order.
`%o%` <- function(lhs, rhs) {
parent <- parent.frame()
og_call <- match.call()
og_lhs <- get_og_lhs(og_call)
rhs_call <- og_call[[3L]]
lhs_call <- og_call[[2L]]
eval(as.call(c(rhs_call[[1L]], lhs_call, og_lhs, as.list(rhs_call[-1L]))),
parent, parent)
}
# This will just return both values for you to see
return_both_values <- function(x,y) {
list(old = y, new = x)
}
# This is an example of a function you could write to 'reset' the attributes
set_col_attributes <- function(df, orig_df) {
new_cols <- names(df)
old_cols <- names(orig_df)
for (col in old_cols) {
if (col %in% new_cols) {
old_attrs <- attributes(orig_df[[col]])
# new_attrs <- attributes(df[[col]])
attributes(df[[col]]) <- old_attrs
}
}
df
}
# Or you can specify which columns you want
keep_these_attributes <- function(df, orig_df, ...) {
cols_to_keep <- rlang::ensyms(...) %>%
as.character()
new_cols <- names(df)
old_cols <- names(orig_df)
for (col in cols_to_keep) {
if (col %in% old_cols) {
if (col %in% new_cols) {
old_attrs <- attributes(orig_df[[col]])
attributes(df[[col]]) <- old_attrs
}
} else {
warning("'", col, "' not in original data frame")
}
}
df
}
################################################################################################################
###### EXAMPLES #####################################################################################
################################################################################################################
df <- data.frame(x=1,y=2)
class(df) <- c("data.frome", class(df))
attributes(df$x) <- list(class="myclass", something="my.attribute")
df1 <- df %>%
mutate(z=3) %>%
group_by(y) %>%
mutate(x=x/2) %>%
ungroup()
attributes(df1$x)
df2 <- df %>%
mutate(z=3) %>%
group_by(y) %>%
mutate(x=x/2) %>%
ungroup() %o%
set_col_attributes()
attributes(df2$x)
df3 <- df %>%
mutate(z=3) %>%
group_by(z) %>%
mutate(x=x/2, y=y+4) %>%
ungroup() %o%
keep_these_attributes(x)
attributes(df3$x)
attributes(df3$y)
df %>%
mutate(z=3) %>%
group_by(y) %>%
summarise(n=n()) %o%
return_both_values()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment