# R/SYS.R In BenBarnard/slidR: Heteroscedastic Linear Dimension Reduction

#### Documented in SYS

```#'SYS
#'
#' @param x data
#' @param svdMethod svd function used for dimesion reduction by default
#'                  svd in base is used
#' @param covEst covariance estimator used forming M matrix
#' @param ... options passed to covEst and svd methods
#'
#' @return list of reduced data, projection matrix,
#'          group variable, discrimination function,
#'          m matrix.
#' @export
#'
SYS <- function(x, svdMethod = svd, covEst = Haff_shrinkage, ...){
matrix_ls <- x

ls <- list(...)
ls\$data <- matrix_ls

xbar <- lapply(matrix_ls, colMeans)
covs <- lapply(matrix_ls, cov)
invCovs <- lapply(covs, solve)

StildeInv_ls <- lapply(matrix_ls, function(x, ls){
ls\$x <- x
do.call(covEst, ls)
}, ls = ls)

projectedMeanDiffs <- Reduce(cbind, mapply(function(x, y){
x %*% y - StildeInv_ls[[1]] %*% xbar[[1]]
}, StildeInv_ls, xbar, SIMPLIFY = FALSE)[-1])

covsDiffs <- Reduce(cbind, lapply(covs, function(x){x - covs[[1]]})[-1])

M <- cbind(projectedMeanDiffs, covsDiffs)

projection <- t(do.call(svdMethod, list(M))\$u)

projectedData <- lapply(matrix_ls, FUN = projection_func, proj = projection)

object <- list(projectedData = projectedData,
projectionMatrix = projection,
M = M,
method = SYS,
covEst = covEst)
object
}
```
BenBarnard/slidR documentation built on March 21, 2018, 2:26 p.m.