如何通過將行組合成列表來折疊小標題？

Question

作為dplyr / tidyr wrangling pipe的一部分，我到達了一個看起來像這樣的小標題：

trb <-
  tibble::tribble(~person,   ~data_name,       ~data_obj,    ~some_string,
                  "chris",   "df_mtcars",      mtcars,       "abc",
                  "rachel",  "df_trees",       trees,        "efg",
                  "john",    "df_iris",        iris,         "hij",
                  "nicole",  "df_plantgrowth", PlantGrowth,  "klm",
                  "ron",     "df_women",       women,        "nop", # | notice that both ron's rows have same values
                  "ron",     "df_cars",        cars,         "nop", # | except for data_name and data_obj
                  "jillian", "df_sleep",       sleep,        "tuv")

此表描述了 6 個人和每個人喜歡的數據 object。 煩人的是， "ron"給出了 2 個數據偏好，所以我需要以某種方式將 ron 的信息折疊到一行trb中。

我的“折疊策略”是將兩個 ron 的數據首選項結合在一個命名列表中，這樣最終的 output 將是

trb_output <-
  tribble(~person,   ~.dat,                     ~some_string,
          "chris",   mtcars,                    "abc",
          "rachel",  trees,                     "efg",
          "john",    iris,                      "hij",
          "nicole",  PlantGrowth,               "klm",
          "ron",     list("df_women" = women,
                          "df_cars"  = cars),   "nop",
          "jillian", sleep,                     "tuv")

一個重要的注意事項是我必須在 pipe 上完成這項工作。 那是：

# demo to desired solution
trb_output  <- 
  trb %>%
  wrangle_this(...) %>%
  wrangle_that(...)

trb_output  
## # A tibble: 6 x 3
##   person  .dat             some_string
##   <chr>   <list>           <chr>      
## 1 chris   <df [32 x 11]>   abc        
## 2 rachel  <df [31 x 3]>    efg        
## 3 john    <df [150 x 5]>   hij        
## 4 nicole  <df [30 x 2]>    klm        
## 5 ron     <named list [2]> nop        
## 6 jillian <df [20 x 3]>    tuv    

僅使用管道可以做到這一點嗎？

Answer 1

這些對你有用嗎？

trb2 = trb %>%
  nest_by(
    person, some_string
  ) 


trb3 <- trb %>%
  group_by(
    person, some_string
  ) %>%
  summarise(
    dta = list(data_name = data_obj)
  )

編輯，這個？

trb4 <- trb %>%
  group_by(
    person, some_string
  ) %>%
  summarise(
    dta = ifelse(length(data_obj) > 1, list(as.list(setNames(data_obj,data_name ))), data_obj))
  )

Answer 2

這可能並不完美，但這似乎有效：

trb %>% 
  group_by(across(c(-data_obj, -data_name))) %>% 
  summarise(data_obj = ifelse(length(data_obj) > 1, lst(setNames(data_obj,data_name)), data_obj))

  person  some_string data_obj        
  <chr>   <chr>       <list>          
1 chris   abc         <df [32 x 11]>  
2 jillian tuv         <df [20 x 3]>   
3 john    hij         <df [150 x 5]>  
4 nicole  klm         <df [30 x 2]>   
5 rachel  efg         <df [31 x 3]>   
6 ron     nop         <named list [2]>

Answer 3

這是一種使用purrr的方法。

library(tidyverse)

trb %>%
  group_split(person) %>%
  map_dfr(function(df) {
    if (nrow(df) > 1) {
      tibble(person = unique(df$person), .dat = list(map(df$data_obj, ~.x) %>% set_names(df$data_name)), some_string = unique(df$some_string))
    } else {
      transmute(df, person, ".dat" := data_obj, some_string)
    }
  })
#> # A tibble: 6 × 3
#>   person  .dat             some_string
#>   <chr>   <list>           <chr>      
#> 1 chris   <df [32 × 11]>   abc        
#> 2 jillian <df [20 × 3]>    tuv        
#> 3 john    <df [150 × 5]>   hij        
#> 4 nicole  <df [30 × 2]>    klm        
#> 5 rachel  <df [31 × 3]>    efg        
#> 6 ron     <named list [2]> nop

^{由代表 package (v2.0.1) 於 2022 年 1 月 22 日創建}

數據：

trb <-
    tibble::tribble(~person,   ~data_name,       ~data_obj,    ~some_string,
                    "chris",   "df_mtcars",      mtcars,       "abc",
                    "rachel",  "df_trees",       trees,        "efg",
                    "john",    "df_iris",        iris,         "hij",
                    "nicole",  "df_plantgrowth", PlantGrowth,  "klm",
                    "ron",     "df_women",       women,        "nop", # | notice that both ron's rows have same values
                    "ron",     "df_cars",        cars,         "nop", # | except for data_name and data_obj
                    "jillian", "df_sleep",       sleep,        "tuv")