最初にカットするifelse
と、57%節約できます...
almostEqual2 <- function(x, y, tolerance=1e-8) {
diff <- abs(x - y)
mag <- pmax( abs(x), abs(y) )
out <- logical(length(y))
out[ mag > tolerance ] <- (diff/mag <= tolerance)[ mag > tolerance]
out[ ! mag > tolerance ] <- (diff <= tolerance)[! mag > tolerance]
return( out )
}
require(microbenchmark)
set.seed(1)
x <- 1
y <- rnorm(1e6)
bm <- microbenchmark( almostEqual(x,y,tol=0.5) , almostEqual2(x,y,tol=0.5) , times = 25 )
print( bm , digits = 3 , unit = "relative" , order = "median" )
#Unit: relative
# expr min lq median uq max neval
# almostEqual2(x, y, tol = 0.5) 1.00 1.00 1.00 1.00 1.00 25
# almostEqual(x, y, tol = 0.5) 2.09 1.76 1.73 1.86 1.82 25
Rcpp の使用
以外のCRANで最も依存するパッケージを使用しない理由がわかりませんbase
が、必要に応じて、以前の努力の5倍のスピードアップ(OPで10倍)を実現でき、それも処理しますNA優雅に...
#include <Rcpp.h>
using namespace Rcpp;
//[[Rcpp::export]]
LogicalVector all_equalC( double x , NumericVector y , double tolerance ){
NumericVector diff = abs( x - y );
NumericVector mag = pmax( abs(x) , abs(y) );
LogicalVector res = ifelse( mag > tolerance , diff/mag <= tolerance , diff <= tolerance );
return( res );
}
を使用して利用可能になりRcpp::sourceCpp('path/to/file.cpp')
ました。結果...
bm <- microbenchmark( almostEqual(x,y,tol=0.5) , almostEqual2(x,y,tol=0.5) , all_equalC(x,y,tolerance=0.5) , times = 25 )
print( bm , digits = 3 , unit = "relative" , order = "median" )
#Unit: relative
# expr min lq median uq max neval
# all_equalC(x, y, tolerance = 0.5) 1.00 1.00 1.00 1.00 1.00 25
# almostEqual2(x, y, tol = 0.5) 4.50 4.39 5.39 5.24 7.32 25
# almostEqual(x, y, tol = 0.5) 8.69 9.34 9.24 9.96 10.91 25