将宽格式转换为长格式，然后嵌套列
Pivoting wide to long format and then nesting columns
我收到了宽格式的数据。每行都与当前 table 外部的变量以及与该变量相关的可能值有关。我正在尝试：(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.
因此，旋转 table 应采用以下嵌套形式：
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 有几个问题。首先，当前的列命名不方便。 Headers 例如 value 并不理想，因为它们与 pivot_longer() 的 ".value" 机制冲突。其次，当 key 有多个选项时 df_1 有 values（复数形式）（例如 color 的“红色”和“绿色”），但是 value（单数）当 key 只有一个选项时（例如 age）。
下面是我不成功的代码，灵感来自 .
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
我缺少一些解决这个问题的技巧。
这是一个 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]
}
})
)
在这里你得到你的嵌套小标题（里面有 data.tables 和字符）
实现所需结果的 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 语句作为结尾（这基本上是为了转换类别的 tibble 而没有级别到向量）并在嵌套之前添加 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
一个选项将 return 与提供的输入具有相同类型的输出：
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"
我收到了宽格式的数据。每行都与当前 table 外部的变量以及与该变量相关的可能值有关。我正在尝试：(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.
因此，旋转 table 应采用以下嵌套形式：
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 有几个问题。首先，当前的列命名不方便。 Headers 例如 value 并不理想，因为它们与 pivot_longer() 的 ".value" 机制冲突。其次，当 key 有多个选项时 df_1 有 values（复数形式）（例如 color 的“红色”和“绿色”），但是 value（单数）当 key 只有一个选项时（例如 age）。
下面是我不成功的代码，灵感来自
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
我缺少一些解决这个问题的技巧。
这是一个 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]
}
})
)
在这里你得到你的嵌套小标题（里面有 data.tables 和字符）
实现所需结果的 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 语句作为结尾（这基本上是为了转换类别的 tibble 而没有级别到向量）并在嵌套之前添加 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
一个选项将 return 与提供的输入具有相同类型的输出：
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"