Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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()
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement