Purrr package for R is good for performance

灰太狼 2022-06-16 12:59 211阅读 0赞

## Hadley’s project purrr ##

So, if you haven’t seen it, there’s some goodness over at [github][] where Hadley Wickham has been  
working to fill in some more of the holes in R should one want a more functional programming language  
set of constructs to work with.

But, in true Hadley style, in addition to all of the functional programming syntactical goodness, the code is fast as well.

——more——

To install the package, which is not on CRAN as of this post, one need simply

`# install.packages("devtools") devtools::install_github("hadley/purrr")`

Here is an example using purrr. The example sets to split a data frame into pieces, fit a model to each piece, summarise and extract R^2.

library(purrr)
     
    mtcars %>%
      split(.$cyl) %>%
      map(~ lm(mpg ~ wt, data = .)) %>%
      map(summary) %>%
      map_dbl("r.squared")

Here is another, more complicated example. It generates 100 random test-training splits, fits a model to each training split then evaluates based on the test split:

library(dplyr)
    randomgroup <- function(n, probs) { 
      probs <- probs / sum(probs)
      g <- findInterval(seq(0, 1, length = n), c(0, cumsum(probs)),
        rightmost.closed = TRUE)
      names(probs)[sample(g)]
    }
    partition <- function(df, n, probs) { 
      replicate(n, split(df, randomgroup(nrow(df), probs)), FALSE) %>%
        zip() %>%
        asdataframe()
    }
     
    msd <- function(x, y) sqrt(mean((x - y) ^ 2))
     
    # Genearte 100 rbootandom test-training splits
    boot <- partition(mtcars, 100, c(test = 0.8, training = 0.2))
    boot
     
    boot <- boot %>% mutate(
      # Fit the models
      models = map(training, ~ lm(mpg ~ wt, data = mtcars)),
      # Make predictions on test data
      preds = map2(models, test, predict),
      diffs = map2(preds, test %>% map("mpg"), msd)
    )
     
    # Evaluate mean-squared difference between predicted and actual
    mean(unlist(boot$diffs))

As Hadley writes about the philosophy for purrr, the goal is not to try and simulate Haskell in R: purrr does not implement currying or destructuring binds or pattern matching. The goal is to give you similar expressiveness to an FP language, while allowing you to write code that looks and works like R.

*  Instead of point free style, use the pipe, %>%, to write code that can be read from left to right.
 *  Instead of currying, we use … to pass in extra arguments.
 *  Anonymous functions are verbose in R, so we provide two convenient shorthands. For predicate functions, ~ .x + 1 is equivalent to function(.x) .x + 1. For chains of transformations functions, . %>% f() %>% g() is equivalent to function(.) . %>% f() %>% g().
 *  R is weakly typed, so we can implement general zip(), rather than having to specialise on the number of arguments. (That said I still provide map2() and map3() since it’s useful to clearly separate which arguments are vectorised over).
 *  R has named arguments, so instead of providing different functions for minor variations (e.g. detect() and detectLast()) I use a named argument, .first. Type-stable functions are easy to reason about so additional arguments will never change the type of the output.

## Timings ##

OK, so how about some measurements of performance. Let us create a 10 x 10,000 matrix with one row for each combination of the levels in f.

# Some data
    nvars <- 10000
    nsamples <- 500
    sample_groups <- 5
    MAT <- replicate(nvars, runif(n=nsamples))
     
    # And a grouping vector:
     
    f <- rep_len(1:sample_groups, nsamples)
    f <- LETTERS[f]

In pursuit of this, the first task is to calculate the mean for each group for all columns. First, a high order function in R  
leveraging helpers.

# Settings
    aggr_FUN  <- mean
    combi_FUN <- function(x,y) "/"(x,y) 
     
    # helper function
    pasteC <- function(x,y) paste(x,y,sep=" - ")
     
    # aggregate
    system.time({
         
    temp2 <- aggregate(. ~ class, data = cbind.data.frame(class=f,MAT), aggr_FUN)
    })

which yields

`user system elapsed 13.457 1.187 14.766`

Here’s an approach with reshape

# reshape2
    library(reshape2)
    system.time({
         
    temp3 <- recast(data.frame(class=f,MAT),class ~ variable,id.var="class",aggr_FUN)
    })

which has

`user system elapsed 1.945 0.454 2.525`

7x faster. Finally, here is a purrr approach. Firstly, look at the elegance of the representation. Then look at the timings.

# purrr 
    library(purrr)
    system.time({
         
        tmp <- data.frame(class = f, MAT) %>%
            slicerows("class") %>%
            byslice(map, aggr_FUN)
    })

`user system elapsed 0.512 0.043 0.569`

Another 4x speedup, or 28x faster than the original approach with aggregate. Impressive. The purrr work deserves to be  
looked at and picked up by R devs, as it is both elegant and performant.

All of this has resulted in

tmp[,1:10]
    Source: local data frame [5 x 10]
     
      class        X1        X2        X3        X4        X5        X6        X7        X8        X9
    1     A 0.5194124 0.5066943 0.5326734 0.5042122 0.4190162 0.4882796 0.4947138 0.4701085 0.4982535
    2     B 0.5267829 0.4545410 0.4883640 0.4894278 0.4672661 0.4477106 0.4832262 0.4583598 0.4767773
    3     C 0.4703151 0.4994032 0.4842406 0.4960585 0.5276044 0.4817216 0.4853307 0.5331066 0.4881527
    4     D 0.5139762 0.5318747 0.5071466 0.4657025 0.4972884 0.4815889 0.5049296 0.4685044 0.5535197
    5     E 0.5439962 0.4479991 0.4640088 0.4946168 0.4716724 0.5370196 0.5011706 0.5219855 0.5160875

[github]: https://github.com/hadley/purrr