using dplyr functions programmatically

dplyr_functions_programmatic_use.R

# using dplyr finctions in non-interactive mode
# examples

library(plyr)
library(dplyr)

d1 = data_frame(x = seq(1,20),y = rep(1:10,2),z = rep(1:5,4))
head(d1)

#### single table verbs ####
# group_by
group_by_fn <- function(d_in,gp_vec){
  d_out = d_in %>%
    group_by_(.dots = gp_vec)
}

gp_vec = c("y","z")
d1_gp_by_out = group_by_fn(d1,gp_vec)
head(d1_gp_by_out)


# select/rename (haven't included drop variables case)
select_fn <- function(d_in,sel_vec){
  d_out = d_in %>%
    select_(.dots = sel_vec)
}

sel_vec = c("x","y")
d1_select_out = select_fn(d1,sel_vec)
head(d1_select_out)


# filter
filter_fn <- function(d_in,filter_crit){
  d_out = d_in %>%
    filter_(filter_crit)
}

y_vec = 6:8
filter_crit = interp(~ filter_var %in% y_vec,filter_var = as.name("y"))
d1_filter_out = filter_fn(d1,filter_crit)
head(d1_filter_out)

z_vec = 1:2
filter_crit2 = interp(~ filter_var1 %in% y_vec & filter_var2 %in% z_vec,.values = list(filter_var1 = as.name("y"),
                                                                                   filter_var2 = as.name("z")))
d1_filter2_out = filter_fn(d1,filter_crit2)
head(d1_filter2_out)


# mutate, transmute, summarise
mutate_fn <- function(d_in,op_ls,var_vec){
  
  d_out = d_in %>%
    mutate_(.dots = setNames(op_ls,var_vec))
}

var1_rng = 3:5
op_ls = list(interp(~f(var1,var2), .values = list(f = as.name("*"),
                                                  var1 = as.name("x"), 
                                                  var2 = as.name("y"))),
             interp(~f(var1 %in% var1_rng,var2,var3),.values= list(f = as.name("ifelse"),
                                                                   var1 = as.name("x"),
                                                                   var2 = as.name("y"),
                                                                   var3 = as.name("z"))))

var_vec = c("yy","zz")
d1_mutate_out = mutate_fn(d1, op_ls, var_vec)
head(d1_mutate_out)
var_ls = list("yy","zz")
d1_mutate_out1 = mutate_fn(d1, op_ls, var_ls)
head(d1_mutate_out1)


#### two table verbs ####
# joins
d2 = data_frame(xx = seq(1,20),yy = rep(1:10,2),zz = rep(1:2,10))

join_fn <-function(d_in1,d_in2,var_vec1,var_vec2){
  d_out = d_in1 %>%
    left_join(d_in2,setNames(var_vec2,var_vec1))
}

var_vec1 = c("x","y")
var_vec2 = c("xx","yy")
d_join_out = join_fn(d1,d2,var_vec1,var_vec2)
head(d_join_out)


# everything combined (essentially, power of %>%)
d_combined_out = d1 %>%
  filter_fn(filter_crit) %>%
  group_by_fn(gp_vec) %>%
  mutate_fn(op_ls,var_vec) %>%
  select_fn(c("x","y","z")) %>%
  join_fn(.,d2,var_vec1,var_vec2) 

head(d_combined_out)  
# sources:
# http://cran.r-project.org/web/packages/dplyr/vignettes/nse.html
# http://stackoverflow.com/questions/28125816/r-standard-evalation-for-join-dplyr