将宽格式转换为长格式，然后嵌套列答案

【问题标题】：Pivoting wide to long format and then nesting columns将宽格式转换为长格式，然后嵌套列
【发布时间】：2021-04-09 19:54:35
【问题描述】：

我收到了多种格式的数据。每一行都与当前表外部的一个变量以及与该变量相关的可能值有关。我正在尝试：（1）转为长格式，（2）嵌套转轴值。

示例

library(tibble)

df_1 <-
  tribble(~key, ~values.male, ~values.female, ~values.red, ~values.green, ~value,
        "gender", 0.5, 0.5, NA, NA, NA,
        "age", NA, NA, NA, NA, "50",
        "color", NA, NA, TRUE, FALSE, NA,
        "time_of_day", NA, NA, NA, NA, "noon")

## # A tibble: 4 x 6
##   key         values.male values.female values.red values.green value
##   <chr>             <dbl>         <dbl> <lgl>      <lgl>        <chr>
## 1 gender              0.5           0.5 NA         NA           NA   
## 2 age                NA            NA   NA         NA           50   
## 3 color              NA            NA   TRUE       FALSE        NA   
## 4 time_of_day        NA            NA   NA         NA           noon

在这个例子中，我们看到gender 可以有female = 0.5 和male = 0.5。另一方面，age 只能有一个值50。从第 3 行我们了解到color 可以具有red = TRUE 和green = FALSE 和time_of_day = noon 的值。

因此，透视表应采用以下嵌套形式：

my_pivoted_df <-
  structure(
    list(
      var_name = c("gender", "age", "color", "time_of_day"),
      vals = list(
        structure(
          list(
            level = c("male", "female"),
            value = c(0.5,
                      0.5)
          ),
          row.names = c(NA, -2L),
          class = c("tbl_df", "tbl", "data.frame")
        ),
        "50",
        structure(
          list(
            level = c("red", "green"),
            value = c(TRUE,
                      FALSE)
          ),
          row.names = c(NA, -2L),
          class = c("tbl_df", "tbl", "data.frame")
        ),
        "noon"
      )
    ),
    row.names = c(NA, -4L),
    class = c("tbl_df", "tbl",
              "data.frame")
  )


## # A tibble: 4 x 2
##   var_name    vals            
##   <chr>       <list>          
## 1 gender      <tibble [2 x 2]>
## 2 age         <chr [1]>       
## 3 color       <tibble [2 x 2]>
## 4 time_of_day <chr [1]>

我试图解决这个问题

df_1 存在一些问题。首先，列的当前命名不方便。 value 之类的标头并不理想，因为它们与 pivot_longer() 的 ".value" 机制冲突。其次，df_1 有values（复数形式）当key 有多个选项时（例如，color 的“红色”和“绿色”），但value（单数）只有一个时key 的选项（例如 age）。下面是我失败的代码，灵感来自this answer。

library(tidyr)
library(dplyr)

df_1 %>%
  rename_with( ~ paste(.x, "single", sep = "."), .cols = value) %>% ## changed the header because otherwise it breaks
  pivot_longer(cols = starts_with("val"),
               names_to = c("whatevs", ".value"), names_sep = "\\.")


## # A tibble: 8 x 7
##   key         whatevs  male female red   green single
##   <chr>       <chr>   <dbl>  <dbl> <lgl> <lgl> <chr> 
## 1 gender      values    0.5    0.5 NA    NA    NA    
## 2 gender      value    NA     NA   NA    NA    NA    
## 3 age         values   NA     NA   NA    NA    NA    
## 4 age         value    NA     NA   NA    NA    50    
## 5 color       values   NA     NA   TRUE  FALSE NA    
## 6 color       value    NA     NA   NA    NA    NA    
## 7 time_of_day values   NA     NA   NA    NA    NA    
## 8 time_of_day value    NA     NA   NA    NA    noon

我缺乏一些技巧来解决这个问题。

【问题讨论】：

标签： r tidyr tibble

【解决方案1】：

实现所需结果的 tidyverse 方法可能如下所示：

library(tibble)

df_1 <-
  tribble(~key, ~values.male, ~values.female, ~values.red, ~values.green, ~value,
          "gender", 0.5, 0.5, NA, NA, NA,
          "age", NA, NA, NA, NA, "50",
          "color", NA, NA, TRUE, FALSE, NA,
          "time_of_day", NA, NA, NA, NA, "noon")

library(tidyr)
library(dplyr)
library(purrr)

df_pivoted <- df_1 %>% 
  mutate(across(everything(), as.character)) %>% 
  pivot_longer(-key, names_to = "level", names_prefix = "^values\\.", values_drop_na = TRUE) %>% 
  group_by(key) %>% 
  nest() %>% 
  mutate(data = map(data, ~ if (all(.x$level == "value")) deframe(.x) else .x))
df_pivoted
#> # A tibble: 4 x 2
#> # Groups:   key [4]
#>   key         data            
#>   <chr>       <list>          
#> 1 gender      <tibble [2 × 2]>
#> 2 age         <chr [1]>       
#> 3 color       <tibble [2 × 2]>
#> 4 time_of_day <chr [1]>

编辑在您的 cmets 中对所需结果的澄清之后，我们可以简单地摆脱 map 语句作为结尾（这基本上是为了将没有级别的类别的小标题转换为向量）并在嵌套之前添加一个 mutate 语句，用 NA 替换没有level 的类别的级别：

pivot_nest <- function(x) {
  mutate(x, across(everything(), as.character)) %>% 
    pivot_longer(-key, names_to = "level", names_prefix = "^values\\.", values_drop_na = TRUE) %>% 
    group_by(key) %>% 
    mutate(level = ifelse(all(level == "value"), NA_character_, level)) %>% 
    nest() 
}

df_pivoted <- df_1 %>% 
  pivot_nest()
df_pivoted
#> # A tibble: 4 x 2
#> # Groups:   key [4]
#>   key         data            
#>   <chr>       <list>          
#> 1 gender      <tibble [2 × 2]>
#> 2 age         <tibble [1 × 2]>
#> 3 color       <tibble [2 × 2]>
#> 4 time_of_day <tibble [1 × 2]>
df_pivoted$data
#> [[1]]
#> # A tibble: 2 x 2
#>   level value
#>   <chr> <chr>
#> 1 male  0.5  
#> 2 male  0.5  
#> 
#> [[2]]
#> # A tibble: 1 x 2
#>   level value
#>   <chr> <chr>
#> 1 <NA>  50   
#> 
#> [[3]]
#> # A tibble: 2 x 2
#>   level value
#>   <chr> <chr>
#> 1 red   TRUE 
#> 2 red   FALSE
#> 
#> [[4]]
#> # A tibble: 1 x 2
#>   level value
#>   <chr> <chr>
#> 1 <NA>  noon

df_2 <- tribble(~key, ~value, "age", "50", "income", "100000", "time_of_day", "noon")

df_pivoted2 <- df_2 %>% 
  pivot_nest()
df_pivoted2
#> # A tibble: 3 x 2
#> # Groups:   key [3]
#>   key         data            
#>   <chr>       <list>          
#> 1 age         <tibble [1 × 2]>
#> 2 income      <tibble [1 × 2]>
#> 3 time_of_day <tibble [1 × 2]>
df_pivoted2$data
#> [[1]]
#> # A tibble: 1 x 2
#>   level value
#>   <chr> <chr>
#> 1 <NA>  50   
#> 
#> [[2]]
#> # A tibble: 1 x 2
#>   level value 
#>   <chr> <chr> 
#> 1 <NA>  100000
#> 
#> [[3]]
#> # A tibble: 1 x 2
#>   level value
#>   <chr> <chr>
#> 1 <NA>  noon

【讨论】：

谢谢！有没有办法组织输出（df_pivoted），使其data 列不存在？相反，data 下的值将位于value 列中。我在想也许使用dplyr::coalesce() 作为最后一步可以解决问题，但我犹豫了。如果我只有单个值，例如 df_2 <- tribble(~key, ~value, "age", "50", "income", "100000", "time_of_day", "noon")，这可能会中断
我上面的评论还揭示了我在帖子中没有提到的情况。如果所有值都是单一的，例如评论中的 df_2 怎么办？在我的真实数据中，这种情况经常发生。那么输出在列名（key 和 data）方面会有所不同，而不是 df_1 场景（key、level、value、data 在未嵌套的输出格式中） .如何确保输出始终只有key 和value 列，如果需要，还有额外的level 列？
我找到了一些解决方案：df_pivoted %>% unnest(data) %>% {if(all(c("data", "value") %in% colnames(.))) (mutate(., value = coalesce(data, value)) %>% select(-data)) else .} %>% nest()。但我认为它不那么可读，也许不是最佳编码实践。如果有更简单/更清洁的解决方案，我会很高兴。谢谢！
嗨，艾曼。不确定我是否正确。但是看看我的编辑。基本上我不认为我们需要 unnest + ... + nest 来获得你想要的结果。

【解决方案2】：

一个选项将返回与提供的输入相同类型的输出：

df_1 %>%
 group_split(key) %>%
 map_dfr(~ select(., where(~ !all(is.na(.)))) %>%
          pivot_longer(-key, names_to = "level", names_prefix = "^values\\.") %>%
          summarise(key = first(key),
                    vals = if(n() == 1) list(value) else list(tibble(level, value))))

  key         vals            
  <chr>       <list>          
1 age         <chr [1]>       
2 color       <tibble [2 × 2]>
3 gender      <tibble [2 × 2]>
4 time_of_day <chr [1]>

输出结构：

$ key : chr [1:4] "age" "color" "gender" "time_of_day"
 $ vals:List of 4
  ..$ : chr "50"
  ..$ : tibble [2 × 2] (S3: tbl_df/tbl/data.frame)
  .. ..$ level: chr [1:2] "red" "green"
  .. ..$ value: logi [1:2] TRUE FALSE
  ..$ : tibble [2 × 2] (S3: tbl_df/tbl/data.frame)
  .. ..$ level: chr [1:2] "male" "female"
  .. ..$ value: num [1:2] 0.5 0.5
  ..$ : chr "noon"

【讨论】：

【解决方案3】：

这是一个data.table 解决方案，因为我更喜欢melt 和dcast，但应该可以轻松转移到dplyr：

library(data.table)
df <- setDT(df_1)

plouf <- melt(df,measure.vars = patterns("value")) %>%
  .[!is.na(value),.(key,level = gsub("values.","",variable),value)]

这给出了：

           key  level value
1:      gender   male   0.5
2:      gender female   0.5
3:       color    red  TRUE
4:       color  green FALSE
5:         age  value    50
6: time_of_day  value  noon

您现在可以遍历唯一的 key 值以输出您想要的内容：

keylist <- unique(plouf$key)
result <- tibble(varname = keylist,
               vals = lapply(keylist,function(x){
                 if(plouf[x == key,level[1]] != "value"){
                   plouf[x == key,.(level,value)]
                 }else{
                   plouf[x == key,value]
                 }
               })
               
)

在这里您可以获得嵌套的 tibble（其中包含 data.tables 和字符）

【讨论】：