Question

我正在将R中的循环（当样本大小很慢时）转换为Rcpp。这是R

中的循环

loop_R = function(R, V, iV, X){
  Rhat <- matrix(0, nrow = n, ncol = 1)
  for (j in 1:n) {
    r <- R[-j]
    VV <- V[-j, -j]
    iVV <- solve(VV)
    # version using global mean: This works best
    bbhat <- solve(t(X) %*% iV %*% X, t(X) %*% iV %*% R)[1]
    v <- V[j, -j]
    Rhat[j,] <- as.numeric(bbhat + v %*% iVV %*% (r - bbhat))
  }
  Rhat
}

这里，R和V是矩阵，iV只是V的倒数，X是模型矩阵（见下面的例子）。

然后我写了我的第一个Rcpp函数并将其保存为loop.cpp文件：

#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]

using namespace Rcpp;
using namespace arma;

// [[Rcpp::export]]
arma::vec loop_cpp(const arma::vec& R, const arma::mat& V, const arma::mat& iV, const arma::mat& X) {
  // Initiate Rhat
  int n = R.size();
  arma::vec Rhat(n); // to save results
  arma::uvec idx(n); // to identify elements to remove
  idx.fill(1.0);

  for (int j = 0; j < n; j++) {
    idx(j) = 0.0;
    arma::uvec idx2 = find(idx);
    arma::vec r = R.elem(idx2); // r[-j]
    arma::mat VV = V.submat(idx2, idx2); // V[-j, -j]
    arma::mat iVV = arma::pinv(VV);
    arma::mat bbhat = arma::solve(trans(X) * iV * X, trans(X) * iV * R);
    double bbhat1 = as_scalar(bbhat.row(0));
    rowvec v1 = V.row(j);  // V[j, ]
    vec v = v1.elem(idx2); // V[j, -j]
    double res = bbhat1 + as_scalar(trans(v) * iVV * (r - bbhat1));
    Rhat(j) = res;
    idx.fill(1);
  } 

 return Rhat;
}

然后使用Rcpp::sourceCpp("loop.cpp")使其在R中可用。

然后我在R中生成了一些数据：

library(lme4)
mod <- lme4::lmer(Reaction ~ Days + (1 | Subject), data=sleepstudy, REML = F)
Y <- model.frame(mod)[, 1]
X <- model.matrix(mod)
n <- dim(X)[1]; p <- dim(X)[2]
D <- attr(mod, "pp")$LamtUt
V <- crossprod(D) + diag(n)
iV <- solve(V)
bhat <- solve(t(X) %*% iV %*% X, t(X) %*% iV %*% Y)
fitted.values <- X %*% bhat
R <- Y - X %*% bhat
# because I do not know how to deal with sparseMatrix in RcppArmadillo
R = as.matrix(R)
V = as.matrix(V)
iV = as.matrix(iV)

函数loop_R()和loop_cpp()都给出相同的结果，这很好。但是，loop_cpp比loop_R慢约6倍。

> microbenchmark::microbenchmark(loop_R(R, V, iV, X), loop_cpp(R, V, iV, X), times = 10)
    Unit: milliseconds
                  expr       min        lq      mean   median        uq       max neval cld
   loop_R(R, V, iV, X)  523.8825  560.5022  606.5602  582.310  627.7818  797.0094    10  a 
 loop_cpp(R, V, iV, X) 3181.5071 3227.8532 3382.4447 3390.097 3471.1332 3735.6973    10   b

由于这是我的第一个Rcpp功能，我不确定发生了什么。有人可以解释和改进loop_cpp吗？非常感谢！

更新

在pinv()内用inv()替换loop_cpp()之后，cpp版本比R版本略快，但仍然没有太快的速度值得努力......哼..

另外，我如何处理奇异矩阵？如何在c ++中测试矩阵是否是单数？

Unit: milliseconds
                   expr       min        lq      mean    median        uq       max neval cld
    loop_R(R, V, iV, X)  406.0211  411.2906  438.0069  415.2752  418.6047  547.2976    10  b 
  loop_cpp(R, V, iV, X)  384.2119  386.4745  389.2240  388.3505  392.5422  395.2945    10 a  
 loop_cpp2(R, V, iV, X) 2367.2376 2379.9720 2399.4574 2398.4324 2422.3609 2439.0243    10   c

Rcpp中的循环比R中的循环慢

更新

0 个答案: