Skip to content

Instantly share code, notes, and snippets.

@tjmahr
Created April 28, 2020 20:14
Show Gist options
  • Save tjmahr/482e458e7accfbca95704afec5bd4387 to your computer and use it in GitHub Desktop.
Save tjmahr/482e458e7accfbca95704afec5bd4387 to your computer and use it in GitHub Desktop.
super_split <- function(data, ...) {
  dots <- rlang::quos(...)
  for (var in seq_along(dots)) {
    var_name <- rlang::as_name(dots[[var]])
    data <- purrr:::map_depth(
      data, 
      var - 1, 
      function(xs) split(xs, xs[var_name])
    ) 
  }
  data
}

# split by the `wool` column then split each of those by `tension`
super_split(warpbreaks, wool, tension)
#> $A
#> $A$L
#>   breaks wool tension
#> 1     26    A       L
#> 2     30    A       L
#> 3     54    A       L
#> 4     25    A       L
#> 5     70    A       L
#> 6     52    A       L
#> 7     51    A       L
#> 8     26    A       L
#> 9     67    A       L
#> 
#> $A$M
#>    breaks wool tension
#> 10     18    A       M
#> 11     21    A       M
#> 12     29    A       M
#> 13     17    A       M
#> 14     12    A       M
#> 15     18    A       M
#> 16     35    A       M
#> 17     30    A       M
#> 18     36    A       M
#> 
#> $A$H
#>    breaks wool tension
#> 19     36    A       H
#> 20     21    A       H
#> 21     24    A       H
#> 22     18    A       H
#> 23     10    A       H
#> 24     43    A       H
#> 25     28    A       H
#> 26     15    A       H
#> 27     26    A       H
#> 
#> 
#> $B
#> $B$L
#>    breaks wool tension
#> 28     27    B       L
#> 29     14    B       L
#> 30     29    B       L
#> 31     19    B       L
#> 32     29    B       L
#> 33     31    B       L
#> 34     41    B       L
#> 35     20    B       L
#> 36     44    B       L
#> 
#> $B$M
#>    breaks wool tension
#> 37     42    B       M
#> 38     26    B       M
#> 39     19    B       M
#> 40     16    B       M
#> 41     39    B       M
#> 42     28    B       M
#> 43     21    B       M
#> 44     39    B       M
#> 45     29    B       M
#> 
#> $B$H
#>    breaks wool tension
#> 46     20    B       H
#> 47     21    B       H
#> 48     24    B       H
#> 49     17    B       H
#> 50     13    B       H
#> 51     15    B       H
#> 52     15    B       H
#> 53     16    B       H
#> 54     28    B       H

str(
  super_split(warpbreaks, wool, tension), 
  max.level = 2
)
#> List of 2
#>  $ A:List of 3
#>   ..$ L:'data.frame':    9 obs. of  3 variables:
#>   ..$ M:'data.frame':    9 obs. of  3 variables:
#>   ..$ H:'data.frame':    9 obs. of  3 variables:
#>  $ B:List of 3
#>   ..$ L:'data.frame':    9 obs. of  3 variables:
#>   ..$ M:'data.frame':    9 obs. of  3 variables:
#>   ..$ H:'data.frame':    9 obs. of  3 variables:

Created on 2020-04-28 by the reprex package (v0.3.0)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment