Question

这是第1页中用于执行Gram Schmidt的MATLAB代码 http://web.mit.edu/18.06/www/Essays/gramschmidtmat.pdf

我正在尝试用R执行此操作数小时，因为我没有MATLAB 这是我的R

f=function(x){
m=nrow(x);
n=ncol(x);
Q=matrix(0,m,n);
R=matrix(0,n,n);

for(j in 1:n){
v=x[,j,drop=FALSE];

for(i in 1:j-1){
R[i,j]=t(Q[,i,drop=FALSE])%*%x[,j,drop=FALSE];
v=v-R[i,j]%*%Q[,i,drop=FALSE]
}

R[j,j]=max(svd(v)$d);
Q[,j,,drop=FALSE]=v/R[j,j]}

return(list(Q,R))}

它继续说错误：

v=v-R[i,j]%*%Q[,i,drop=FALSE]

或

R[j,j]=max(svd(v)$d);

我错误地将MATLAB代码转换为R ???

是什么意思

Answer 1

为了好玩，我添加了此代码的Armadillo版本并对其进行基准测试

犰狳代码：

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

using namespace Rcpp;

//[[Rcpp::export]]
List grahm_schimdtCpp(arma::mat A) {
    int n = A.n_cols;
    int m = A.n_rows;
    arma::mat Q(m, n);
    Q.fill(0);
    arma::mat R(n, n);
    R.fill(0);  
    for (int j = 0; j < n; j++) {
    arma::vec v = A.col(j);
    if (j > 0) {
        for(int i = 0; i < j; i++) {
        R(i, j) = arma::as_scalar(Q.col(i).t() *  A.col(j));
        v = v - R(i, j) * Q.col(i);
        }
    }
    R(j, j) = arma::norm(v, 2);
    Q.col(j) = v / R(j, j);
    }
    return List::create(_["Q"] = Q,
                     _["R"] = R
    );
    }

R代码未优化（直接基于算法）

grahm_schimdtR <- function(A) {
    m <- nrow(A)
    n <- ncol(A)
    Q <- matrix(0, nrow = m, ncol = n)
    R <- matrix(0, nrow = n, ncol = n)
    for (j in 1:n) {
    v <- A[ , j, drop = FALSE]
        if (j > 1) {
    for(i in 1:(j-1)) {
            R[i, j] <- t(Q[,i,drop = FALSE]) %*% A[ , j, drop = FALSE]
            v <- v - R[i, j] * Q[ ,i]
    }
    }
    R[j, j] = norm(v, type = "2")
    Q[ ,j] = v / R[j, j]
    }

    list("Q" = Q, "R" = R)

}

R

中的原生QR分解

qrNative <- function(A) {
    qrdec <- qr(A)
    list(Q = qr.R(qrdec), R = qr.Q(qrdec))
}

我们将使用与原始文档相同的矩阵（上面的帖子中的链接）进行测试

A <- matrix(c(4, 3, -2, 1), ncol = 2)

all.equal(grahm_schimdtR(A)$Q %*% grahm_schimdtR(A)$R, A)
## [1] TRUE

all.equal(grahm_schimdtCpp(A)$Q %*% grahm_schimdtCpp(A)$R, A)
## [1] TRUE

all.equal(qrNative(A)$Q %*% qrNative(A)$R, A)
## [1] TRUE

现在让我们对它进行基准测试

require(rbenchmark)
set.seed(123)
A <- matrix(rnorm(10000), 100, 100)
benchmark(qrNative(A),
          grahm_schimdtR(A),
          grahm_schimdtCpp(A),
          order = "elapsed")
##                  test replications elapsed relative user.self
## 3 grahm_schimdtCpp(A)          100   0.272    1.000     0.272
## 1         qrNative(A)          100   1.013    3.724     1.144
## 2   grahm_schimdtR(A)          100  84.279  309.849    95.042
##   sys.self user.child sys.child
## 3    0.000          0         0
## 1    0.872          0         0
## 2   72.577          0         0

我真的很喜欢将代码移植到Rcpp中是多么容易....

Answer 2

如果要将Matlab中的代码转换为R，那么代码语义（代码逻辑）应保持相同。例如，在您的代码中，您根据给定的Matlab代码在t(Q[,i,drop=FALSE])中转置Q.但Q[,i,drop=FALSE]不会返回列向量中的列。因此，我们可以使用以下语句将其作为列向量：

matrix(Q[,i],n,1); # n is the number of rows.

如果R[j,j]=max(svd(v)$d)是向量（行或列），则v中没有错误。

是的，

中有错误

v=v-R[i,j]%*%Q[,i,drop=FALSE]

因为您正在使用矩阵乘法。相反，你应该使用正常的乘法：

v=v-R[i,j] * Q[,i,drop=FALSE]

此处R[i,j]是一个数字，而Q[,i,drop=FALSE]是一个数字。因此，尺寸不匹配就出现在这里。

还有一件事，如果j为3，那么1:j-1会返回[0,1,2]。因此，它应该更改为1:(j-1)，它会为[{1}}的相同值返回[1,2]。但是有一个问题！如果j为2，则j返回[1,0]。因此，对于向量或矩阵，第0个索引是未定义的。因此，我们可以通过放置条件表达式来绕过1:(j-1)值。

以下是Gram Schmidt算法的工作代码：

如果您需要将代码包装到一个函数中，您可以根据自己的方便这样做。

Answer 3

这里有一个非常类似于你的版本，但没有使用额外的变量v。我直接使用Q矩阵。所以不需要使用drop。当然，由于索引中有j-1，您需要添加条件j>1。

f=function(x){
  m <- nrow(x)
  n <- ncol(x)
  Q <- matrix(0, m, n)
  R <- matrix(0, n, n)
  for (j in 1:n) {
    Q[, j] <- x[, j]
    if (j > 1) {
      for (i in 1:(j - 1)) {
        R[i, j] <- t(Q[, i]) %*% Q[, j]
        Q[, j] <- Q[, j] - R[i, j] * Q[, i]
      }
    }
    R[j, j] <- max(svd(Q[, j])$d)
    Q[, j] <- Q[, j]/R[j, j]
  }
  return(list(Q = Q, R = R))
}

编辑添加一些基准测试：

为了得到一些实际案例，我使用Hilbert包中的Matrix矩阵。

library(microbenchmark)
library(Matrix)
A <- as.matrix(Hilbert(100))
microbenchmark(grahm_schimdtR(A),
               grahm_schimdtCpp(A),times = 100L)

Unit: milliseconds
expr       min         lq     median        uq        max neval
grahm_schimdtR(A) 330.77424 335.648063 337.443273 343.72888 601.793201   100
grahm_schimdtCpp(A)   1.45445   1.510768   1.615255   1.66816   2.062018   100

正如预期的那样， CPP 解决方案确实非常好。

Answer 4

你可以简单地使用Hans W. Borchers＆＃39; pracma package，它提供了许多在R中翻译的Octave / Matlab函数。

> library(pracma)
> gramSchmidt
function (A, tol = .Machine$double.eps^0.5) 
{
    stopifnot(is.numeric(A), is.matrix(A))
    m <- nrow(A)
    n <- ncol(A)
    if (m < n) 
        stop("No. of rows of 'A' must be greater or equal no. of colums.")
    Q <- matrix(0, m, n)
    R <- matrix(0, n, n)
    for (k in 1:n) {
        Q[, k] <- A[, k]
        if (k > 1) {
            for (i in 1:(k - 1)) {
                R[i, k] <- t(Q[, i]) %*% Q[, k]
                Q[, k] <- Q[, k] - R[i, k] * Q[, i]
            }
        }
        R[k, k] <- Norm(Q[, k])
        if (abs(R[k, k]) <= tol) 
            stop("Matrix 'A' does not have full rank.")
        Q[, k] <- Q[, k]/R[k, k]
    }
    return(list(Q = Q, R = R))
}
<environment: namespace:pracma>

格拉姆施密特与R

4 个答案: