Question

R中是否有colMeans的实现包含alpha修剪的均值参数？

如果没有，我该怎么做？

原始问题已在下面的评论中得到解答。

apply(x, 2, mean, trim=.05)未像colMeans;

那样优化

同等效率的实施是什么？

Answer 1

以下是计算修剪colMeans的不同方法的一些示例，并比较了它们的效果。

m <- matrix(runif(1000000), nc=1000)
trim <- 0.1

使用apply：

out1 <- apply(m, 2, mean, trim=trim)

使用sapply：

out2 <- sapply(seq_len(ncol(m)), function(i) mean(m[, i], trim=trim))

使用Rcpp：

library(inline)
library(RcppArmadillo)

f <- 'using namespace arma;
      mat x = sort(as<mat>(x_));
      double trim = as<double>(trim_); 
      int low;
      if(x.n_rows % 2 == 1) {
        low = ceil(trim * x.n_rows) - 1;
      } else {
        low = ceil(trim * x.n_rows);
      }
      int high = ceil((1 - trim) * x.n_rows) - 1;
      return(wrap(mean(x.rows(low, high))));'

trim.colMeans <- cxxfunction(signature(x_='matrix', trim_='numeric'), 
                             f, plugin="RcppArmadillo")

out3 <- trim.colMeans(m, trim)

<强>比较

identical(out1, out2)
[1] TRUE
identical(out1, c(out3))
[1] TRUE

library(microbenchmark)

microbenchmark(apply=apply(m, 2, mean, trim=trim),
               sapply=sapply(seq_len(ncol(m)), function(i) mean(m[, i], trim=trim)),
               Rcpp=trim.colMeans(m, trim),
               colMeans=colMeans(m))


Unit: microseconds
     expr       min          lq     median          uq        max neval
    apply 68907.162 100439.4775 102555.396 109044.4025 136034.067   100
   sapply 64675.928  66383.6010  66937.615  68152.1115  98680.906   100
     Rcpp 43614.629  44297.6980  44761.360  45164.4850  46883.602   100
 colMeans   782.458    805.7995    828.538    988.4625   1452.877   100

我确信我的Rcpp实施是次优的，所以请随意改进。正如您所看到的，这些方法都没有像colMeans的未修正计算那样有效，但我怀疑效率是不可能的，因为必须进行额外的计算，包括矩阵的排序和子集化。在对矢量mean与修剪后的对应物进行基准测试时，修剪数据的这种惩罚是显而易见的：

v <- runif(1000)
microbenchmark(mean(v), mean(v, trim=0.1))

Unit: microseconds
                expr    min     lq median     uq     max neval
             mean(v)  5.722  6.325  6.927  7.229 124.989   100
 mean(v, trim = 0.1) 42.165 43.671 44.574 44.876  84.630   100

在colMeans中设置alpha修剪

1 个答案: