How to collapse a tibble by combining rows into a list?

As part of a dplyr/tidyr wrangling pipe, I arrived at a tibble that looks like that:

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

This table describes 6 people and the data object each person prefers. Annoyingly, "ron" gave 2 data preferences, so I need to somehow collapse ron's info into one row of trb.

My "collapsing strategy" is to combine both ron's data preferences inside a named list such that the final output will be

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

One critical note is that I must get this done on the pipe. That is:

# 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    

Is this possible to do using just piping?

Solution 1:

Do either of these work for you?

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


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

Edit, this one?

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

Solution 2:

This may not be perfect, but this seems to work:

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

Solution 3:

Here's a way of doing it with 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

^{Created on 2022-01-22 by the reprex package (v2.0.1)}

Edit: More general approach using across instead of manually calling unique in each column.

trb %>%
  group_split(person) %>%
  map_dfr(function(df) {
    if (nrow(df) > 1) {
      other_cols <- summarise(df, across(-c(data_obj, data_name), ~ unique(.)))
      bind_cols(other_cols, tibble(.dat = list(map(df$data_obj, ~.x) %>% set_names(df$data_name))))
    } else {
      select(df, -c(data_obj, data_name, some_string), ".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

^{Created on 2022-01-22 by the reprex package (v2.0.1)}

data:

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