Question

我经常遇到需要检查某个条件是否适用于非常大的向量或列表的任何或所有元素的情况。例如，检查列表是否包含我将使用的任何/ NULL元素：

any(vapply(x, is.null, logical(1))
all(vapply(x, is.null, logical(1))

然而，这是低效的，因为它总是检查列表中的每个元素。更智能的实现会在找到第一个NULL或非NULL元素时停止检查。即相当于：

is.null(x[[1]]) || is.null(x[[2]]) || is.null(x[[3]]) || ...
is.null(x[[1]]) && is.null(x[[2]]) && is.null(x[[3]]) && ...

使用for循环执行此操作很慢。 r-base提供了一些特殊情况，例如anyNA是any(is.na(.))的有效版本，它正是这样做的。但是我想知道我们是否可以更普遍地实现它并提供用于检查条件的优化函数：

all_fast(x, is.null)
any_fast(x, is.null)

但是：

all_fast(x, function(z) {length(z) == 2})
all_fast(x, is, "POSIXt")

Answer 1

这是天真的方式，

all0 <- function(x, FUN)
    all(vapply(x, FUN, logical(1)))

和R循环...

all1 <- function(x, FUN) {
    for (xi in x)
        if (!FUN(xi))
            return(FALSE)
    TRUE
}

......可以编译

library(compiler)
all1c <- cmpfun(all1)

...或用C写的

library(inline)
allc <- cfunction(signature(x="list", fun="function"), "
    SEXP call = PROTECT(lang2(fun, R_NilValue));
    int len = Rf_length(x);
    for (int i = 0; i < len; ++i) {
        SETCADR(call, VECTOR_ELT(x, i));
        if (!LOGICAL(eval(call, R_GlobalEnv))[0]) {
            UNPROTECT(1);
            return Rf_ScalarLogical(FALSE);
        }
    }
    UNPROTECT(1);
    return Rf_ScalarLogical(TRUE);")

我们需要衡量绩效，所以

library(microbenchmark)

最糟糕的情况似乎是条件通过

n <- 100000
x0 <- x <- vector("list", n)
microbenchmark(all0(x, is.null), all1(x, is.null), all1c(x, is.null),
               allc(x, is.null))
## Unit: milliseconds
##               expr      min       lq   median       uq      max neval
##   all0(x, is.null) 47.48038 50.58960 52.34946 54.10116 61.94736   100
##   all1(x, is.null) 41.52370 44.40024 45.25135 46.68218 53.22317   100
##  all1c(x, is.null) 33.76666 35.03008 35.71738 36.41944 45.37174   100
##   allc(x, is.null) 13.95340 14.43153 14.78244 15.94688 19.41072   100

因此，与编译的R版本相比，我们在C中的速度只有2倍 - 每个测试都有一个函数调用，所以我们只保留循环本身。最好的情况是当我们立即退出并清楚地显示循环的优点时，但是编译和C代码都没有帮助我们

x[[1]] <- FALSE
microbenchmark(all0(x, is.null), all1(x, is.null), all1c(x, is.null),
               allc(x, is.null))
## Unit: microseconds
##               expr       min         lq     median        uq       max neval
##   all0(x, is.null) 45376.760 45772.5020 46108.5795 46655.005 54242.687   100
##   all1(x, is.null)     1.566     1.9550     2.6335    12.015    14.177   100
##  all1c(x, is.null)     1.367     1.7340     2.0345     9.359    17.438   100
##   allc(x, is.null)     1.229     1.6925     4.6955    11.628    23.378   100

这是一个中间案例，它实际上并没有任何意外 - C循环比编译的R循环快约2倍，因此可以快速地获得大约2倍。

x <- x0
x[[length(x)/2]] <- FALSE
microbenchmark(all0(x, is.null), all1(x, is.null), all1c(x, is.null),
               allc(x, is.null))
## Unit: milliseconds
##               expr      min       lq    median        uq       max neval
##   all0(x, is.null) 46.85690 49.92969 51.045519 52.653137 59.445611   100
##   all1(x, is.null) 20.90066 21.92357 22.582636 23.077863 25.974395   100
##  all1c(x, is.null) 16.51897 17.44539 17.825551 18.119202 20.535709   100
##   allc(x, is.null)  6.98468  7.18392  7.312575  8.290859  9.460558   100

在C级（VECTOR_ELT(x, i) == R_NilValue）显式测试NULL非常快，因此将值与NULL进行比较的C代码比相应的R代码快约100倍。如果速度是最重要的话，似乎allNULL可能是值得推广的，但是通用C级的情况似乎并不那么引人注目。当然，C代码并不处理NA或错误条件。

Answer 2

Jeroen正确地说

然而，这是低效的，因为它总是检查列表中的每个元素。更聪明实现将在找到第一个NULL或非NULL元素时停止检查。

和Rcpp糖版本已经这样做了几年。我在某处有基准比较。

编辑：找到它，这是一个非常古老的例子，早于我们使用rbenchmark或microbenchmark包，它仍然在Rcpp包中examples/SugarPerformance目录。当我现在运行它时，相关的行是（并编辑为符合此处的行）

  runs              expr hand.written       sugar        R hnd/sugar    R/sugar
1 5000    any(x * y < 0)  0.000128746 0.000232458  7.52280  0.553846 32361.9631

我们在很多早期谈判中使用了这个，因为“收益”似乎令人印象深刻。但是即使单个R运行也只有0.15毫秒，所以除非你真的重复它不值得获得。

正如Martin在他的回答中所说，只是字节编译（当我们在2010年初设置这个例子时还没有提供）也很有帮助。

Answer 3

＆＃39;任何＆＃39;版本：

res <- FALSE
for ( i in seq_along(x) ) { if( is.null(x[i]) ) { res <-TRUE; break()} 
res

lapply和vapply在内部只是for循环，所以你只是失去了它们提供的语法压缩，但是你正在获得在第一次出现的循环时突破循环的能力。一个定义条件。您可以使用res <- TRUE并将FALSE设置为全部＆＃39;版本

Answer 4

FWIW，尽管灵活性较低，但在可能的情况下避免使用R的评估机制会更快。与Martin的答案相比，我提供了一个简单的Rcpp解决方案，但特别针对'all NULL'案例。

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
SEXP all_fast(SEXP x, SEXP fun) {
    SEXP call = PROTECT(Rf_lang2(fun, R_NilValue));
    int len = Rf_length(x);
    for (int i = 0; i < len; ++i) {
        SETCADR(call, VECTOR_ELT(x, i));
        if (!LOGICAL(Rf_eval(call, R_GlobalEnv))[0]) {
            UNPROTECT(1);
            return Rf_ScalarLogical(FALSE);
        }
    }
    UNPROTECT(1);
    return Rf_ScalarLogical(TRUE);
}

// [[Rcpp::export]]
bool all_null(List x) {
  int n = x.size();
  for (R_len_t i=0; i < n; ++i) {
    if (x[i] != R_NilValue) return false;
  }
  return true;
}

/*** R
n <- 100000
x0 <- x <- vector("list", n)
all_fast(x, is.null)
all_null(x)
library(microbenchmark)
microbenchmark(
  all_fast(x, is.null),
  all_null(x)
)
*/

给了我

> Rcpp::sourceCpp('~/Desktop/all_fast.cpp')

> n <- 100000

> x0 <- x <- vector("list", n)

> all_fast(x, is.null)
[1] TRUE

> all_null(x)
[1] TRUE

> library(microbenchmark)

> microbenchmark(
+   all_fast(x, is.null),
+   all_null(x)
+ )
Unit: microseconds
                 expr      min        lq   median        uq      max neval
 all_fast(x, is.null) 6703.948 6962.7355 7051.680 7231.1805 13100.41   100
          all_null(x)  280.816  283.8025  292.531  303.3125   340.19   100

如果您有一组非常常见的函数，那么编写自己的简单Rcpp包装器可能是值得的。你失去了灵活性，但你确实获得了相当大的速度。

但是，保存的微秒值是否足够值，取决于您的用例/数据大小。

虽然我认为Martin的C答案是最佳答案，但我认为值得注意的是，某些常见案例的具体实施可能是值得的。

实现这些概念的软件包很不错：Martin提供的“通用”版本，以及常见案例的“调整”版本。例如：all_null，all_na，all_inherits，all_odd，...

任何/所有的高效版本

4 个答案: