将数据框行与不同的值进行比较并提取 true 列表

Question

我正在用 R 编写一个闪亮的应用程序，对于我的部分代码，我需要识别数据帧中超过某个级别的所有元素。诀窍是，每行的阈值都不同。最终目标是有一个列表，其中元素 [[1]] 是一个两列数据框，第一列是名称（取自原始列名），第二列是执行（或未执行）的值，无论哪种方式）通过布尔测试。

这是一个可重现的起点：

set.seed(20)
rows = 400
cols = 300
df <- data.frame(matrix(runif(rows*cols), nrow = rows), row.names = NULL)
colnames(df) <- paste0('col', 1:cols)
compare <- runif(rows)

df 是原始数据， compare 是每行应与之比较的值的向量。 我已经编写了一个可以执行我想要的工作的代码块，但是它运行得相当慢，这对我的 Shiny 应用程序来说是一个麻烦。我花了比我预期的更长的时间来获得这个解决方案，但我知道我并不总是最高效的程序员，尤其是在 R 中应用循环时，所以我想知道是否有更快/更有效的方法这样做。

我目前的解决方案：

res <- lapply(1:nrow(df), function(x){
  currRow <- df[x,]
  tf <- currRow >= compare[x]
  ret2 <- data.frame(names(currRow)[tf], currRow[tf], row.names = NULL)
  colnames(ret2) <- c('Name', 'Value')
  ret2 <- ret2[complete.cases(ret2),]
  ret2 <- ret2[order(-ret2$Value),]
  return(ret2)
})

提前谢谢你。

Answer 1

lapply 中的几乎所有代码都可以通过使用矩阵运算来进行矢量化，从而使示例数据的性能提高约 10 倍。需要注意的关键是您可以使用单个 sweep 进行所有比较以获取布尔值；其余的只是将结果整理到数据框列表中，同时确保每个原始行都在列表中获得一个元素（即使没有列通过测试）：

f2 <- function() {
  x <- as.matrix(df)
  bool <- sweep(x, 1, compare, ">=")

  res <- data.frame(
    row   = as.vector(row(x)),
    Name  = colnames(x)[col(x)],
    Value = as.vector(x),
    pass  = as.vector(bool)
  )

  res <- res[order(-res$Value), ]

  lapply(split(res, res$row), function(x) {
    x <- x[complete.cases(x), ]
    x[x$pass, c("Name", "Value")]
  })
}

system.time(res1 <- f1()) # original
#>    user  system elapsed 
#>    3.17    0.02    3.18
system.time(res2 <- f2())
#>    user  system elapsed 
#>    0.27    0.01    0.28
all.equal(res1, res2, check.attributes = FALSE)
#> [1] TRUE

这是再次设置：

set.seed(20)
rows <- 400
cols <- 300

df <- data.frame(matrix(runif(rows * cols), nrow = rows), row.names = NULL)
colnames(df) <- paste0('col', 1:cols)
compare <- runif(rows)

f1 <- function() {
  lapply(1:nrow(df), function(x){
    currRow <- df[x,]
    tf <- currRow >= compare[x]
    ret2 <- data.frame(names(currRow)[tf], currRow[tf], row.names = NULL)
    colnames(ret2) <- c('Name', 'Value')
    ret2 <- ret2[complete.cases(ret2),]
    ret2 <- ret2[order(-ret2$Value),]
    return(ret2)
  })
}

由reprex package (v0.2.0) 于 2018 年 3 月 17 日创建。

Answer 2

这里没什么特别的，只是利用data.table 超快速的排序和索引。

这应该更快。

# Using apply (this is vectorized)
pes <- apply(df, 1, function(x){

    for(i in seq(compare))
    {
        # get indexes where the condition satisfies
        ix <- which(x >= compare[i])

        # get values
        val <- x[ix]

        # get column names
        nam <- names(x)[ix]

        # store above data
        df <- data.table(Name = nam, Value = val)
        df <- df[order(-Value)]
        df <- df[complete.cases(df)]
        return(df)
    }
})