在数据帧上逐行应用函数，与列数无关

Question

我想在 data.frame 上按行应用函数，以根据行中的值连接列标题。

df 
      A     B
1  TRUE  TRUE
2 FALSE  TRUE
3 FALSE FALSE

      A     B Result
1  TRUE  TRUE A / B
2 FALSE  TRUE   B
3 FALSE FALSE NA

我使用 mutate() 和 rowwise() 阅读了有关 dplyr 的信息，但我不知道如何应用它们，因为列不是常量。

对于一行“i”，我会这样做：

paste(names(df)[as.logical(df[i,])], collapse = ' / ')

欢迎任何帮助。

谢谢。

Answer 1

我建议不要在 data.frames 上使用 apply（由于矩阵转换），尤其是边距为 1（R 中的行操作很慢）。相反，您也可以很容易地在没有矩阵转换的列上对其进行矢量化，这是一个示例

res <- rep(NA_character_, nrow(df))
for(j in names(df)) res[df[[j]]] <- paste(res[df[[j]]], j, sep = " / ")
sub("NA / ", "", res, fixed = TRUE)
# [1] "A / B" "B"     NA   

---

以下是一个显示 ~X16 改进的基准

set.seed(123)
N <- 1e5
df <- as.data.frame(matrix(sample(c(TRUE, FALSE), N*2, replace = TRUE), ncol = 2))

Rowwise <- function(df) apply(df, 1, FUN = function(x) paste(names(x)[x], collapse=" / "))

Colwise <- function(df) {
  res <- rep(NA_character_, nrow(df));
  for(j in names(df)) res[df[[j]]] <- paste(res[df[[j]]], j, sep = " / ");
  sub("NA / ", "", res, fixed = TRUE)
} 

microbenchmark::microbenchmark(Rowwise(df), Colwise(df))
# Unit: milliseconds
#        expr       min        lq      mean    median        uq      max neval cld
# Rowwise(df) 458.54526 502.43496 545.47028 548.42042 584.18000 669.6161   100   b
# Colwise(df)  27.11235  27.83873  34.65596  29.05341  32.83664 137.7905   100  a 

Answer 2

如果数据集不是很大（即数百万/数十亿行），我们可以使用apply 和MARGIN=1 循环遍历行，使用逻辑vector 作为向量的子集names index 和paste 他们在一起。在一行中编写代码更容易。

df$Result <- apply(df, 1, FUN = function(x) paste(names(x)[x], collapse=" / "))

---

但是，如果我们有一个大数据集，另一种选择是创建一个键/值对并通过匹配替换值，它比上述解决方案更快。

v1 <- do.call(paste, df)
unname(setNames(c("A / B", "B", "A", NA), do.call(paste, 
          expand.grid(rep(list(c(TRUE, FALSE)), 2))))[v1])
#[1] "A / B" "B"     NA   

---

或者我们可以使用算术运算来做到这一点

c(NA, "A", "B", "A / B")[1 + df[,1] + 2 * df[,2]]
#[1] "A / B" "B"     NA  

基准测试

使用@DavidArenburg 的数据集并包括此处发布的两个解决方案（将“df”的列名更改为“A”和“B”）

newPaste <- function(df) {
    v1 <- do.call(paste, df)
  unname(setNames(c("A / B", "B", "A", NA), do.call(paste, 
      expand.grid(rep(list(c(TRUE, FALSE)), 2))))[v1])
}

arith <- function(df){
     c(NA, "A", "B", "A / B")[1 + df[,1] + 2 * df[,2]]
}

microbenchmark::microbenchmark(Rowwise(df), Colwise(df), newPaste(df),arith(df))
#Unit: milliseconds
#        expr        min        lq      mean     median         uq       max neval
#  Rowwise(df) 398.024791 453.68129 488.07312 481.051431 523.466771 688.36084   100
#  Colwise(df)  25.361609  28.10300  34.20972  30.952365  35.885061  95.92575   100
# newPaste(df)  65.777304  69.07432  82.08602  71.606890  82.232980 176.66516   100
#   arith(df)   1.790622   1.88339   4.74913   2.027674   4.753279  58.50942   100