2014-04-17 15 views
5

Tôi thường gặp phải các tình huống mà tôi cần kiểm tra xem một số điều kiện có giữ cho bất kỳ hoặc tất cả các thành phần của một vectơ hoặc danh sách rất lớn hay không. Ví dụ để kiểm tra xem một danh sách chứa bất kỳ/chỉ NULL yếu tố Tôi sẽ sử dụng:Phiên bản hiệu quả của bất kỳ/tất cả

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

Tuy nhiên điều này là không hiệu quả bởi vì nó luôn kiểm tra mỗi phần tử trong danh sách. Triển khai thông minh hơn sẽ ngừng kiểm tra khi tìm thấy phần tử NULL hoặc không NULL đầu tiên. I E. tương đương với:

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

Làm điều này với vòng lặp for chậm. Có một số trường hợp đặc biệt do r-base cung cấp, ví dụ anyNA là phiên bản hiệu quả của any(is.na(.)) thực hiện chính xác điều này. Nhưng tôi đã tự hỏi nếu chúng ta có thể thực hiện điều này nói chung và cung cấp một chức năng được tối ưu hóa để kiểm tra một điều kiện:

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

nhưng cũng:

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

Bạn có thể viết điều này trong C++ hoặc RCpp :) – bartektartanus

+0

Bạn có nghĩa là đối với mỗi vấn đề cá nhân, hoặc sẽ có thể là một cách để thực hiện chung 'all_fast' chức năng trong ' Rcpp'? – Jeroen

+0

Không ... Bạn có thể chuyển hàm làm đối số cho hàm RCpp. – bartektartanus

Trả lời

7

Đây là cách ngây thơ,

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

và một vòng lặp R ...

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

...mà có thể được biên dịch

library(compiler) 
all1c <- cmpfun(all1) 

... hoặc viết bằng 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);") 

Chúng ta cần để đo hiệu suất, vì vậy

library(microbenchmark) 

Trường hợp xấu nhất sẽ có vẻ là rằng tình trạng này vượt qua

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 

vì vậy chúng tôi chỉ nhanh gấp 2 lần so với phiên bản R đã biên dịch - có một cuộc gọi hàm trên mỗi bài kiểm tra, vì vậy chúng tôi chỉ tiết kiệm cho mỗi vòng lặp. Các trường hợp tốt nhất là khi chúng ta thoát ngay lập tức và rõ ràng cho thấy lợi thế của vòng lặp, nhưng sau đó không phải biên soạn hay mã C giúp chúng ta

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 

Dưới đây là một trường hợp trung gian, mà không thực sự chứa bất kỳ bất ngờ - C vòng lặp nhanh hơn gấp 2 lần so với vòng lặp R được biên dịch, vì vậy sẽ có khoảng 2x nhanh chóng.

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 

Rõ ràng thử nghiệm cho NULL ở mức C (VECTOR_ELT(x, i) == R_NilValue) là rất nhanh, do đó, C mã mà so sánh giá trị NULL là khoảng 100x nhanh hơn so với mã R tương ứng. Có vẻ như allNULL có thể là một sự khái quát hóa đáng giá nếu tốc độ là bản chất, nhưng trường hợp cho một mục đích chung C-tất cả dường như không hấp dẫn lắm. Và dĩ nhiên mã C không xử lý các điều kiện NA hoặc lỗi.

+0

Cảm ơn! Tôi nghĩ rằng 'allc' là một cải tiến to lớn so với 'all0' ngây thơ. – Jeroen

1

Các 'bất kỳ' phiên bản:

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

lapplyvapply chỉ dành cho các vòng lặp nội bộ, vì vậy bạn chỉ mất nén cú pháp mà chúng cung cấp, nhưng bạn đang có khả năng thoát ra khỏi vòng lặp trên lần xuất hiện đầu tiên của một điều kiện xác định. Bạn có thể sử dụng res <- TRUE và đặt thành FALSE cho phiên bản 'tất cả'.

2

Jeroen một cách đúng đắn nói rằng

Tuy nhiên điều này là không hiệu quả bởi vì nó luôn kiểm tra mỗi phần tử trong danh sách. Triển khai thông minh hơn sẽ ngừng kiểm tra khi tìm thấy phần tử NULL hoặc non NULL đầu tiên.

và các phiên bản đường Rcpp đã hoạt động trong vài năm. Tôi có một so sánh chuẩn ở đâu đó.

Edit: Tìm thấy nó, nó là một ví dụ thực sự cũ mà xảy ra trước sử dụng của chúng ta về rbenchmark hoặc microbenchmark gói, và nó vẫn còn trong gói Rcpp trong thư mục examples/SugarPerformance. Khi tôi chạy nó bây giờ, dòng tương ứng là (và chỉnh sửa để phù hợp với dòng ở đây)

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 

Chúng tôi sử dụng này trong rất nhiều cuộc đàm phán sớm nhất là vào khoản mục "Lãi" dường như rất ấn tượng. Nhưng ngay cả một R chạy duy nhất chỉ là 0,15 mili giây, trừ khi bạn thực sự nó liên tục nó không phải là giá trị đạt được.

Và như Martin hiển thị trong câu trả lời của mình, chỉ cần biên dịch byte (chưa có sẵn hoặc khi chúng tôi đặt ví dụ vào đầu năm 2010) cũng hữu ích.

1

FWIW, mặc dù điều này kém linh hoạt hơn, nhanh hơn nhiều để tránh cơ chế đánh giá của R khi có thể. Tôi cung cấp một giải pháp đơn giản Rcpp so với câu trả lời của Martin, nhưng đặc biệt cho trường hợp 'tất cả 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) 
) 
*/ 

mang lại cho tôi

> 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 

Nếu bạn có một tập hợp các chức năng mà được gọi rất phổ biến, nó có thể là giá trị các nỗ lực để viết đơn giản riêng Rcpp giấy gói của bạn. Bạn mất tính linh hoạt, nhưng bạn đạt được một số lượng đáng kể tốc độ.

Dù các micro giây đã lưu có đủ để có giá trị hay không tùy thuộc vào trường hợp sử dụng/kích thước dữ liệu của bạn.

Mặc dù tôi nghĩ câu trả lời C của Martin là câu trả lời hay nhất ở đây Tôi nghĩ rằng điều đáng lưu ý là triển khai cụ thể cho một số trường hợp phổ biến có thể đáng giá.

Gói đã triển khai các khái niệm này sẽ đẹp: phiên bản 'chung' mà Martin cung cấp, cộng với phiên bản 'được điều chỉnh' cho các trường hợp phổ biến. Ví dụ: all_null, all_na, all_inherits, all_odd ...

Các vấn đề liên quan