LQ factorization function for RNimble

48 Views Asked by At

I need to write a function in R that decomposes a rectangular m x n (m > n) matrix A into an m x n lower triangular L matrix and a n x n orthogonal Q matrix. I need to write out every single step of the method so that I can use it in my nimbleCode function. Specifically, what I need is a function that does what the lq() function does from the tensr package with the addition that the all the steps need to be written out. The functions I have so far are given below (they give the Gram-Schmidt decomposition of the A'), but the problem is that they generate an nxm orthogonal matrix Q and a mxm lower triangular matrix L which is not what I need. I was hoping that somebody can help me rewrite my code to get what I need.

nimQR.Q = nimbleFunction(
  run = function(A = double(2)){
    returnType(double(2))
    A1 = t(A)
    m <- dim(A1)[1]
    n <- dim(A1)[2]
    Q <- matrix(0, m, n)
    R <- matrix(0, n, n)
    for (k in 1:n) {
      Q[1:m, k] <- A1[1:m, k]
      if (k > 1) {
        for (i in 1:(k - 1)) {
          R[i, k] <- t(Q[1:m, i]) %*% Q[1:m, k]
          Q[1:m, k] <- Q[1:m, k] - R[i, k] * Q[1:m, i]
        }
      }
      R[k, k] <- sum(abs(Q[, k])^2)^(1/2)
      Q[1:m, k] <- Q[1:m, k]/R[k, k]
    }
    return(Q)
})

nimQR.R = nimbleFunction(
  run = function(A = double(2)){
    returnType(double(2))
    A1 = t(A)
    m <- dim(A1)[1]
    n <- dim(A1)[2]
    Q <- matrix(0, m, m)
    R <- matrix(0, n, n)
    for (k in 1:n) {
      Q[1:m, k] <- A1[1:m, k]
      if (k > 1) {
        for (i in 1:(k - 1)) {
          R[i, k] <- t(Q[1:m, i]) %*% Q[1:m, k]
          Q[1:m, k] <- Q[1:m, k] - R[i, k] * Q[1:m, i]
        }
      }
      R[k, k] <- sum(abs(Q[1:m, k])^2)^(1/2)
      Q[1:m, k] <- Q[1:m, k]/R[k, k]
    }
    return(t(R))
    
  })

0

There are 0 best solutions below