Testing delayed evaluation in pipes

delayed_evaluation_in_pipes.R

`%>>>%`<-function(lhs,rhs){
  parent <- parent.frame()
  env <- new.env(parent = parent)
  chain_parts <- magrittr:::split_chain(match.call(), env = env)
  eval(as.call(call("%>%",call("%>%",chain_parts$lhs$lhs,substitute(play)),chain_parts$lhs$rhs)))
}

play<-function(lhs){
  delayedexpr<-as.list(attr(lhs,"delayedeval"))
  delayedFunc<-delayedexpr[[length(delayedexpr)]]
  tmp_delayedFunc<-c(delayedFunc[[1]],quote(lhs))
  if(length(delayedFunc)>1){
    tmp_delayedFunc<-c(tmp_delayedFunc,as.list(delayedFunc)[-1])
  }
  delayedexpr[[length(delayedexpr)]]<-as.call(tmp_delayedFunc)
  eval(as.call(delayedexpr))
}

`%||%` <- function (lhs, rhs) {
  parent <- parent.frame()
  env <- new.env(parent = parent)
  chain_parts <- magrittr:::split_chain(match.call(), env = env)
  
  tmp_lhs<-chain_parts[["lhs"]]$lhs
  # delayedFunc<-as.list(tmp_lhs[[length(tmp_lhs)]])[[1]]
  # tmp_lhs[[length(tmp_lhs)]]<-delayedFunc
  
  #if rhs is an object, handle it this way
  attr(rhs,'delayedeval')<-tmp_lhs
  class(rhs)<-c(class(rhs),'delayedeval')

  return(rhs)
}
  
set.seed(42)

df<-data.frame(x=LETTERS,
               y=runif(26),
               z=sample(letters,26,replace = TRUE))
df2<-data.frame(x=LETTERS,
                w=sample(c(1,2),size = 26,replace = TRUE))

tmpvar1<-df2 %>% 
  filter(w==1)

left_join_test <- df %>% 
  mutate(vowel=LETTERS%in%c("A","E","I","O","U","Y")) %>% 
  filter(y>.5) %>% 
  left_join(tmpvar1,by="x") %>% 
  filter(!is.na(w))

left_join_test2 <- df %>% 
  mutate(vowel=LETTERS%in%c("A","E","I","O","U","Y")) %>% 
  filter(y>.5) %>% 
  left_join(by="x") %||% 
    df2 %>% 
    filter(w==1) %>>>%
  filter(!is.na(w))


testthat::expect_equal(left_join_test2,left_join_test)

tmpvar2<-df2 %>% 
  filter(x%in%c("A","E","I","O","U","Y")) %>% 
  select(w) 

cor_result <- df %>% 
  filter(x%in%c("A","E","I","O","U","Y")) %>% 
  select(y) %>% 
  cor(tmpvar2)

cor_test2 <- df %>% 
  filter(x%in%c("A","E","I","O","U","Y")) %>% 
  select(y) %>% 
  cor() %||%
    df2 %>% 
    filter(x%in%c("A","E","I","O","U","Y")) %>% 
    select(w) %>% 
  play()

testthat::expect_equal(cor_test2,cor_result)

left_join_test2 <- 
df %>% 
  mutate(vowel=LETTERS%in%c("A","E","I","O","U","Y")) %>% 
  filter(y>.5) . %||% # pause
df2 %>%  # process your second data frame
  filter(w==1) %>>>% # fast forward after the process to the next step
   left_join(by="x")  %>% # do the left join, then pipe that to the next step
  filter(!is.na(w))