#' @include procmod.frame.R
#' @include multivariate.R
#'
#' @import expm
#'
#' @author Christelle Gonindard-Melodelima
#' @author Eric Coissac
NULL

#' Compute the trace of a square matrix.
#'
#'
#' @param X a square matrix
#' @return the trace of X
#'
#' @examples
#'     m = matrix(1:16,nrow=4)
#'     ProcMod:::.Trace(m)
#'
#' @note Internal function do not use.
#'
#' @rdname internal.getPermuteMatrix
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#'
.Trace = function(X) sum(diag(X))

#' 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
#' @param permutation
#' @param rcovls
#'
#' @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
#'    varls2(A,B,C)
#'    varls2(A=A,B=B,C=C)
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
varls = function(...,nperm = 100,rcovls=FALSE) {

  if (is.numeric(nperm) &&
      length(nperm)==1 &&
      nperm==0)
    nperm=NULL

  if (is.null(nperm))
    rcovls=FALSE

  Xs <- list(...)
  if (length(Xs)==1) {
    x = Xs[[1]]
    if (is.procmod.frame(x))
      Xs=x
    else if (is.pm(x))
      return(x$cov)
    else
      Xs=procmod.frame(x)
  }
  else
      Xs=as.procmod.frame(Xs)

  Xnames=names(Xs)

  Xs <- ortho(Xs)

  XXs = as.procmod.frame(mapply(tcrossprod,
                                Xs,
                                SIMPLIFY = FALSE))

  nX = length(Xs)
  N  = nrow(Xs)-1

  CovXXs = matrix(0, nrow = nX, ncol = nX)

  # Computes the standard Covls covariance matrix
  for (i in seq_len(nX))
    for (j in i:nX) {
        CovXXs[i,j] = Re(.Trace(sqrtm(XXs[[i]] %*% XXs[[j]])))
    }


  CovXX2s = matrix(0, nrow = nX, ncol = nX)

  if (! is.null(nperm)) {
    rCovXXs = array(0,dim=c(nX,nX))
      for (i in seq_len(nX)) {
        for (j in i:nX) {
          rCovXXs[i,j] = null_varls_sim(Xs[i],Xs[j],nperm)
          rCovXXs[j,i] = rCovXXs[i,j]
          CovXXs[i,j]  = CovXXs[i,j] - rCovXXs[i,j]
        }
      }
  }

  for (i in seq_len(nX))
    for (j in i:nX)
      CovXXs[j,i] = CovXXs[i,j]

  CovXXs = CovXXs / N
  colnames(CovXXs)=Xnames
  rownames(CovXXs)=Xnames

  CovXXs = Re(CovXXs)

  if (rcovls)
    attr(CovXXs,"rcovls") = rCovXXs / N

  attr(CovXXs,"nperm") = nperm

  return(make_subS3Class(Re(CovXXs), "procmod.varls"))
}


#' Compute the person correlation matrix of K coordinate matrices
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
corls = function(...,nperm = 100,rcovls=FALSE) {
  cov = varls(...,nperm = nperm,rcovls = rcovls)
  s = sqrt(diag(cov))
  vv= outer(s,s)

  rls = make_subS3Class(cov/vv, "procmod.corls")
  attr(rls,"nperm")=attr(cov,"nperm")

  if (rcovls)
    attr(rls,"rcovls") = attr(rls,"rcovls") / vv

  return(rls)
}

#' Compute the person partial correlation matrix of K coordinate matrices
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
corls.partial = function(...,nperm = 100,rcovls=FALSE) {
  rls = corls(...,nperm = nperm,rcovls = rcovls)
  C = solve(rls)
  D = sqrt(diag(C) %o% diag(C))
  rp = make_subS3Class(C/D,"procmod.corls")
  attr(rp,"nperm")=attr(rls,"nperm")
  if (rcovls)
    attr(rp,"rcovls") = attr(rls,"rcovls")

  return(rp)
}

#' Compute the person partial correlation matrix of K coordinate matrices
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
print.procmod.varls = function (x, ...) {
  class(x)="matrix"
  attr(x,"permutations")=NULL
  attr(x,"rcovls") =NULL
  print(x)
}

#' Compute the person partial correlation matrix of K coordinate matrices
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
print.procmod.corls = function (x, ...) {
  class(x)="matrix"
  attr(x,"permutations")=NULL
  attr(x,"rcovls") =NULL
  print(x)
}
