Search code examples
rmatrixsparse-matrix

Efficiently creating the following patterned upper triangle matrix in R


I have the following code to create a patterned upper triangle matrix appended with last column in R. I wonder if someone point more efficient way to get the same.

matrix_k <- function(n){
  j <- 0
  kn22 <- NULL
  while(j < n-1){
    long <- sqrt((n-j-1)*(n-j)) 
    i <- 0
    kn2 <- NULL
    while(i < n){
      if(i == j) k = (n-j-1) else k = NA
      if(i < j)  k =  0      else k = k
      if(i > j)  k = -1      else k = k
      kn <- k/long
      kn2 <- cbind(kn2, kn)
      i <- i+1  
    }
    kn22 <- rbind(kn22, kn2)
    j <- j+1    
  }
  return(kn22)
}


matrix_k(5)
           kn         kn         kn         kn         kn
[1,] 0.8944272 -0.2236068 -0.2236068 -0.2236068 -0.2236068
[2,] 0.0000000  0.8660254 -0.2886751 -0.2886751 -0.2886751
[3,] 0.0000000  0.0000000  0.8164966 -0.4082483 -0.4082483
[4,] 0.0000000  0.0000000  0.0000000  0.7071068 -0.7071068

Solution

  • Here is a faster and somewhat more compact version:

    mtrx_k2 <- function(n) {
      m <- matrix(0, nrow = (n-1), ncol=n)
      long <- sqrt((n - (0:(n-2)) - 1) * (n - (0:(n-2))))
      diag(m) <- (n - (0:(n-2)) - 1)
      m[upper.tri(m)] <- -1
      m / long[row(m)]
    }
    
    
    mtrx_k2(6)==matrix_k(6)
    #>        kn   kn   kn   kn   kn   kn
    #> [1,] TRUE TRUE TRUE TRUE TRUE TRUE
    #> [2,] TRUE TRUE TRUE TRUE TRUE TRUE
    #> [3,] TRUE TRUE TRUE TRUE TRUE TRUE
    #> [4,] TRUE TRUE TRUE TRUE TRUE TRUE
    #> [5,] TRUE TRUE TRUE TRUE TRUE TRUE
    
    microbenchmark::microbenchmark(matrix_k(100), mtrx_k2(100))
    #> Unit: microseconds
    #>           expr       min         lq       mean    median         uq
    #>  matrix_k(100) 31411.208 36039.5930 40019.9648 38840.433 41367.2190
    #>   mtrx_k2(100)   260.691   302.1135   640.6276   316.326   524.0615
    #>        max neval cld
    #>  88799.178   100   b
    #>   4830.734   100  a