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

Question

我想编写一个自定义管道运算符，其中使用的运算符名称是open。可能是例如

%>%

,

%|%

,

:=

, ... 也许需要根据所需的 operator precedence 来选择它，就像在 Same function but using for it name %>% causes a different result compared when使用名称 :=.

使用的占位符名称是开放的但是

.

或

_

是常见的并且需要显式放置（没有自动放置作为第一个参数）。

测评环境开放。但是在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

---

目前我有：

`:=` <- 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

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}

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