76 lines
1.9 KiB
R
76 lines
1.9 KiB
R
#' @rdname matProj
|
|
#' @export
|
|
projSym <- function(A) 0.5 * (A + t(A))
|
|
#' @rdname matProj
|
|
#' @export
|
|
projDiag <- function(A) diag(diag(A))
|
|
#' @rdname matProj
|
|
#' @export
|
|
.projBand <- function(dims, low, high) {
|
|
diag.index <- .row(dims) - .col(dims)
|
|
mask <- (diag.index <= low) & (-high <= diag.index)
|
|
function(A) A * mask
|
|
}
|
|
#' @rdname matProj
|
|
#' @export
|
|
.projSymBand <- function(dims, low, high) {
|
|
diag.index <- .row(dims) - .col(dims)
|
|
mask <- (diag.index <= low) & (-high <= diag.index)
|
|
function(A) projSym(A) * mask
|
|
}
|
|
#' @rdname matProj
|
|
#' @export
|
|
.projPSD <- function(sym = FALSE) {
|
|
if (sym) {
|
|
function(A) {
|
|
eig <- eigen(A, symmetric = TRUE)
|
|
eig$vectors %*% (pmax(0, eig$values) * t(eig$vectors))
|
|
}
|
|
} else {
|
|
function(A) {
|
|
eig <- eigen(0.5 * (A + t(A)), symmetric = TRUE)
|
|
eig$vectors %*% (pmax(0, eig$values) * t(eig$vectors))
|
|
}
|
|
}
|
|
}
|
|
#' @rdname matProj
|
|
#' @export
|
|
.projRank <- function(rank) {
|
|
force(rank)
|
|
function(A) {
|
|
rank <- min(dim(A), rank)
|
|
svdA <- La.svd(A, rank, rank)
|
|
svdA$u %*% (svdA$d[seq_len(rank)] * svdA$vt)
|
|
}
|
|
}
|
|
#' @rdname matProj
|
|
#' @export
|
|
.projSymRank <- function(rank) {
|
|
force(rank)
|
|
function(A) {
|
|
rank <- min(dim(A), rank)
|
|
svdA <- La.svd(0.5 * (A + t(A)), rank, rank)
|
|
svdA$u %*% (svdA$d[seq_len(rank)] * svdA$vt)
|
|
}
|
|
}
|
|
#' @rdname matProj
|
|
#' @export
|
|
projStiefel <- function(A) {
|
|
# Using a polar decomposition of `A = Q P` via SVD `A = U D V^T`. Compaired
|
|
# to a QR decomposition the polar decomposition is unique, making it "stabel".
|
|
svdA <- La.svd(A)
|
|
svdA$u %*% svdA$vt # = Q
|
|
}
|
|
# .projKron <- function(dims) {
|
|
# ... # TODO: Implement this!
|
|
# }
|
|
|
|
#' @rdname matProj
|
|
#' @export
|
|
.projMaskedMean <- function(mask) {
|
|
force(mask)
|
|
function(A) {
|
|
`[<-`(matrix(0, nrow(A), ncol(A)), mask, mean(A[mask]))
|
|
}
|
|
}
|