在嵌套的小标题中分组汇总（带有排列）

Question

我有一个相当简单的问题，答案已经很复杂（通过循环），但我希望有人能在purrr 中指出一个更优雅的答案。

基本上，我正在考虑为我的学生介绍排列，作为统计推断的样板方法（即 t 和 z 值）的计算替代方法。在我设置的玩具示例中，我正在做一些分组方法（通过dplyr' 的group_by() 和summarize()）以及通过modelr 的排列。我想知道如何将分组均值存储在包含排列的嵌套小标题中。

我已经有一个通过循环的解决方案（绕过将它们存储在带有排列的小标题中），但我想看看purrr 中的解决方案是什么。

这是我正在做的一个基本示例。

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))

这在purrr 中可能很容易，但purrr 现在对我来说主要是希腊语，借用那个表达方式。

Answer 1

在我看来，您可能会受益于对“列表列”进行操作，然后使用 tidyr::unnest 函数。

在这个例子中，我使用lapply对列表列进行操作，但如果你真的想使用purrr::map，你可以很容易地使用。

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

为了后代，这里是使用 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