keep_og_values.R

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()