r - 当按其他数据框变量分组时，如何生成包含命名向量的列表列？

Question

有了一个数据框，我想生成一个新的列表列，其中包含命名向量(每行一个向量)。每个向量都从另外 2 个数据框列中派生出其名称和值。但我被困住了，因为我想这样做:

• 按组
• 尽可能提高计算效率

示例

让我们使用 {ggplot2} 中的 mpg 数据集来说明按组原理。我想将 cty 和 hwy 值对集中在一起，并按 manufacturer 和 year 的不同组合进行分组。所以我们可以这样做:

library(ggplot2)
library(dplyr, warn.conflicts = FALSE)
library(tidyr)

my_mpg <-
  mpg %>%
  select(manufacturer, year, cty, hwy)

via_tidyr_nest <- 
  my_mpg %>%
  group_by(manufacturer, year) %>%
  nest()

via_tidyr_nest
#> # A tibble: 30 x 3
#> # Groups:   manufacturer, year [30]
#>    manufacturer  year data             
#>    <chr>        <int> <list>           
#>  1 audi          1999 <tibble [9 x 2]> 
#>  2 audi          2008 <tibble [9 x 2]> 
#>  3 chevrolet     2008 <tibble [12 x 2]>
#>  4 chevrolet     1999 <tibble [7 x 2]> 
#>  5 dodge         1999 <tibble [16 x 2]>
#>  6 dodge         2008 <tibble [21 x 2]>
#>  7 ford          1999 <tibble [15 x 2]>
#>  8 ford          2008 <tibble [10 x 2]>
#>  9 honda         1999 <tibble [5 x 2]> 
#> 10 honda         2008 <tibble [4 x 2]> 
#> # ... with 20 more rows

^{由 reprex package 于 2021 年 9 月 27 日创建(v0.3.0)}

这是完美的，除了我不需要嵌套的 tibble 而是嵌套的命名向量。 (原因:一旦我们将输出作为对象存储在环境中，命名向量版本的大小就比嵌套 tibble 版本更轻)。

有效但不受欢迎的解决方案将采用via_tidyr_nest并将嵌套小标题转换为命名向量。

expected_output <-
  via_tidyr_nest %>%
  mutate(desired_named_vec = map(.x = data, .f = ~pull(.x, cty, hwy))) %>%
  select(-data)

expected_output
#> # A tibble: 30 x 3
#> # Groups:   manufacturer, year [30]
#>    manufacturer  year desired_named_vec
#>    <chr>        <int> <list>           
#>  1 audi          1999 <int [9]>        
#>  2 audi          2008 <int [9]>        
#>  3 chevrolet     2008 <int [12]>       
#>  4 chevrolet     1999 <int [7]>        
#>  5 dodge         1999 <int [16]>       
#>  6 dodge         2008 <int [21]>       
#>  7 ford          1999 <int [15]>       
#>  8 ford          2008 <int [10]>       
#>  9 honda         1999 <int [5]>        
#> 10 honda         2008 <int [4]>        
#> # ... with 20 more rows

这是不受欢迎的，因为它通过绕道实现了所需的输出。首先它创建一个 tibble，然后转换为一个命名向量。虽然在此示例中处理时间可以忽略不计，但实际上我有一个很大的数据集(1000 万行)。因此，添加任何额外的步骤都是昂贵的。相反，我希望以尽可能少的步骤达到 expected_output。

---

一次不成功的尝试:

library(purrr)

via_summarise_map2_setnames <- 
  my_mpg %>%
  group_by(manufacturer, year) %>%
  summarise(named_vec = map2(.x = cty, .y = hwy, .f = ~setNames(.x, .y))) 
#> `summarise()` has grouped output by 'manufacturer', 'year'. You can override using the `.groups` argument.

via_summarise_map2_setnames
#> # A tibble: 234 x 3
#> # Groups:   manufacturer, year [30]
#>    manufacturer  year named_vec
#>    <chr>        <int> <list>   
#>  1 audi          1999 <int [1]>
#>  2 audi          1999 <int [1]>
#>  3 audi          1999 <int [1]>
#>  4 audi          1999 <int [1]>
#>  5 audi          1999 <int [1]>
#>  6 audi          1999 <int [1]>
#>  7 audi          1999 <int [1]>
#>  8 audi          1999 <int [1]>
#>  9 audi          1999 <int [1]>
#> 10 audi          2008 <int [1]>
#> # ... with 224 more rows

---

知道如何直接从 my_mpg 到 expected_output 而不在中间创建 tibble 吗？

---

编辑

---

只是针对这个问题的一般想法。我了解 tidyr::nest() 的默认行为是返回嵌套的 tibble。但我没有找到任何关于这个决定的讨论。换句话说，如果我们想自己选择嵌套数据的类怎么办？它可以是默认的tibble，也可以是data.frame、data.table、命名向量等等。无论用户选择什么作为输出类。

Answer 1

这里有一个方法。在设置名称之前，将 cty 和 hwy 强制转换为 "list"。看来有效。

library(purrr)
library(dplyr)

data(mpg, package = "ggplot2")
my_mpg <-
  mpg %>%
  select(manufacturer, year, cty, hwy)

my_mpg %>%
  group_by(manufacturer, year) %>%
  summarise(named_vec = map2(list(cty), list(hwy), ~set_names(.x, .y)))
#`summarise()` has grouped output by 'manufacturer'. You can override using the `.groups` argument.
## A tibble: 30 x 3
## Groups:   manufacturer [15]
#   manufacturer  year named_vec 
#   <chr>        <int> <list>    
# 1 audi          1999 <int [9]> 
# 2 audi          2008 <int [9]> 
# 3 chevrolet     1999 <int [7]> 
# 4 chevrolet     2008 <int [12]>
# 5 dodge         1999 <int [16]>
# 6 dodge         2008 <int [21]>
# 7 ford          1999 <int [15]>
# 8 ford          2008 <int [10]>
# 9 honda         1999 <int [5]> 
#10 honda         2008 <int [4]> 
## … with 20 more rows

---

基准

由于该问题是一个性能问题，因此这里是 4 个建议解决方案的基准，到目前为止，该问题的 Nicolas2's , Till's和上面我的。

f <- function(X) {
  X %>%
    group_by(manufacturer, year) %>%
    nest() %>%
    mutate(desired_named_vec = map(.x = data, .f = ~pull(.x, cty, hwy))) %>%
    select(-data)
}

g <- function(X) {
  df1 <- X %>% group_by(manufacturer, year)
  df2 <- attr(df1,"groups")
  Map(function(rows) {
    r <- df1[rows,"cty",drop=TRUE]
    setNames(r,df1[rows,"hwy",drop=TRUE])
  },
  df2$.rows
  ) -> l
  data.frame(manufacturer=df2$manufacturer,year=df2$year,named_vector=I(l))
}
h <- function(X){
  X %>%
    group_by(manufacturer, year) %>%
    summarise(named_vec = map2(list(cty), list(hwy), ~set_names(.x, .y)), .groups = "drop")
}
i <- function(X){
  X |>
    select(manufacturer, year, cty, hwy) |>
    group_by(manufacturer, year)  |>
    group_modify(\(x, ...) tibble(res = list(deframe(x))))
}

mb <- microbenchmark(
  Emman = f(my_mpg),
  Nicolas2 = g(my_mpg),
  Rui = h(my_mpg),
  Till = i(my_mpg)
)
print(mb, unit = "relative", order = "median")
#Unit: relative
#     expr      min       lq     mean   median       uq      max neval  cld
#      Rui 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000   100 a   
# Nicolas2 1.527957 1.468524 1.478286 1.482185 1.471565 1.724004   100  b  
#    Emman 4.504185 4.230921 4.215643 4.234087 4.148188 4.170934   100   c 
#     Till 6.264028 5.813678 5.883107 5.810876 5.744080 5.666524   100    d