将重复的列集收集到单个列中

Gather duplicate column sets into single columns

这里已经解决了收集多组列的问题:Gather multiple sets of columns,但在我的例子中,列不是唯一的。

我有以下数据:

input <- data.frame(
  id = 1:2, 
  question = c("a", "b"),
  points = 0,
  max_points = c(3, 5),
  question = c("c", "d"),
  points = c(0, 20),
  max_points = c(5, 20),
  check.names = F,
  stringsAsFactors = F
)
input
#>   id question points max_points question points max_points
#> 1  1        a      0          3        c      0          5
#> 2  2        b      0          5        d     20         20

第一列是一个id,然后我有很多重复的列(原始数据集有133列):

  1. 问题标识符
  2. 给分
  3. 最高分

我想以这种结构结束:

expected <- data.frame(
  id = c(1, 2, 1, 2),
  question = letters[1:4],
  points = c(0, 0, 0, 20),
  max_points = c(3, 5, 5, 20),
  stringsAsFactors = F
)
expected
#>   id question points max_points
#> 1  1        a      0          3
#> 2  2        b      0          5
#> 3  1        c      0          5
#> 4  2        d     20         20

我尝试了几种方法:

两者都没有提供所需的输出。此外,如果列比此处显示的多,gather 将不再起作用,因为重复列太多。

作为解决方法,我试过这个:

# add numbers to make col headers "unique"
names(input) <- c("id", paste0(1:(length(names(input)) - 1), names(input)[-1]))

# gather, remove number, spread
input %>% 
  gather(key, val, -id) %>%
  mutate(key = stringr::str_replace_all(key, "[:digit:]", "")) %>%
  spread(key, val)

这给出了一个错误:Duplicate identifiers for rows (3, 9), (4, 10), (1, 7), (2, 8)

这里已经讨论过这个问题:Unexpected behavior with tidyr,但我不知道 why/how 我应该添加另一个标识符。这很可能不是主要问题,因为我可能应该以不同的方式处理整个问题。

如何解决我的问题,最好使用 tidyr 或 base?我不知道如何使用data.table,但如果有简单的解决方案,我也会接受。

试试这个:

do.call(rbind,
        lapply(seq(2, ncol(input), 3), function(i){
          input[, c(1, i:(i + 2))]
              })
        )

#   id question points max_points
# 1  1        a      0          3
# 2  2        b      0          5
# 3  1        c      0          5
# 4  2        d     20         20

您可能需要阐明您希望如何处理 ID 列,但也许是这样的?

runme <- function(word , dat){
     grep( paste0("^" , word , "$") , names(dat)) 
}

l <- mapply( runme ,  unique(names(input)) , list(input) )
l2 <- as.data.frame(l)

output <- data.frame()
for (i in 1:nrow(l2)) output <- rbind( output , input[,  as.numeric(l2[i,])  ])

不确定它在处理不同数量的重复列方面有多稳健,但它适用于您的测试数据,并且如果您的列重复次数相同,它应该也能正常工作。

不使用 lapply 实现相同目标的另一种方法:

我们首先抓住所有问题的列,max_points,然后点,然后我们将每个列单独融合,然后 cbind 将它们全部融合在一起。

library(reshape2)

questions <- input[,c(1,c(1:length(names(input)))[names(input)=="question"])]
points <- input[,c(1,c(1:length(names(input)))[names(input)=="points"])]
max_points <- input[,c(1,c(1:length(names(input)))[names(input)=="max_points"])]

questions_m <- melt(questions,id.vars=c("id"),value.name = "questions")[,c(1,3)]
points_m <- melt(points,id.vars=c("id"),value.name = "points")[,3,drop=FALSE]
max_points_m <- melt(max_points,id.vars=c("id"),value.name = "max_points")[,3, drop=FALSE]

res <- cbind(questions_m,points_m, max_points_m)
res
  id questions points max_points
1  1         a      0          3
2  2         b      0          5
3  1         c      0          5
4  2         d     20         20

在 data.table 中执行此操作的惯用方法非常简单:

library(data.table)
setDT(input)

res = melt(
  input, 
  id = "id", 
  meas = patterns("question", "^points$", "max_points"), 
  value.name = c("question", "points", "max_points")
)


   id variable question points max_points
1:  1        1        a      0          3
2:  2        1        b      0          5
3:  1        2        c      0          5
4:  2        2        d     20         20

您会得到名为 "variable" 的额外列,但如果需要,您可以随后使用 res[, variable := NULL] 删除它。