按公共列表元素名称绑定数据帧列表



我有以下data.frame(实际上它要大得多(:

df <- data.frame(
    question = c("Q1",  "Q1", "Q2_1", "Q2_1", "Q2_2", "Q2_2", "Q3_1", "Q3_2", "Q3_3", "Q3_4", "Q4"),
    label    = c("yes", "no", "yes",  "no",   "yes",  "no",   "yes",  "yes",  "yes",  "yes",  "x"),
    value   =  c("1",   "2",  "3",    "1",    "3",    "2",    "2",    "3",    "2",    "2",    "2")
)

我想按问题将其拆分为data.frames list

l <- split(df, df$question)
l
# $`Q1`
#   question label value
# 1       Q1   yes     1
# 2       Q1    no     2
# $Q2_1
#   question label value
# 3     Q2_1   yes     3
# 4     Q2_1    no     1
# $Q2_2
#   question label value
# 5     Q2_2   yes     3
# 6     Q2_2    no     2
# $Q3_1
#   question label value
# 7     Q3_1   yes     2
# $Q3_2
#   question label value
# 8     Q3_2   yes     3
# $Q3_3
#    question label value
# 9      Q3_3   yes     2
# 10     Q3_3   yes     2
# $Q4
#    question label value
# 11       Q4     x     2 

对于共享相同问题的列表名称,我希望尽可能简洁地将它们cbind在一起。

最终结果将是:

l
    # $`Q1`
    #   question label value
    # 1       Q1   yes     1
    # 2       Q1    no     2
    # $`Q2`
    #   question label value question label value
    # 3     Q2_1   yes     3     Q2_2   yes     3
    # 4     Q2_1    no     1     Q2_2    no     2
    # $`Q3`
    #   question label value question label value question label value
    # 1     Q3_1   yes     2     Q3_2   yes     3     Q3_3   yes     2
    # 2     Q3_1   yes     2     Q3_2   yes     3     Q3_3   yes     2
    # $Q4
    #    question label value
    # 11       Q4     x     2   

理想情况下,寻找基本或数据表解决方案。

我们可以使用两个split

lapply(split(df, sub('_\d+', '', df$question)),
       function(x) do.call(cbind, split(x, x$question, drop = TRUE)))

或带map

library(tidyverse)
df %>%
  split(sub('_\d+', '', .$question)) %>%
  map(~ split(., .$question, drop = TRUE) %>% 
        do.call(cbind, .))

输出:

$Q1
  Q1.question Q1.label Q1.value
1          Q1      yes        1
2          Q1       no        2
$Q2
  Q2_1.question Q2_1.label Q2_1.value Q2_2.question Q2_2.label Q2_2.value
3          Q2_1        yes          3          Q2_2        yes          3
4          Q2_1         no          1          Q2_2         no          2
$Q3
  Q3_1.question Q3_1.label Q3_1.value Q3_2.question Q3_2.label Q3_2.value Q3_3.question Q3_3.label Q3_3.value
7          Q3_1        yes          2          Q3_2        yes          3          Q3_3        yes          2
  Q3_4.question Q3_4.label Q3_4.value
7          Q3_4        yes          2
$Q4
   Q4.question Q4.label Q4.value
11          Q4        x        2

基本选项将首先通过仅保留 Q1、Q2、Q3 来更改列表的names...对于每个列表,然后收集具有相似名称的所有列表并cbind它们。

names(l) <- sub("(Q\d+)_.*", "\1", names(l))
lapply(unique(names(l)), function(x) do.call(cbind, l[names(l) == x]))

#[[1]]
#  Q1.question Q1.label Q1.value
#1          Q1      yes        1
#2          Q1       no        2
#[[2]]
#  Q2.question Q2.label Q2.value Q2.question Q2.label Q2.value
#3        Q2_1      yes        3        Q2_2      yes        3
#4        Q2_1       no        1        Q2_2       no        2
#[[3]]
#  Q3.question Q3.label Q3.value Q3.question Q3.label Q3.value Q3.question Q3.label
#7        Q3_1      yes        2        Q3_2      yes        3        Q3_3      yes
#  Q3.value Q3.question Q3.label Q3.value
#7        2        Q3_4      yes        2
#[[4]]
#   Q4.question Q4.label Q4.value
#11          Q4        x        2

最新更新