renkun-ken / pipeR

Multi-Paradigm Pipeline Implementation
Other
169 stars 39 forks source link

Add environment-based pipe object #17

Closed renkun-ken closed 10 years ago

renkun-ken commented 10 years ago
Pipe <- function(value = NULL) {
  push <- function(fun,...) {
    fun <- match.fun(fun)
    Pipe(fun(value,...))
  }
  eval <- function(expr) {
    Pipe(base::eval(substitute(expr),list(.=value),sys.call()))
  }
  lambda <- function(x, expr) {
    Pipe(base::eval(substitute(expr),
      setnames(list(value),as.character.default(substitute(x))),
      sys.call()))
  }
  finish <- function() {
    invisible(value)
  }
  environment()
}

This allows the following code:

Pipe(sample(letters,6,replace = T))$
    push(paste,collaspe="")$
    push("==","rstats")$
    value

And benchmark test shows that

`%>%` <- magrittr::`%>%`
microbenchmark::microbenchmark(a={
  sample(letters,6,replace = T) %>%
    paste(collapse = "") %>%
    "=="("rstats")
},b={
  sample(letters,6,replace = T) %>>%
    paste(collapse = "") %>>%
    "=="("rstats")
},c={
  Pipe(sample(letters,6,replace = T))$
    push(paste,collaspe="")$
    push("==","rstats")$
    value
})
Unit: microseconds
 expr     min      lq  median      uq     max neval
    a 262.740 266.640 268.898 274.440 405.604   100
    b  22.169  23.401  25.043  28.327  87.854   100
    c  20.527  22.169  24.017  26.685  43.517   100
renkun-ken commented 10 years ago

An alternative design is to override $.Pipe:

Pipe <- function(value) {
  envir <- environment()
  class(envir) <- c("Pipe","environment")
  envir
}

`$.Pipe` <- function(x,y) {
  value <- get("value",envir = x,inherits = FALSE)
  if(exists(y,envir = x,inherits = FALSE)) {
    get(y,envir = x,inherits = FALSE)
  } else {
    fun <-  match.fun(y)
    function(...) {
      Pipe(fun(value,...))
    }
  }  
}

print.Pipe <- function(x,...) {
  cat("Pipe\n")
  print(x$value,...)
}

which allows

z <- Pipe(1:3)$
  lapply(function(i) i+1)$
  as.numeric()$
  mean()
> z
Pipe
[1] 3