2020-02-26 12:44:53 +00:00
|
|
|
#' Random sample from Stiefel manifold.
|
|
|
|
#'
|
|
|
|
#' Draws a random sample from the invariant measure on the Stiefel manifold
|
2019-12-16 16:34:35 +00:00
|
|
|
#' \eqn{S(p, q)}.
|
|
|
|
#'
|
|
|
|
#' @param p row dimension
|
|
|
|
#' @param q col dimension
|
2020-02-26 12:44:53 +00:00
|
|
|
#' @return A \eqn{p \times q}{p x q} semi-orthogonal matrix.
|
2019-12-16 16:34:35 +00:00
|
|
|
#' @examples
|
2020-02-26 12:44:53 +00:00
|
|
|
#' V <- rStiefel(6, 4)
|
2019-12-16 16:34:35 +00:00
|
|
|
#' @export
|
|
|
|
rStiefel <- function(p, q) {
|
|
|
|
return(qr.Q(qr(matrix(rnorm(p * q, 0, 1), p, q))))
|
|
|
|
}
|
|
|
|
|
|
|
|
#' Null space basis of given matrix `V`
|
|
|
|
#'
|
|
|
|
#' @param V `(p, q)` matrix
|
|
|
|
#' @return Semi-orthogonal `(p, p - q)` matrix spaning the null space of `V`.
|
|
|
|
#' @keywords internal
|
|
|
|
#' @export
|
|
|
|
null <- function(V) {
|
|
|
|
tmp <- qr(V)
|
|
|
|
set <- if(tmp$rank == 0L) seq_len(ncol(V)) else -seq_len(tmp$rank)
|
|
|
|
return(qr.Q(tmp, complete = TRUE)[, set, drop = FALSE])
|
|
|
|
}
|