r 将多个条件应用于多个列（函数参数值的向量）

Question

我正在尝试将多个条件应用于 data.frame 的多个列，其中条件 i 应应用于列 i，即应用的条件取决于我所在的列。我有一个可行的解决方案，但它有两个主要缺点，它在大数据上可能很慢，因为它使用 for 循环，并且它需要两个输入向量“应用条件的列”和“要应用的条件”以相同的顺序。我设想了一个利用快速数据整理包功能的解决方案，例如dplyr, data.table 并且在参数向量元素的顺序方面更加灵活。一个例子应该清楚（这里的条件只是一个阈值测试，但在更大的问题中，它可能是一个涉及数据集变量的更复杂的布尔表达式）。

t <- structure(list(a = c(2L, 10L, 10L, 10L, 3L), 
                    b = c(5L, 10L, 20L, 20L, 20L), 
                    c = c(100L, 100L, 100L, 100L, 100L)), 
               .Names = c("a", "b", "c"), 
               class = "data.frame", 
               row.names = c(NA, -5L))

foo_threshold <- 
  function(data, cols, thresholds, condition_name){
    df <- data.frame(matrix(ncol = length(cols), nrow = nrow(data)))
    colnames(df) <- paste0(cols, "_", condition_name)

    for (i in 1:length(cols)){
      df[,i] <- ifelse(data[,i] > thresholds[i],T,F)
      }
    return(df)
    }

foo_threshold(data = t, cols = c("a", "b"), thresholds = c(5, 18), 
              condition_name = "bigger_threshold")

我试图在 dplyr 链中解决它，但我未能正确传递参数向量，即如何明确他应该将条件 i 应用于第 i 列。下面是我要去的插图。它不起作用，它遗漏了一些要点，但我认为它说明了我正在努力实现的目标。请注意，这里假设条件位于 data.frame 中，其中列变量保存 col 名称，阈值是通过查找（dplyr 文件管理器 + 选择链）提取的。

foo_threshold <- function(data, cols, thresholds, cond_name) {
  require(dplyr)
  # fun to evaluate boolean condition
  foo <- function(x) {
    threshold <- thresholds %>% filter(variable==x) %>% select(threshold)
    temp <- ifelse(x > threshold, T, F)
    return(temp)
    }

  vars <- setNames(cols, paste0(cols,"_",cond_name))

  df_out <-
    data %>%
    select_(.dots = cols) %>%
    mutate_(funs(foo(.)), vars) %>%
    select_(.dots = names(vars))

  return(df_out)
  }

# create threshold table
temp <- 
  data.frame(variable = c("a", "b"),
             threshold = c(5, 18),
             stringsAsFactors = F)

# call function (doesn't work)
foo_threshold(data = t, thresholds = temp, cond_name = "bigger_threshold")

编辑：@thepule data.frame of conditions 可能如下所示，其中 x 是列。所以每个条件都会针对其对应列的每一行进行评估。

conditions <- 
  data.frame(variable = c("a", "b"),
             condition = c("x > 5 and x < 10", "!x %in% c("o", "p")"),
             stringsAsFactors = F)

Answer 1

再次尝试使用扫描而不是映射。保留之前的答案，因为我觉得它增加了价值，显示了 mapply 的低效。 这个新答案的运行速度似乎是 OP 的两倍多。我认为它比当前评分最高的答案慢了一点，但代码更简洁。

如果您愿意将结果作为矩阵而不是 data.frame 接受，它会运行得更快。

library(dplyr) 


temp <- structure(list(a = c(2L, 10L, 10L, 10L, 3L), 
                    b = c(5L, 10L, 20L, 20L, 20L), 
                    c = c(100L, 100L, 100L, 100L, 100L)), 
                    .Names = c("a", "b", "c"), 
                    class = "data.frame", 
                    row.names = c(NA, -5L))

foo_threshold <- function(data , cols , thresholds , condition_name ) {
    dat <- sweep ( data [ cols ] , 2  ,  thresholds , ">" ) %>%  as.data.frame()
    names(dat) <- paste0(names(dat) , "_" , condition_name)
    return(dat)
} 

foo_threshold(data = temp, cols = c("a", "b"), thresholds = c(5, 18), 
              condition_name = "bigger_threshold")

Answer 2

最后尝试回答。试图使代码更通用，以便它可以接受任意函数。很好，它的运行速度似乎也比我以前的任何答案都快得多。我也很累，如果我犯了一个愚蠢的错误，我很抱歉。

temp <- structure(list(a = c(2L, 10L, 10L, 10L, 3L), 
                       b = c(5L, 10L, 20L, 20L, 20L), 
                       c = c(100L, 100L, 100L, 100L, 100L)), 
                  .Names = c("a", "b", "c"), 
                  class = "data.frame", 
                  row.names = c(NA, -5L))



condition <- c(function(x)  x> 5  , 
               function(x) x > 18 )


foo_threshold <- function ( data , cols , threshold , condition_name ) {
    dat <- data[0]
    for ( i in 1:length(condition))     dat[cols[i]] <- condition[[i]]( data[[cols[i]]] )
    names(dat) <- paste0( cols , "_" , condition_name)
    return(dat)
}


foo_threshold(data = temp, cols = c("a", "b"), threshold  = condition , 
           condition_name = "bigger_threshold")

Answer 3

试试这个：

library(dplyr)

 foo_threshold <-
     function(data, cols, thresholds, condition_name){
         temp <- rbind(data[,cols], thresholds) %>%
         lapply(function(x) x[1:length(x)-1] > last(x)) %>% data.frame()
         colnames(temp) <- paste0(cols, "_", condition_name)
         return(temp)

     }

 foo_threshold(data = t, cols = c("a", "b"), thresholds = c(5, 18), 
               condition_name = "bigger_threshold")

为了测试哪个更快：

test <- data.frame(a = runif(10000000), b = runif(10000000), stringsAsFactors = F)

 lapply(list(foo_threshold_original, foo_threshold),
        function(x) system.time(x(data = test, cols = c("a", "b"), thresholds = c(0.5, 0.8), 
                      condition_name = "bigger_threshold")))

其中 foo_threshold_original 是您的初始版本。 结果是：

[[1]]
   user  system elapsed 
   3.95    0.64    4.58 

[[2]]
   user  system elapsed 
   1.73    0.24    1.96

所以新版本在更大的数据帧上实际上更快。

Answer 4

这个怎么样？不使用 dplyr（我还是加载了它以使用管道）

library(dplyr)

foo_threshold <- function( data , cols , thresholds , condition_name){
    dat <- mapply( function(x , val)  x > val  , data[cols] , thresholds ) %>%  as.data.frame
    names(dat) <- paste0(names(dat) , "_" , condition_name)
    return(dat)
}

编辑：简化