Question

我使用以下代码：

var <- c(rep(4,4),rep(9,5))
cov <- diag(var)
n <- length(var)
rho <- 0.2 
for(i in 1:(n-1)){
   for(j in (i+1):n){
    if (j <= i + 4) cov[i,j] <- rho/(j-i)* sqrt(var[i] * var[j])
   }
}

创建所需的矩阵输出：

      [,1] [,2] [,3]      [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    4  0.8  0.4 0.2666667  0.3  0.0  0.0  0.0 0.00
 [2,]    0  4.0  0.8 0.4000000  0.4  0.3  0.0  0.0 0.00
 [3,]    0  0.0  4.0 0.8000000  0.6  0.4  0.3  0.0 0.00
 [4,]    0  0.0  0.0 4.0000000  1.2  0.6  0.4  0.3 0.00
 [5,]    0  0.0  0.0 0.0000000  9.0  1.8  0.9  0.6 0.45
 [6,]    0  0.0  0.0 0.0000000  0.0  9.0  1.8  0.9 0.60
 [7,]    0  0.0  0.0 0.0000000  0.0  0.0  9.0  1.8 0.90
 [8,]    0  0.0  0.0 0.0000000  0.0  0.0  0.0  9.0 1.80
 [9,]    0  0.0  0.0 0.0000000  0.0  0.0  0.0  0.0 9.00

但是，此代码太慢，无法计算大n的情况。你有什么有效的解决方案吗？

Answer 1

我假设你的n非常大，所以你想要一个带宽为5的稀疏带状矩阵。

首先是一个辅助函数，如diff，它允许任意函数而不仅仅是减法（-）。

fdiff <- function(x,lag,f) {
  i1 <- -seq_len(lag)
  f(x[i1],x[-length(x):-(length(x)-lag+1L)]) 
}

在这种情况下，我们想要的功能是

gm <- function(x,y) sqrt(x*y)

所以第一个超对角线是由

给出的

x <- c(rep(4,4),rep(9,5))
0.2*fdiff(x,1,gm)/1
# [1] 0.8 0.8 0.8 1.2 1.8 1.8 1.8 1.8

要填充备用带状矩阵，我们使用＆＃39; bandSparse＆＃39;来自Matrix图书馆

library(Matrix)
x <- c(rep(4,4),rep(9,5))
bandSparse(n,k=0:4,diagonals=
  c(list(x),lapply(1:4,function(lag) 0.2*fdiff(x,lag,gm)/lag)))

输出：

9 x 9 sparse Matrix of class "dgCMatrix"

 [1,] 4 0.8 0.4 0.2666667 0.3 .   .   .   .   
 [2,] . 4.0 0.8 0.4000000 0.4 0.3 .   .   .   
 [3,] . .   4.0 0.8000000 0.6 0.4 0.3 .   .   
 [4,] . .   .   4.0000000 1.2 0.6 0.4 0.3 .   
 [5,] . .   .   .         9.0 1.8 0.9 0.6 0.45
 [6,] . .   .   .         .   9.0 1.8 0.9 0.60
 [7,] . .   .   .         .   .   9.0 1.8 0.90
 [8,] . .   .   .         .   .   .   9.0 1.80
 [9,] . .   .   .         .   .   .   .   9.00

Answer 2

无论使用什么，都需要填充矩阵的上/下三角形。在这种情况下，模式非常简单，即mat1 <- rho/(col(mat)-row(mat));diag(mat1)=mat;#Cov mat。要计算相关矩阵，只需注意列中的R存储元素并执行v=sqrt(diag(mat1));mat1=mat1/v;mat1=t(t(mat1)/v);。这可以合并为一行，并避免在其他行中复制mat1=mat1/v种类。评价。

但是如果每个条目中的模式更加复杂，您可以考虑使用inline::cxxfunction，它需要对原始R代码进行少量修改，速度要快得多。为了避免内存复制，您也可以使用矩阵索引（实际上是双向量）。

library(inline)
include="
#include <math.h>
#include <vector>
"

body="
NumericMatrix x(X);
int nrow = x.nrow();
int ncol = x.ncol();
std::vector<double> diag(nrow);
for (int i=0;i<nrow;i++){
    diag[i] = sqrt(x(i,i));
}
double rho = .2;
for(int j=1;j<ncol;j++){
       for(int i=0; i<(j-1);i++){
               if (j < i + nrow-4){// Change to your version
                  x(i,j) = rho/double(j-i)*diag[i]*diag[j];
                  x(j,i) = x(i,j);
}
   }
}
return(x);
"
f1 <- cxxfunction(signature(X='matrix'),body,plugin='Rcpp',include=include)

用法：

> dim(C)
[1] 3000 3000
> system.time(f1(C))
   user  system elapsed 
  0.086   0.000   0.087

因此忽略了编译时间，即使在我的镀铬书上它也非常快。

更有效的方法来创建特定的带状矩阵

2 个答案: