R 如何实现类突变链评估？

Dplyr的

mutate

函数可以计算“链式”表达式，例如

library(dplyr)

data.frame(a = 1) %>%
   mutate(b = a + 1, c = b * 2)
##   a b c
## 1 1 2 4 

如何实现这一点？快速浏览dplyr的源代码可以发现候选代码的基本结构：

library(lazyeval)
library(rlang)

compat_as_lazy <- function(quo) {
  structure(class = "lazy", list(
    expr = f_rhs(quo),
    env = f_env(quo)
  ))
}

compat_as_lazy_dots <- function(...) {
  structure(class = "lazy_dots", lapply(quos(...), compat_as_lazy))
}

my_mutate <- function(.data, ...) {
  lazy_eval(compat_as_lazy_dots(...), data = .data)
}

data.frame(a = 1) %>%
  my_mutate(b = a + 1, c = b * 2)
## Error in eval(x$expr, data, x$env) : object 'b' not found

库（lazyeval）
图书馆（rlang）
compat_as_lazy我不能完全确定这是您想要的，但下面是3个在base R中的变异克隆，它们与您的示例一起工作：

mutate_transform <- function(df,...){
  lhs <- names(match.call())[-1:-2]
  rhs <- as.character(substitute(list(...)))[-1]
  args = paste(lhs,"=",rhs)
  for(arg in args){
    df <- eval(parse(text=paste("transform(df,",arg,")")))
  }
df
}

mutate_within <- function(df,...){
  lhs <- names(match.call())[-1:-2]
  rhs <- as.character(substitute(list(...)))[-1]
  args = paste(lhs,"=",rhs)
  df <- eval(parse(text=paste("within(df,{",paste(args,collapse=";"),"})")))
  df
}

mutate_attach <- function(df,...){
  lhs <- names(match.call())[-1:-2]
  rhs <- as.character(substitute(list(...)))[-1]
  new_env <- new.env()
  with(data = new_env,attach(df,warn.conflicts = FALSE))
  for(i in 1:length(lhs)){
    assign(lhs[i],eval(parse(text=rhs[i]),envir=new_env),envir=new_env)
  }
  add_vars <- setdiff(lhs,names(df))
  with(data = new_env,detach(df))
  for(var in add_vars){
    df[[var]] <- new_env[[var]]
  }
  df
}  

data.frame(a = 1) %>%  mutate_transform(b = a + 1, c = b * 2)
#   a b c
# 1 1 2 4
data.frame(a = 1) %>%  mutate_within(b = a + 1, c = b * 2)
#   a c b   <--- order is different here 
# 1 1 4 2
data.frame(a = 1) %>%  mutate_attach(b = a + 1, c = b * 2)
#   a b c
# 1 1 2 4

mutate_transform我不完全确定这是您想要的，但这里有3个base R中的mutate clone可以与您的示例一起使用：

mutate_transform <- function(df,...){
  lhs <- names(match.call())[-1:-2]
  rhs <- as.character(substitute(list(...)))[-1]
  args = paste(lhs,"=",rhs)
  for(arg in args){
    df <- eval(parse(text=paste("transform(df,",arg,")")))
  }
df
}

mutate_within <- function(df,...){
  lhs <- names(match.call())[-1:-2]
  rhs <- as.character(substitute(list(...)))[-1]
  args = paste(lhs,"=",rhs)
  df <- eval(parse(text=paste("within(df,{",paste(args,collapse=";"),"})")))
  df
}

mutate_attach <- function(df,...){
  lhs <- names(match.call())[-1:-2]
  rhs <- as.character(substitute(list(...)))[-1]
  new_env <- new.env()
  with(data = new_env,attach(df,warn.conflicts = FALSE))
  for(i in 1:length(lhs)){
    assign(lhs[i],eval(parse(text=rhs[i]),envir=new_env),envir=new_env)
  }
  add_vars <- setdiff(lhs,names(df))
  with(data = new_env,detach(df))
  for(var in add_vars){
    df[[var]] <- new_env[[var]]
  }
  df
}  

data.frame(a = 1) %>%  mutate_transform(b = a + 1, c = b * 2)
#   a b c
# 1 1 2 4
data.frame(a = 1) %>%  mutate_within(b = a + 1, c = b * 2)
#   a c b   <--- order is different here 
# 1 1 4 2
data.frame(a = 1) %>%  mutate_attach(b = a + 1, c = b * 2)
#   a b c
# 1 1 2 4

mutate\u transform在阅读了Moody\u Mudskipper的答案后，我提出了自己的解决方案，重新实现了
lazyeval:：lazy\u eval
函数，用于“记住”过去计算的表达式列表：

my_eval <- function(expr, .data = NULL) {
  idx <- structure(seq_along(expr),
                   names = names(expr))
  lapply(idx, function(i) {
    evl <- lazy_eval(expr[[i]], data = .data)
    .data[names(expr)[i]] <<- evl
    evl
  })
}

my_eval在阅读了Moody_Mudskipper的答案后，我提出了自己的解决方案，重新实现了
lazyeval:：lazy_eval
函数，用于“记住”过去计算的表达式列表：

my_eval <- function(expr, .data = NULL) {
  idx <- structure(seq_along(expr),
                   names = names(expr))
  lapply(idx, function(i) {
    evl <- lazy_eval(expr[[i]], data = .data)
    .data[names(expr)[i]] <<- evl
    evl
  })
}

我的评估哦，你在尝试制作你自己的变异函数……哦，你在尝试制作你自己的变异函数。。。。