diff --git a/R/mcov.R b/R/mcov.R new file mode 100644 index 0000000..64a814b --- /dev/null +++ b/R/mcov.R @@ -0,0 +1,85 @@ +#' @include procmod.frame.R +#' +NULL + +#' Compute the variance, covariance matrix of K coordinate matrices. +#' +#' Covariance between two matrices is defined as the sum of the +#' sigular values of the X'Y matrix. All the matrices must have +#' the same number of rows. +#' +#' @param ... the set of matrices +#' +#' @examples +#' # Build Three matrices of 3 rows. +#' A <- matrix(1:9,nrow=3) +#' B <- matrix(10:15,nrow=3) +#' C <- matrix(20:31,nrow=3) +#' # compute the variance covariance matrix +#' mvar(A,B,C) +#' mvar(A=A,B=B,C=C) +#' +#' @author Eric Coissac & Christelle Gonindard-Melodelima +#' @export +mvar = function(...) { + + Xs <- list(...) + if (length(Xs)==1) + if (is.list(Xs[[1]])) + Xs=as.procmod.frame(Xs[[1]]) + else if (is.procmod.frame(Xs[[1]])) + Xs=Xs[[1]] + else + Xs=procmod.frame(Xs[[1]]) + else + Xs=as.procmod.frame(Xs) + + Xnames=names(Xs) + + Xs <- lapply(Xs,scale,scale = FALSE) + + nX = length(Xs) + + Xx <- rep(1:nX,nX) + Xy <- rep(1:nX,rep(nX,nX)) + + XXs <- mapply(function(x,y) crossprod(Xs[[x]], Xs[[y]]), + Xx,Xy, + SIMPLIFY = FALSE) + + sol_xxs <- lapply(XXs,svd) + + CovXXs = sapply(sol_xxs, function(sol) sum(sol\$d)) + + + dim(CovXXs)=c(nX,nX) + colnames(CovXXs)=Xnames + rownames(CovXXs)=Xnames + + return(CovXXs) +} + +#' Compute the person correlation matrix of K coordinate matrices +#' +#' @author Eric Coissac +#' @author Christelle Gonindard-Melodelima +#' @export +mcor = function(...) { + cov = mvar(...) + s = sqrt(diag(cov)) + vv= outer(s,s) + return(cov/vv) +} + +#' Compute the person partial correlation matrix of K coordinate matrices +#' +#' @author Eric Coissac +#' @author Christelle Gonindard-Melodelima +#' @export +mcor.partial = function(...) { + C = solve(mcor(...)) + D = sqrt(diag(C) %o% diag(C)) + return(C/D) +} + +