编写自己的/定制管道运算符

Question

我想编写一个自定义管道运算符，其中使用的运算符名称为open。它可以是例如%>%、%|%、:=等，也许需要根据所需的运算符优先级选择，就像在Same function but using for it the name %>% causes a different result compared when using the name :=中解释的那样。

使用的占位符名称是open，但.或_是常见的，并且需要明确放置（不是作为第一个参数自动放置）。 评估环境是开放的。但是在this answer中看起来应该避免使用用户环境。

它应该能够保留用户环境中的值，如果它与占位符名称相同。

1 %>% identity(.)
#[1] 1
.
#Error: object '.' not found

. <- 2
1 %>% identity(.)
#[1] 1
.
#[1] 2

它应该能够更新用户环境中的值，包括占位符的名称。

1 %>% assign("x", .)
x
#[1] 1

"x" %>% assign(., 2)
x
#[1] 2

1 %>% assign(".", .)
.
#[1] 1

"." %>% assign(., 2)
.
#[1] 2

x <- 1 %>% {names(.) <- "foo"; .}
x
#foo 
#  1 

它应该从左到右进行评估。

1 %>% . + 2 %>% . * 3
#[1] 9

---

我知道的定义管道操作符的最短方式是将 . 设置为lhs的值，然后在其中评估rhs。

`:=` <- function(lhs, rhs) eval(substitute(rhs), list(. = lhs))

但是在这里，调用环境中的值无法被创建或更改。

因此，另一种尝试是将lhs分配给调用环境中的占位符 . ，并在调用环境中评估rhs。

`:=` <- function(lhs, rhs) {
  assign(".", lhs, envir=parent.frame())
  eval.parent(substitute(rhs))
}

这里已经完成了大部分工作，但它会在调用范围内创建或覆盖变量“.”。

因此，在退出时添加以删除占位符：

`:=` <- function(lhs, rhs) {
  on.exit(if(exists(".", parent.frame())) rm(., envir = parent.frame()))
  assign(".", lhs, envir=parent.frame())
  eval.parent(substitute(rhs))
}

现在唯一的问题是，如果.已经存在于调用环境中，则会将其删除。

因此，在退出时检查是否已经存在.，如果未修改lhs，则存储并重新插入它。

`:=` <- function(lhs, rhs) {
  e <- exists(".", parent.frame(), inherits = FALSE)
  . <- get0(".", envir = parent.frame(), inherits = FALSE)
  assign(".", lhs, envir=parent.frame())
  on.exit(if(identical(lhs, get0(".", envir = parent.frame(), inherits = FALSE))) {
            if(e) {
              assign(".", ., envir=parent.frame())
            } else {
              if(exists(".", parent.frame())) rm(., envir = parent.frame())
            }
          })
  eval(substitute(rhs), parent.frame())
}

但在尝试时失败了：

. <- 0
1 := assign(".", .)
.
#[1] 0

以下代码给出了预期结果，但我不确定它是否从左到右评估。

1 := . + 2 := . * 3
#[1] 9

- GKi

---

尝试使用这个。 - Jishan Shaikh

谢谢！看起来很有前途。但是 1 := assign(".", .) 或 "." := assign(., 2) 并没有给出预期的结果。无论如何，您能否发布这个解决方案的答案？ - GKi

我认为1 := assign(".", .)和x <- 1 := {names(.) <- "foo"; .}这两种情况可能不一致。你希望在同一个环境中同时使用.表示两个不同的含义，那么x <- 1 := {. <- .; .}会做什么呢？我们可以特殊处理assign()来满足你的测试，但我不确定这是否能满足你的要求。 - moodymudskipper

我有一个适用于所有情况的解决方案，但对于 x <- 1 := {names(.) <- "foo"; .} 这种情况不起作用，其中 . 是一个自毁式的活动绑定，根据定义只能使用一次。 - moodymudskipper

我在 https://dev59.com/4tmdpIgBRmDukGFEESNv#76155435 找到了 1 := {names(.) <- "foo"; .}，其中提到 我们可以通过不将“.”替换为LHS而是将“。”的定义注入到RHS所在的环境中来解决这个问题： - GKi

Answer 1

这意味着您需要在算术运算符下设置优先级

1 %>% . + 2 %>% . * 3

这将取消任何%>% 运算符，:= 不是一个坏选择，我们也可以使用?，让我们使用:=。

assign()和<-通常默认执行相同的操作。但是你的例子表明它们有所不同：

你希望 assign(".", "foo") 覆盖旧点，但 names(.) <- "foo"（以及. <- "foo"）覆盖新点而不影响旧点。

我相信实现这一点的唯一方法是特殊情况下使用assign()。我在下面给出了方案，并且你的测试已经得到满足。

通过此解决方案，我们在调用者的子环境中评估表达式，该子环境继承所有值，除了点，在此子环境中，并且在未提供环境参数时修改赋值函数使其在调用者中进行分配。

`:=` <- function(lhs, rhs) {
  pf <- parent.frame()
  rhs_call <- substitute(rhs)
  assign2 <- function (x, value, pos = -1, envir = as.environment(pos), inherits = FALSE, 
                       immediate = TRUE) {
    if (missing(pos) && missing(envir)) envir <- pf
    assign(x, value, envir = envir, inherits = inherits, immediate = immediate)
  }
  eval(rhs_call, envir = list(. = lhs, assign = assign2), enclos = pf)
}

1 := identity(.)
#> [1] 1
.
#> Error in eval(expr, envir, enclos): object '.' not found

. <- 2
1 := identity(.)
#> [1] 1
.
#> [1] 2

1 := assign("x", .)
x
#> [1] 1

"x" := assign(., 2)
x
#> [1] 2

1 := assign(".", .)
.
#> [1] 1

"." := assign(., 2)
.
#> [1] 2

x <- 1 := {names(.) <- "foo"; .}
x
#> foo 
#>   1

1 := . + 2 := . * 3
#> [1] 9

^{2023-05-03创建，使用reprex v2.0.2生成}

- moodymudskipper

Answer 2

在评论中，@Jishan Shaikh的回答。

`:=` <- function(lhs, rhs) {
  env <- parent.frame()
  
  # Save the value of the placeholder variable if it exists
  if (exists(".", envir = env, inherits = TRUE)) {
    dot_value <- get0(".", envir = env, inherits = TRUE)
  } else {
    dot_value <- NULL
  }
  
  # Assign the new value to the placeholder variable
  assign(".", lhs, envir = env)
  
  # Evaluate the right-hand side expression
  rhs_value <- eval(substitute(rhs), env)
  
  # Restore the value of the placeholder variable
  if (!is.null(dot_value)) {
    assign(".", dot_value, envir = env)
  } else {
    rm(".", envir = env)
  }
  
  # Return the value of the right-hand side expression
  return(rhs_value)
}

测试

1 := identity(.)
#> [1] 1
.
#> Error in eval(expr, envir, enclos): object '.' not found

. <- 2
1 := identity(.)
#> [1] 1
.
#> [1] 2

1 := assign("x", .)
x
#> [1] 1

"x" := assign(., 2)
x
#> [1] 2

1 := assign(".", .)
.
#> [1] 2  #!

"." := assign(., 3)
.
#> [1] 2  #!

x <- 1 := {names(.) <- "foo"; .}
x
#> foo 
#>   1

1 := . + 2 := . * 3
#> [1] 9

- GKi