将宽格式转换为长格式，然后嵌套列
Posted
技术标签:
【中文标题】将宽格式转换为长格式，然后嵌套列【英文标题】：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
我缺乏一些技巧来解决这个问题。
【问题讨论】：
【参考方案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 和字符）
【讨论】：
以上是关于将宽格式转换为长格式，然后嵌套列的主要内容，如果未能解决你的问题，请参考以下文章
使用 INNER JOIN LATERAL 和 postgresql 将宽表转换为长表
R语言ggplot2可视化：应用pivot_longer函数将数据从宽格式转换为长格式为dataframe的每一列绘制密度图和直方图（堆叠）
R语言配对图（pair plot）可视化：pivot_longer函数将宽格式的数据重塑为长格式并进行数据全连接（full join）可视化基本的配对图（pair plot）
R语言配对图（pair plot）可视化：pivot_longer函数将宽格式的数据重塑为长格式并进行数据全连接（full join）可视化基本的配对图（pair plot）