Advertisement
Guest User

Untitled

a guest
Mar 19th, 2019
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.78 KB | None | 0 0
  1. library(dplyr)
  2.  
  3. # Copied from magrittr
  4. is_pipe <- function (pipe) {
  5. identical(pipe, quote(`%>%`)) || identical(pipe, quote(`%T>%`)) ||
  6. identical(pipe, quote(`%<>%`)) || identical(pipe, quote(`%$%`))
  7. }
  8.  
  9. get_og_lhs <- function(expr) {
  10. # While the expression is a call and the first element is a pipe
  11. while (is.call(expr) && (is_pipe(expr[[1L]]) || identical(expr[[1L]], quote(`%o%`)))) {
  12. expr <- expr[[2L]]
  13. }
  14. expr
  15. }
  16.  
  17. # Takes the end result of everything to the left and the original,
  18. # most-left part of the chain, and puts those two values into
  19. # the function on the right, in that order.
  20. `%o%` <- function(lhs, rhs) {
  21. parent <- parent.frame()
  22. og_call <- match.call()
  23. og_lhs <- get_og_lhs(og_call)
  24.  
  25. rhs_call <- og_call[[3L]]
  26. lhs_call <- og_call[[2L]]
  27.  
  28. eval(as.call(c(rhs_call[[1L]], lhs_call, og_lhs, as.list(rhs_call[-1L]))),
  29. parent, parent)
  30. }
  31.  
  32. # This will just return both values for you to see
  33. return_both_values <- function(x,y) {
  34. list(old = y, new = x)
  35. }
  36.  
  37. # This is an example of a function you could write to 'reset' the attributes
  38. set_col_attributes <- function(df, orig_df) {
  39. new_cols <- names(df)
  40. old_cols <- names(orig_df)
  41. for (col in old_cols) {
  42. if (col %in% new_cols) {
  43. old_attrs <- attributes(orig_df[[col]])
  44. # new_attrs <- attributes(df[[col]])
  45. attributes(df[[col]]) <- old_attrs
  46. }
  47. }
  48. df
  49. }
  50.  
  51. # Or you can specify which columns you want
  52. keep_these_attributes <- function(df, orig_df, ...) {
  53. cols_to_keep <- rlang::ensyms(...) %>%
  54. as.character()
  55. new_cols <- names(df)
  56. old_cols <- names(orig_df)
  57.  
  58. for (col in cols_to_keep) {
  59. if (col %in% old_cols) {
  60. if (col %in% new_cols) {
  61. old_attrs <- attributes(orig_df[[col]])
  62. attributes(df[[col]]) <- old_attrs
  63. }
  64. } else {
  65. warning("'", col, "' not in original data frame")
  66. }
  67. }
  68. df
  69. }
  70.  
  71. ################################################################################################################
  72. ###### EXAMPLES #####################################################################################
  73. ################################################################################################################
  74.  
  75. df <- data.frame(x=1,y=2)
  76. class(df) <- c("data.frome", class(df))
  77. attributes(df$x) <- list(class="myclass", something="my.attribute")
  78.  
  79. df1 <- df %>%
  80. mutate(z=3) %>%
  81. group_by(y) %>%
  82. mutate(x=x/2) %>%
  83. ungroup()
  84. attributes(df1$x)
  85.  
  86. df2 <- df %>%
  87. mutate(z=3) %>%
  88. group_by(y) %>%
  89. mutate(x=x/2) %>%
  90. ungroup() %o%
  91. set_col_attributes()
  92. attributes(df2$x)
  93.  
  94. df3 <- df %>%
  95. mutate(z=3) %>%
  96. group_by(z) %>%
  97. mutate(x=x/2, y=y+4) %>%
  98. ungroup() %o%
  99. keep_these_attributes(x)
  100. attributes(df3$x)
  101. attributes(df3$y)
  102.  
  103. df %>%
  104. mutate(z=3) %>%
  105. group_by(y) %>%
  106. summarise(n=n()) %o%
  107. return_both_values()
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement