0

I have a fairly simple question with an already convoluted answer (via loop), but I'm hoping someone can point me to a more elegant answer in purrr.

Basically, I'm thinking of an introduction to permutations for my students as a computational alternative to your boilerplate means to statistical inference (i.e. t and z values). In the toy example I have set up, I'm doing some grouped means (via dplyr''s group_by() and summarize()) along with permutations via modelr. I'd like to know how I can store the grouped means in the nested tibble containing the permutations.

I already have a solution via loop (that bypasses storing them in the tibble with the permutations), but I'd like to see what the solution in purrr would be.

Here's a basic example of what I'm doing.

library(tidyverse)
library(modelr)

mtcars %>%
  permute(1000, mpg) -> perm_mtcars

perm_sums <- tibble()

# convoluted loop answer, does what I want,
# but is convoluted loop and spams the R console with messages
# about "ungrouping output" because of group_by()
for (i in 1:1000) {
  perm_mtcars %>%
    slice(i) %>%
    pull(perm) %>% as.data.frame %>%
    group_by(cyl) %>%
    summarize(mean = mean(mpg)) %>%
    mutate(perm = i) -> hold_this
  perm_sums <- bind_rows(perm_sums, hold_this)
}

# what I'd like to do, based off how easy this is to pull off with running regressions,
# tidying the output, and extracting that.
perm_mtcars %>%
  mutate(groupsums = map(perm, ~summarize(???)) %>%
  # and where I might be getting ahead of myself
  pull(groupsums) %>% 
  map2_df(., seq(1, 1000), ~mutate(.x, perm = .y))

This is probably easy in purrr but purrr is mostly Greek to me right now, to borrow that expression.

1 Answer 1

2

It sounds to me like you might benefit from operating on "list-columns" and then using the tidyr::unnest function.

In this example, I use lapply to operate on the list column, but you could easily use purrr::map if you really wanted to.

library(tidyverse)
library(modelr)

groupmean <- function(x) {
  x %>% 
    as.data.frame %>%
    group_by(cyl) %>%
    summarize(mpg_mean = mean(mpg), .groups = 'drop')
}

perm_means <- mtcars %>%
  permute(1000, mpg) %>%
  mutate(perm = lapply(perm, groupmean)) %>%
  unnest(perm)

perm_means %>% head
#> # A tibble: 6 x 3
#>     cyl mpg_mean .id  
#>   <dbl>    <dbl> <chr>
#> 1     4     17.5 0001 
#> 2     6     23.6 0001 
#> 3     8     20.3 0001 
#> 4     4     20.1 0002 
#> 5     6     19.6 0002 
#> 6     8     20.3 0002

And for posterity, here's the equivalent using data.table:

library(data.table)
library(modelr)

f = function(x) as.data.table(x)[, .(mpg_mean = mean(mpg)), by=.(cyl)]
perm_mtcars = permute(mtcars, 1000, mpg)
perm_mtcars = data.table(perm_mtcars)
perm_mtcars[, perm := lapply(perm, f)][
            , perm[[1]], by=.(.id)]
#>        .id cyl mpg_mean
#>    1: 0001   6 17.21429
#>    2: 0001   4 22.52727
#>    3: 0001   8 19.61429
#>    4: 0002   6 19.92857
#>    5: 0002   4 22.40909
#>   ---                  
#> 2996: 0999   4 20.85455
#> 2997: 0999   8 19.22143
#> 2998: 1000   6 18.41429
#> 2999: 1000   4 18.20000
#> 3000: 1000   8 22.41429
1
  • 1
    Yep, that was it. Thank you kindly.
    – steve
    Oct 21, 2020 at 20:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.