如何加快测试R中数值之间的相等性

目前，我是如何测试数值相等性的，如果

x

是一个数值，而

y

是一个向量，它就可以工作

almostEqual <- function(x, y, tolerance=1e-8) {
  diff <- abs(x - y)
  mag <- pmax( abs(x), abs(y) )
  ifelse( mag > tolerance, diff/mag <= tolerance, diff <= tolerance)
}

你能让它更快吗（只使用基本R）

编辑： 我认为这是有用的建议

"%~=%" <- almostEqual;
"%~in%" <- function(x,y){ sapply(x,FUN=function(a,b){any(almostEqual(a,b))},y)};

---

“%~=%”首先删除
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:：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

bm您是否发现
all.equal
？如果是这样的话，您的函数缺少什么？@Justin:
all.equal
需要具有相同长度的对象，并且不会告诉您哪些元素是
TRUE
和/或
FALSE
。@JoshuaUlrich几乎做到了！您可以将结果强制为逻辑，并将
NA
视为
FALSE
veql=function（x）sapply（x，function（x）as.logical（all.equal（1，x））
@Justin这绝对不会比OP当前的解决方案快…我没说是这样！我只是好奇
all.equal
：）有什么问题，但是你放松了
NA
治疗，不是吗？@Roland是的，你这样做是因为你不能用NA下标。我没有考虑到这可能是你必须处理的事情。也许OP能起到作用？@Roland，不错，但我想我会保留NAin@statquant为什么不是Rcpp？出于兴趣？@SimonO101:只是为了提高兼容性。。。此外，Rolland显示的函数需要编译器（Rtools）+Rcpp，这太多了
#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 );
}

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