34 lines
839 B
R
34 lines
839 B
R
|
#' Half vectorization of a matrix (lower part)
|
||
|
#' @export
|
||
|
vech <- function(A) A[lower.tri(A, diag = TRUE)]
|
||
|
|
||
|
#' @export
|
||
|
vech.index <- function(p) which(.row(c(p, p)) >= .col(c(p, p)))
|
||
|
|
||
|
#' @export
|
||
|
vech.pinv.index <- function(p) {
|
||
|
index <- matrix(NA_integer_, p, p)
|
||
|
index[lower.tri(index, diag = TRUE)] <- seq_len(p * (p + 1L) / 2L)
|
||
|
index[upper.tri(index)] <- t(index)[upper.tri(index)]
|
||
|
|
||
|
index
|
||
|
}
|
||
|
|
||
|
#' pseudo inserse of the half vectorization
|
||
|
#'
|
||
|
#' @examples
|
||
|
#' # only valid for symmetric matrices
|
||
|
#' A <- matrix(rnorm(4^2), 4)
|
||
|
#' A <- A + t(A)
|
||
|
#' all.equal(A, vech.pinv(vech(A)))
|
||
|
#'
|
||
|
#' @export
|
||
|
vech.pinv <- function(a) {
|
||
|
# determin original dimensions
|
||
|
p <- as.integer((sqrt(8 * length(a) + 1) - 1) / 2)
|
||
|
stopifnot(p * (p + 1L) == 2L * length(a))
|
||
|
|
||
|
# de-vectorized matrix
|
||
|
matrix(a[vech.pinv.index(p)], p, p)
|
||
|
}
|