kind of precompiling from magrittr's syntax to eager evaluation syntax
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "README-"
)
demagrittr()
and demagrittr_source()
convert magrittr’s syntax to eager
evaluation syntax (by default) for the purpose of:
%>%
is heavily used inside a long loop)This is experimental and not fully tested, so I would be glad
if you could inform me of any misunderstandings or mistakes.
# install.packages("devtools")
devtools::install_github("tobcap/demagrittr")
library("demagrittr")
library(magrittr)
library(demagrittr)
# NSE
demagrittr(x %>% f %>% g %>% h) # mode = "eager" by default
demagrittr(x %>% f %>% g %>% h, mode = "lazy")
demagrittr(x %>% f %>% g %>% h, mode = "promise")
# Manipulation for a language object
expr0 <- quote(x %>% f %>% g %>% h)
demagrittr(expr0, is_NSE = FALSE)
# The output in `mode = "promise"` seems redundant but is essential in
# this example.
demagrittr({set.seed(1); rnorm(1) %>% sum(., .)}, mode = "lazy")
demagrittr({set.seed(1); rnorm(1) %>% sum(., .)}, mode = "promise")
compiled0 <- demagrittr(1:10 %>% sum %>% log %>% sin)
print(compiled0)
eval(compiled0)
demagrittr(f <- . %>% cos %>% sin)
demagrittr(f <- . %>% cos %>% sin, mode = "lazy")
demagrittr(f <- . %>% cos %>% sin, mode = "promise")
# The resul is just a language object. You need to eval().
eval(demagrittr(f <- . %>% cos %>% sin))
f(1)
sin(cos(1))
demagrittr(
rnorm(200) %>%
matrix(ncol = 2) %T>%
plot %>% # plot usually does not return anything.
colSums
)
demagrittr({
iris %>%
subset(Sepal.Length > mean(Sepal.Length)) %$%
cor(Sepal.Length, Sepal.Width)
data.frame(z = rnorm(100)) %$%
ts.plot(z)
})
demagrittr({
iris$Sepal.Length <-
iris$Sepal.Length %>%
sqrt
iris$Sepal.Length %<>% sqrt
})
e <- quote(
for (i in 1:10000) {
i %>%
identity %>%
identity %>%
identity %>%
identity
}
)
system.time(eval(e))
system.time(eval(demagrittr(e, FALSE)))
library("microbenchmark")
library("magrittr")
library("pipeR")
library("demagrittr")
expr1 <- quote(1:10 %>% sum %>% log %>% sin)
expr2e <- demagrittr(expr1, FALSE, mode = "eager")
expr2l <- demagrittr(expr1, FALSE, mode = "lazy")
expr2p <- demagrittr(expr1, FALSE, mode = "promise")
expr3 <- quote(1:10 %>>% sum %>>% log %>>% sin)
microbenchmark(
"%>%" = eval(expr1)
, "demagrittr eager" = eval(expr2e)
, "demagrittr lazy" = eval(expr2l)
, "demagrittr promise" = eval(expr2p)
, "%>>%" = eval(expr3)
, times = 1e3)
Reduce(function(x, y) if (identical(x, y)) y else FALSE,
lapply(list(expr1, expr2e, expr2l, expr2p, expr3), eval))
# from http://renkun.me/blog/2014/08/08/difference-between-magrittr-and-pipeR.html#performance
expr4 <- quote({
set.seed(1)
lapply(1:100000, function(i) {
sample(letters, 6, replace = T) %>%
paste(collapse = "") %>%
"=="("rstats")
})
})
expr5e <- demagrittr(expr4, FALSE, mode = "eager")
expr5l <- demagrittr(expr4, FALSE, mode = "lazy")
expr5p <- demagrittr(expr4, FALSE, mode = "promise")
expr6 <- quote({
set.seed(1)
lapply(1:100000, function(i) {
sample(letters, 6, replace = T) %>>%
paste(collapse = "") %>>%
"=="("rstats")
})
})
# My poor laptop takes huge time. The unit is 'seconds'.
microbenchmark(
"%>%" = eval(expr4)
, "demagrittr eager" = eval(expr5e)
, "demagrittr lazy" = eval(expr5l)
, "demagrittr promise" = eval(expr5p)
, "%>>%" = eval(expr6)
, times = 1)
tmp_dir <- tempdir()
in_path <- file.path(tmp_dir, "test_in.r")
out_path <- file.path(tmp_dir, "test_out.r")
writeLines(
"
x <- data.frame(a = 1:5, b = 6:10)
y <- x %>%
select(b) %>%
filter(b >= 8)
", in_path)
demagrittr_source(in_path, out_path, ask = FALSE)
# input file
cat(paste0(readLines(in_path), collapse="\n"))
# output file
cat(paste0(readLines(out_path), collapse="\n"))
#{n}
is used for the prefix-name of temporary symbols in the converteddemagrittr()
. (hope nobody uses such a tricky name as a symbol)return()
appears in middle of pipe stream differs by the mode.expr_return <- quote(1:10 %>% sum %>% return %>% log)
expr_return
demagrittr(expr_return, is_NSE = FALSE, mode = "eager")
demagrittr(expr_return, is_NSE = FALSE, mode = "lazy")
demagrittr(expr_return, is_NSE = FALSE, mode = "promise")
eval(expr_return)
eval(demagrittr(expr_return, is_NSE = FALSE, mode = "eager"))
eval(demagrittr(expr_return, is_NSE = FALSE, mode = "lazy"))
eval(demagrittr(expr_return, is_NSE = FALSE, mode = "promise"))
## runs but expected output?
1:10 %>% sum %>% return %>% log
# The code below occurs error in console
{
`#0` <- 1:10
`#1` <- sum(`#0`)
`#2` <- return(`#1`)
log(`#2`)
}
## execute in console
## Error: no function to return from, jumping to top level
# Also error in console
log(return(sum(1:10)))
## Error: no function to return from, jumping to top level
# runs, but expected result?
(function(`#2`) log(`#2`))((function(`#1`) return(`#1`))((function(`#0`) sum(`#0`))(1:10)))