在數據框上按行應用函數，與列數無關

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，但我不知道如何應用它們，因為列不是常量。

對於一行“我”我會做類似的事情：

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

歡迎任何幫助。

謝謝。

Answer 1

我建議不要在data.frame上使用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

如果數據集不是很大（即數百萬/數十億行），我們可以使用帶MARGIN=1 apply來遍歷行，使用邏輯vector作為索引對向量的names進行子集化paste它們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