logo标签列表

转换宽表为长表并嵌套列

rtidyrtibble
9

我得到的数据是宽格式的。每一行都涉及当前表格外部的一个变量以及与该变量相关的可能值。我正在尝试：（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。从第三行可以得知，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"机制相冲突。其次，当key有多个选项（例如color的“red”和“green”）时，df_1具有values（复数），但是当key只有一个选项时（例如age），则为value（单数）。 以下是我受此答案启发而编写的未成功代码。

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

我缺少一些处理技巧来解决这个问题。

3个回答
4

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

编辑 根据您在评论中的澄清，我们可以简单地摆脱最后的map语句(它的目的是将没有级别的类别的tibbles转换为向量)，并在嵌套之前添加一个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")，这可能会出问题。 - Emman
我的上面的评论也揭示了我在帖子中没有解决的一种情况。如果所有值都是单个的，例如在评论中的 df_2 中，那么会发生什么？在我的真实数据中，这种情况经常发生。然后输出将在列名方面有所不同（key 和 data），而不是 df_1 场景中的（在展开的输出格式中为 key、level、value、data）。如何确保输出始终只有 key 和 value 列，并在需要时添加 level 列？ - Emman
我找到了一个部分解决方案：df_pivoted %>% unnest(data) %>% {if(all(c("data", "value") %in% colnames(.))) (mutate(., value = coalesce(data, value)) %>% select(-data)) else .} %>% nest()。但我认为这不太易读，也可能不是最佳编码实践。如果有更简单/更清晰的解决方案，我会很高兴。谢谢！ - Emman
嗨Emman。不确定我是否理解正确。但是看一下我的编辑。基本上，我认为我们不需要使用unnest + ... + nest来获得您想要的结果。 - stefan
3

一种能够返回与输入类型相同的输出的选项：

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

这里是一个 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（其中包含数据表和字符）。
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接