Question

当n增加时，R中双循环的速度非常慢。有没有办法提高for循环的速度？

    set.seed(1)
    n=1000

    y=rnorm(n)
    x1=rnorm(n)
    x2=rnorm(n)

    lm.ft=function(y,x1,x2)
      lm.fit(cbind(1,x1.bar,x2.bar), y)$coef

    res=array(,dim=c(1,3,n,n))
    for(i in 1:n)
      for(j in 1:n){
       x1.bar=x1-x1[i]
       x2.bar=x2-x2[j]
       res[,,i,j]=lm.ft(y,x1.bar,x2.bar)
      }

Answer 1

只是为了给你一个完整的答案：除了代码中的一些奇怪之处（如在x1.bar内使用x2.bar和lm.ft而不是x1和{{1我的描述说：你到底想要实现什么？

如果我在你自己的代码上运行它：

x2

我得到以下有趣的图片：

Rprof("profile1.out")
for(i in 1:n)
  for(j in 1:n){
    x1.bar=x1-x1[i]
    x2.bar=x2-x2[j]
    res[,,i,j]=lm.ft(y,x1.bar,x2.bar)
  }
Rprof(NULL)
summaryRprof("profile1.out")

98％的时间你只是拟合模型。循环并不慢，你试图适应100万个模型的事实让你等待。你真的要重新考虑你的问题。

如果这真的是你想要做的，那么优化你的功能将涉及摆脱lm.fit的开销和矢量化减法。节省约50％。

> summaryRprof("profile1.out")
$by.self
                self.time self.pct total.time total.pct
".Call"              0.96    22.86       0.96     22.86
"lm.fit"             0.92    21.90       4.08     97.14
...
"cbind"              0.22     5.24       0.22      5.24
...

$by.total
                total.time total.pct self.time self.pct
"lm.ft"               4.12     98.10      0.04     0.95
"lm.fit"              4.08     97.14      0.92    21.90
...
"cbind"               0.22      5.24      0.22     5.24
...

Answer 2

如果你想做那样疯狂的事情，你应该使用Rcpp：

library(RcppEigen)
library(inline)

incl <- '
using  Eigen::LLT;
using  Eigen::Lower;
using  Eigen::Map;
using  Eigen::MatrixXd;
using  Eigen::MatrixXi;
using  Eigen::Upper;
using  Eigen::VectorXd;
using  Eigen::Vector3d;
typedef  Map<MatrixXd>  MapMatd;
typedef  Map<MatrixXi>  MapMati;
typedef  Map<VectorXd>  MapVecd;
inline MatrixXd AtA(const MatrixXd& A) {
  int n(A.cols());
  return  MatrixXd(n,n).setZero().selfadjointView<Lower>().rankUpdate(A.adjoint());
}
'

body <- '
const MapMatd        X(as<MapMatd>(XX));
const MapVecd        y(as<MapVecd>(yy));
const int            n(X.rows()), m(X.cols());   
LLT<MatrixXd>        llt; 
MatrixXd             Res(n*n,m), Xbar(n,m);
Vector3d             betahat;
for (int i = 0; i < n; ++i) {
 for (int j = 0; j < n; ++j) {
  Xbar=X;
  for (int k = 0; k < n; ++k) {
   Xbar(k,1) -= X(i,1);
   Xbar(k,2) -= X(j,2);
  };
  llt=AtA(Xbar);
  betahat =llt.solve(Xbar.adjoint() * y);
  Res.row(i*n+j) = betahat;
 };
};
return                wrap(Res);
'

crazyLm <- cxxfunction(signature(XX = "matrix", yy = "numeric"), 
                            body, "RcppEigen", incl)

set.seed(1)
n=4

y=rnorm(n)
x1=rnorm(n)
x2=rnorm(n)

lm.ft=function(y,x1,x2) lm.fit(cbind(1,x1.bar,x2.bar), y)$coef

res=array(,dim=c(3,n,n))
for(i in 1:n)
  for(j in 1:n){
    x1.bar=x1-x1[i]
    x2.bar=x2-x2[j]
    res[,i,j]=lm.ft(y,x1.bar,x2.bar)
  }

res2 <- aperm(array(t(crazyLm(cbind(1,x1,x2), y)), dim=c(3,n,n)), c(1,3,2))
all.equal(res, res2)
#[1] TRUE

system.time({
set.seed(1)
n=1000

y=rnorm(n)
x1=rnorm(n)
x2=rnorm(n)
res <- aperm(array(t(crazyLm(cbind(1,x1,x2), y)), dim=c(3,n,n)), c(1,3,2))
})

#  User      System     elapsed 
#36.130       0.033      36.158

这使您可以在一分钟内完成一百万个模型。但是，我没有看到用例。

双循环线性模型？

2 个答案: