Creating multiple functions with dplyr non-standard evaluation

3
votes

I am trying to use mutate_() to create multiple columns where each is based on a custom function called with different inputs. I can use paste() to create multiple quoted function calls, but this doesn't work because dplyr's NSE requires formulas (~) rather than quoted strings to be able to find the function. How can I write the "dots = " line below so that the function can be found? I tried experimenting with ~, as.formula(), and lazyeval::interp(), but couldn't get any to work. My actual "prefixes" is a long vector so I don't want to separately write out the function calls for each new column. Thanks

library(dplyr)
library(lazyeval)
library(nycflights13)

myfunc = function(x, y) { x - y }

# this works
flights1 <- mutate(flights, dep_time_sched = myfunc(dep_time, dep_delay), 
                            arr_time_sched = myfunc(arr_time, arr_delay))

# this doesn't - Error: could not find function "myfunc"
prefixes <- c('dep', 'arr')
dots = as.list(paste0('myfunc(', 
                       paste0(prefixes, '_time'), ', ', 
                       paste0(prefixes, '_delay)')))
flights2 <- mutate_(flights, .dots = setNames(dots, paste0(prefixes, '_time_sched')))
2
rdplyr

2 Answers

5
votes

You could approach this by using interp with lapply to loop through your prefixes and get a list in the desired format for mutate_.

    dots = lapply(prefixes, function(var) interp(~myfunc(x, y), 
                                        .values = list(x = as.name(paste0(var, "_time")),
                                                    y = as.name(paste0(var, "_delay")))))
    dots

[[1]]
~myfunc(dep_time, dep_delay)
<environment: 0x0000000019e51f00>

[[2]]
~myfunc(arr_time, arr_delay)
<environment: 0x0000000019f1e5b0>

This gives the same results as your flights1.

flights2 = mutate_(flights, .dots = setNames(dots, paste0(prefixes, '_time_sched')))
identical(flights1, flights2)
[1] TRUE
3
votes

My actual "prefixes" is a long vector so I don't want to separately write out the function calls for each new column.

If that's the case, you should really transform your data to long format. To clarify what I mean, let's look at a smaller example:

mydat <- flights[1:5, c(paste0(prefixes,"_time"), paste0(prefixes,"_delay"))]
#   dep_time arr_time dep_delay arr_delay
#      (int)    (int)     (dbl)     (dbl)
# 1      517      830         2        11
# 2      533      850         4        20
# 3      542      923         2        33
# 4      544     1004        -1       -18
# 5      554      812        -6       -25

library(data.table)

longdat <- setDT(mydat)[, .( 
    pref  = rep(prefixes, each=.N), 
    time  = unlist(mget(paste0(prefixes,"_time"))),
    delay = unlist(mget(paste0(prefixes,"_delay")))
)]

longdat[, time_sched := myfunc(time, delay) ]
#     pref time delay time_sched
#  1: dep_  517     2        515
#  2: dep_  533     4        529
#  3: dep_  542     2        540
#  4: dep_  544    -1        545
#  5: dep_  554    -6        560
#  6: arr_  830    11        819
#  7: arr_  850    20        830
#  8: arr_  923    33        890
#  9: arr_ 1004   -18       1022
# 10: arr_  812   -25        837

Besides being simpler, calling the function a single time takes advantage of its vectorization.

While I used data.table to construct longdat, I'm sure there's a tool to do the same thing in the tidyr package (companion to dplyr). Similarly, the addition of the time_sched column is just a mutate.

Alternative ways of reshaping Thanks to @akrun, here is another way to get to longdat, using melt function syntax that will be available in the next version of data.table (1.9.8, not released yet):

longdat <- melt(mydat, 
    measure        = patterns('time$','delay$'), 
    variable.name  = "pref", 
    value.name     = c('time', 'delay')
)[, pref := prefixes[pref]]

or, also thanks to @akrun, here is a way to reshape that automatically constructs the prefixes, given the suffixes (time and delay), using @AnandaMahto's splitstackshape package:

library(splitstackshape)
longdat <- merged.stack(transform(mydat, ind=1:nrow(mydat)), 
  var.stubs = c('_time', '_delay'), 
  sep = 'var.stubs', 
  atStart = FALSE)