Question

我有一个像这样的稀疏设计矩阵状数据框：

  BRDirect BRExclusive MagnetY MagnetN Reasons
1     0.00        0.17    0.08    0.00      NA
2     0.00        0.00    0.08    0.00      NA
3     0.00        0.17    0.00    0.06      NA
4     0.29        0.00    0.00    0.06      NA
5     0.29        0.00    0.00    0.06      NA
6     0.00        0.00    0.00    0.06      NA

我想编写一个函数，该函数可应用于每一行，以用该行中的所有非零值以及该值的列名（由“ /”分隔）填充Reasons列。所以，

  BRDirect BRExclusive MagnetY MagnetN                             Reasons
1     0.00        0.17    0.08    0.00 BRExclusive (0.17) / MagnetY (0.08)
2     0.00        0.00    0.08    0.00                      MagnetY (0.08)
3     0.00        0.17    0.00    0.06 BRExclusive (0.17) / MagnetN (0.06)
4     0.29        0.00    0.00    0.06    BRDirect (0.29) / MagnetN (0.06)
5     0.29        0.00    0.00    0.06    BRDirect (0.29) / MagnetN (0.06)
6     0.00        0.00    0.00    0.06                      MagnetN (0.06)

此“原因”字符串的长度将逐行变化。

这是我当前正在使用的功能：

find_reasons <- function(order){
  reasons <- NA

  for(col in names(order)){
    # check if column value is non-zero and the column isn't the "reasons" column
    if(order[col] != 0 & col != "Reasons"){
      # paste column name and value
      vals <- paste(col," (",order[col],")",sep="")

      # either populate "reasons" or add to it
      reasons <- ifelse(is.na(reasons), vals, paste(reasons, vals,sep=" / "))
    }
  }

  return(reasons)

}

test$Reasons <- apply(test, 1, find_reasons)

但是，当我使用apply（）将其应用于我的实际数据（446030行和171列）时，它是如此之慢，以至于无法完成。我认为这是因为我的函数在每一行的每一列上循环，但是我无法考虑如何执行此操作，因为每一行可以具有填充列的不同组合。

有没有更好的方法来做这样的事情？

Answer 1

我们可以使用apply中的base R

df$Reasons <- apply(df[1:4], 1, function(x) {
           x1 <- x[x!=0]
           paste(names(x1), " (", x1, ")", sep="", collapse=" / ")})

Answer 2

一种可能的方法是

将数据集的格式从宽格式转换为长格式（也许仅限于相关的列），
忽略所有零值，然后
按行号创建Reasons字符串。
最后，结果列将重新加入原始数据集中（使用 update join 防止复制）。

使用data.table：

library(data.table)
reasons <- melt(setDT(test)[, rn := .I], id.vars = "rn")[
  value != 0.0][
    , paste(sprintf("%s (%3.2f)", variable, value), collapse = " / "), by = rn]
test[reasons, on = "rn", Reasons := V1][, rn := NULL]
test[]

   BRDirect BRExclusive MagnetY MagnetN                             Reasons
1:     0.00        0.17    0.08    0.00 BRExclusive (0.17) / MagnetY (0.08)
2:     0.00        0.00    0.08    0.00                      MagnetY (0.08)
3:     0.00        0.17    0.00    0.06 BRExclusive (0.17) / MagnetN (0.06)
4:     0.29        0.00    0.00    0.06    BRDirect (0.29) / MagnetN (0.06)
5:     0.29        0.00    0.00    0.06    BRDirect (0.29) / MagnetN (0.06)
6:     0.00        0.00    0.00    0.06                      MagnetN (0.06)

数据

library(data.table)
test <- fread(
  "i  BRDirect BRExclusive MagnetY MagnetN Reasons
1     0.00        0.17    0.08    0.00      NA
2     0.00        0.00    0.08    0.00      NA
3     0.00        0.17    0.00    0.06      NA
4     0.29        0.00    0.00    0.06      NA
5     0.29        0.00    0.00    0.06      NA
6     0.00        0.00    0.00    0.06      NA",
drop = c(1, 6))

Answer 3

使用功能的版本并按行应用：

   reason <- reason[, -ncol(reason)]
   res_Names <- colnames(reason)
   def_res <- function(a){paste(paste0(res_Names, " (", a, ") ")[a!=0], collapse = "/ ")}
   Reason_res<- apply(reason, 1, def_res)
   reason <- cbind(reason, Reason_res)

将一行中的所有非零值编译为字符串列

3 个答案:

数据