Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Write own / custom pipe operator

Tags:

r

pipe

I would like to write a custom pipe operator where the used operator name is open. It could be e.g. %>%, %|%, :=, ... Maybe it needs to be chosen depending on the needed operator precedence like explained in Same function but using for it the name %>% causes a different result compared when using the name :=.

The used placeholder name is open but . or _ are common and it needs to be placed explicitly (no automatically placement as first argument).

The evaluation environment is open. But in this answer it looks like that using the user environment should be avoided.

It should be able to keep the value in the user environment in case it has the same name as the placeholder.

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

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

It should be able to update values in the user environment including the name of the placeholder.

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 

It should evaluate from left to right.

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

The shortest way I know defining a pipe operator, which is setting . to the value of the lhs in a new environment and evaluates rhs in it, is:

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

But here values in the calling environment could not be created or changed.

So another try is assigning lhs to the placeholder . in the calling environment and evaluate the rhs in the calling environment.

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

Here already most things work but it creates or overwrites the variable . in the calling scope.

So adding to remove the placeholder on exit:

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

Now is only the problem that . will be removed from calling environment in case it was already there.

So check if . is already there store it and reinsert it on exit in case lhs was not modified.

`:=` <- 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())
}

But it fails when trying:

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

The following gives the expected result but I'm not sure if it really evaluates from left to right.

1 := . + 2 := . * 3
#[1] 9
like image 883
GKi Avatar asked May 02 '26 00:05

GKi


1 Answers

This one means you need a precedence under arithmetic ops

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

This dismisses any %>% op, := is not a bad choice, we might also use ?, let's go with :=.

assign() and <- normally do the same thing by default. But your examples imply otherwise :

You would like assign(".", "foo") to overwrite the old dot but names(.) <- "foo" (and presumably . <- "foo") to override the new dot and not affect the old one.

I believe the only way to achieve this is to special case assign(), I do it below and your tests are satisfied.

With this solution we evaluate the expression in a child environment of the caller which inherits from all values except for the dot which is in this child env, and a modified assign functions that assigns in the caller when environment args are not provided.

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

Created on 2023-05-03 with reprex v2.0.2

like image 190
Moody_Mudskipper Avatar answered May 03 '26 15:05

Moody_Mudskipper