正如@joran 所指出的,您的代码非常专业,一般来说,通用性较低的函数、算法等......通常性能更高。看一眼median.default
:
median.default
# function (x, na.rm = FALSE)
# {
# if (is.factor(x) || is.data.frame(x))
# stop("need numeric data")
# if (length(names(x)))
# names(x) <- NULL
# if (na.rm)
# x <- x[!is.na(x)]
# else if (any(is.na(x)))
# return(x[FALSE][NA])
# n <- length(x)
# if (n == 0L)
# return(x[FALSE][NA])
# half <- (n + 1L)%/%2L
# if (n%%2L == 1L)
# sort(x, partial = half)[half]
# else mean(sort(x, partial = half + 0L:1L)[half + 0L:1L])
# }
有多种操作可以适应缺失值的可能性,这些操作肯定会影响函数的整体执行时间。由于您的函数不会复制此行为,因此它可以消除大量计算,但因此不会为具有缺失值的向量提供相同的结果:
median(c(1, 2, NA))
#[1] NA
median2(c(1, 2, NA))
#[1] 2
其他几个可能不存在的因素as much的效果作为处理NA
s,但值得指出的是:
-
median
以及它使用的一些函数都是 S3 泛型,因此在方法分派上花费了少量时间
-
median
不仅仅适用于整数和数值向量;它还会处理Date
, POSIXt
,可能还有一堆其他类,并正确保留属性:
median(Sys.Date() + 0:4)
#[1] "2016-01-15"
median(Sys.time() + (0:4) * 3600 * 24)
#[1] "2016-01-15 11:14:31 EST"
Edit:我应该提到下面的函数会导致原始向量被排序 since NumericVector
s 是代理对象。如果你想避免这种情况,你可以Rcpp::clone
输入向量并对克隆进行操作,或使用您的原始签名(带有std::vector<double>
),这隐含地需要从转换中复制SEXP
to std::vector
.
另请注意,您可以通过使用NumericVector
代替std::vector<double>
:
#include <Rcpp.h>
// [[Rcpp::export]]
double cpp_med(Rcpp::NumericVector x){
std::size_t size = x.size();
std::sort(x.begin(), x.end());
if (size % 2 == 0) return (x[size / 2 - 1] + x[size / 2]) / 2.0;
return x[size / 2];
}
microbenchmark::microbenchmark(
median(x),
median2(x),
cpp_med(x),
times = 200L
)
# Unit: microseconds
# expr min lq mean median uq max neval
# median(x) 74.787 81.6485 110.09870 92.5665 129.757 293.810 200
# median2(x) 6.474 7.9665 13.90126 11.0570 14.844 151.817 200
# cpp_med(x) 5.737 7.4285 11.25318 9.0270 13.405 52.184 200
Yakk 在上面的评论中提出了一个很好的观点——Jerry Coffin 也对此进行了阐述——关于进行完整排序的低效率。这是使用重写std::nth_element
,以更大的向量为基准:
#include <Rcpp.h>
// [[Rcpp::export]]
double cpp_med2(Rcpp::NumericVector xx) {
Rcpp::NumericVector x = Rcpp::clone(xx);
std::size_t n = x.size() / 2;
std::nth_element(x.begin(), x.begin() + n, x.end());
if (x.size() % 2) return x[n];
return (x[n] + *std::max_element(x.begin(), x.begin() + n)) / 2.;
}
set.seed(123)
xx <- rnorm(10e5)
all.equal(cpp_med2(xx), median(xx))
all.equal(median2(xx), median(xx))
microbenchmark::microbenchmark(
cpp_med2(xx), median2(xx),
median(xx), times = 200L
)
# Unit: milliseconds
# expr min lq mean median uq max neval
# cpp_med2(xx) 10.89060 11.34894 13.15313 12.72861 13.56161 33.92103 200
# median2(xx) 84.29518 85.47184 88.57361 86.05363 87.70065 228.07301 200
# median(xx) 46.18976 48.36627 58.77436 49.31659 53.46830 250.66939 200