Split-apply-combine in R

Typical example of split-apply-combine - dplyr

• group_by & summarise and piviot

mtcars %>%
  group_by(cyl,gear) %>%
  summarise(hp_avg = mean(hp)) %>%
  spread(gear,hp_avg)

## # A tibble: 3 x 4
## # Groups:   cyl [3]
##     cyl   `3`   `4`   `5`
##   <dbl> <dbl> <dbl> <dbl>
## 1     4   97    76   102 
## 2     6  108.  116.  175 
## 3     8  194.   NA   300.

mtcars %>%
  group_by(cyl,gear) %>%
  summarise(hp_avg = mean(hp)) %>%
  tidyr::pivot_wider(names_from = gear,names_prefix = 'gear'
                          ,values_from = hp_avg)

## # A tibble: 3 x 4
## # Groups:   cyl [3]
##     cyl gear3 gear4 gear5
##   <dbl> <dbl> <dbl> <dbl>
## 1     4   97    76   102 
## 2     6  108.  116.  175 
## 3     8  194.   NA   300.

Split-apply-combine using purrr

Source: Advanced R

• Calculate the mean for all colmns

map_dbl(mtcars,mean)

##        mpg        cyl       disp         hp       drat         wt       qsec 
##  20.090625   6.187500 230.721875 146.687500   3.596563   3.217250  17.848750 
##         vs         am       gear       carb 
##   0.437500   0.406250   3.687500   2.812500

map_dbl(mtcars, function(x) length(unique(x)))

##  mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
##   25    3   27   22   22   29   30    2    2    3    6

#>  mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
#>   25    3   27   22   22   29   30    2    2    3    6

map_dbl(mtcars, ~ length(unique(.x)))

##  mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
##   25    3   27   22   22   29   30    2    2    3    6

#>  mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
#>   25    3   27   22   22   29   30    2    2    3    6

• To use multiple purrr functions to solve a moderately realistic problem: fitting a model to each subgroup and extracting a coefficient of the model.

mtcars %>% split(.$cyl) %>%
  map(~ lm(mpg ~ wt, data = .x)) %>% 
  map(coef) %>% 
  map_dbl(2)

##         4         6         8 
## -5.647025 -2.780106 -2.192438

#>     4     6     8 
#> -5.65 -2.78 -2.19

you could use a for loop:

by_cyl <- mtcars %>% split(.$cyl)
intercepts <- double(length(by_cyl))
for (i in seq_along(by_cyl)) {
  model <- lm(mpg ~ wt, data = by_cyl[[i]])
  intercepts[[i]] <- coef(model)[[2]]
}
intercepts

## [1] -5.647025 -2.780106 -2.192438

#> [1] -5.65 -2.78 -2.19

mtcars %>%
  split(.$cyl) %>% # from base R
  map(~ lm(mpg ~ wt + hp, data = .)) %>%
  map(summary) %>%
  map_dbl("r.squared") # shortcuts for extracting elements from a vector

##         4         6         8 
## 0.6807065 0.5889239 0.4970692

mtcars %>% split(list(.$cyl)) %>%
  map(~ lm(mpg ~ hp + am, data=.)) %>%
  map(coef) %>%
  map(function(x) data.frame(level = names(x), estimate = x,
                             stringsAsFactors = FALSE)) %>%
  bind_rows(.id = "cyl") %>%
  spread(level,estimate)

##   cyl (Intercept)       am          hp
## 1   4    31.87423 4.879098 -0.10599487
## 2   6    21.65792 1.802465 -0.02197757
## 3   8    22.21049 4.234489 -0.03687806

mtcars %>%
  select(cyl,mpg,am,hp) %>%
  split(.$cyl) %>% # from base R
  map(~ lm(mpg ~ ., data = .)) %>%
  map(summary) %>%
  map(function(x) {
    out <- as.data.frame(x$coefficients[,1, drop = FALSE])
    out$level <- row.names(out)
    out[, 2:1]
    }) %>%
  bind_rows(.id = "cyl") %>%
  spread(level,Estimate)

##   cyl (Intercept)       am          hp
## 1   4    31.87423 4.879098 -0.10599487
## 2   6    21.65792 1.802465 -0.02197757
## 3   8    22.21049 4.234489 -0.03687806

mtcars %>% 
  select(cyl,mpg,am,hp) %>%
  split(.$cyl) %>% 
  map(~ tidy(lm(mpg ~ ., data  = .))) %>%
  bind_rows(.id = "cyl") %>%
  select(cyl,term,estimate) %>%
  spread(term,estimate)

## # A tibble: 3 x 4
##   cyl   `(Intercept)`    am      hp
##   <chr>         <dbl> <dbl>   <dbl>
## 1 4              31.9  4.88 -0.106 
## 2 6              21.7  1.80 -0.0220
## 3 8              22.2  4.23 -0.0369

Map functions

mtcars %>%
  map(mean) %>%
  bind_rows() %>%
  gather()

## # A tibble: 11 x 2
##    key     value
##    <chr>   <dbl>
##  1 mpg    20.1  
##  2 cyl     6.19 
##  3 disp  231.   
##  4 hp    147.   
##  5 drat    3.60 
##  6 wt      3.22 
##  7 qsec   17.8  
##  8 vs      0.438
##  9 am      0.406
## 10 gear    3.69 
## 11 carb    2.81