在嵌套的 tibble 中分組匯總（帶有排列）

Question

我有一個相當簡單的問題，答案已經很復雜（通過循環），但我希望有人能指出我在purrr更優雅的答案。

基本上，我正在考慮為我的學生介紹排列作為您的樣板方法的計算替代方案以進行統計推斷（即t和z值）。 在我設置的玩具示例中，我正在執行一些分組方法（通過dplyr' ' 的group_by()和modelr summarize() ）以及通過modelr進行的排列。 我想知道如何將分組均值存儲在包含排列的嵌套 tibble 中。

我已經有一個通過循環的解決方案（繞過將它們存儲在排列的purrr ），但我想看看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 ，您可以輕松使用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的等效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