#' @title ProcMod
#' @description blabla
#' @author Christelle Gonindard-Melodelima
#'
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 & is.list(Xs[[1]]))
    Xs=Xs[[1]]

  Xnames=names(Xs)
  nXs= sapply(Xs, nrow)

  if (any(nXs!=nXs[1])) {
    stop("Matrices have different number of rows: ", cat(nXs))
  }

  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)
}

#' Performs a procruste model on a set of coordinate matrices
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
pm = function (model,data) {
  cl=match.call()

  if (missing(data))
    data=NULL

  terms = terms(model,data=data)

  vars = eval(attr(terms(model,data=data),"variables"),
            envir = data,
            enclos = globalenv())

  names(vars)=rownames(attr(terms,"factors"))

  cvars= sapply(vars, class)
  if (! all(cvars %in% c("matrix","data.frame"))) {
    stop("All the variables are not matrices", cat(cvars))
  }

  vars = lapply(vars, as.matrix)


  nrvars= sapply(vars, nrow)

  if (any(nrvars!=nrvars[1])) {
    stop("Matrices have different number of rows: ", cat(nrvars))
  }

  attr(vars,"terms")=terms

  nvar = length(vars) - 1

  data.cov = do.call(mvar,vars)

  xy.cov = data.cov[2:(nvar+1),1,drop=FALSE]
  xx.cov = data.cov[2:(nvar+1),2:(nvar+1)]

  Y = vars[[1]]
  Xs= vars[-1]

  Ymean <- colMeans(Y)
  Xmeans<- lapply(Xs,colMeans)

  YC  <- scale(Y,scale=FALSE)
  XCs <- lapply(Xs,scale,scale = FALSE)
  XYs <- lapply(XCs,function(x) crossprod(YC, x))
  sol_yxs <- lapply(XYs,svd)
  A_xys <- lapply(sol_yxs, function(x) x$v %*% t(x$u))

  Xrots <- mapply(function(x,a) x %*% a,
                  XCs,A_xys,
                  SIMPLIFY = FALSE)

  if (length(xx.cov)>1)
    ixx.cov=solve(xx.cov)
  else
    ixx.cov=1/xx.cov

  scales=ixx.cov %*% xy.cov

  dim(scales)=NULL

  b  =  Ymean - Reduce(function(a,b) a+b,
                       mapply(function(d,coef,rot) coef * (d %*% rot),
                              Xmeans, scales, A_xys,
                              SIMPLIFY = FALSE))

  yhat = mapply(function(coef,xrot) coef * xrot,
                scales, Xrots,
                SIMPLIFY = FALSE)

  init=matrix(rep(0,nrow(yhat[[1]])*ncol(yhat[[1]])),
              nrow=nrow(yhat[[1]]))
  yhat = Reduce(function(a,b) a+b,
                yhat,
                init)

  yhat = sweep(yhat,2,b,"+")

  names(scales)=attr(terms,"term.labels")

  results = list(coefficients   = scales,
                 fitted.values  = yhat,
                 residuals      = Y - yhat,
                 df.residual    = nrow(Y) - length(scales) - 2,
                 call           = cl,
                 model          = vars,
                 terms          = terms,
                 A              = A_xys
                )

  class(results)="pm"

  return(results)
}

#' Default display function for `pm` objects.
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
print.pm = function(m,...) {
  cat(sprintf("\nCall:\n%s\n\nCoefficients:\n",
              deparse(m$call)))
  print(m$coefficients)
  invisible(m)
}

#' Default plot function for `pm` objects.
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
plot.pm = function(m,
                   points.cex=0.6,
                   labels.cex=0.6,
                   arrow.length=0.05,
                   asp=1,
                   ...) {

  layout(matrix(c(1,1,1,1,2,3),nrow = 2))

  xlim = c(min(m$model[[1]][,1],m$fitted.values[,1]),
           max(m$model[[1]][,1],m$fitted.values[,1])
          )
  ylim = c(min(m$model[[1]][,2],m$fitted.values[,2]),
           max(m$model[[1]][,2],m$fitted.values[,2])
          )

  centers = (m$model[[1]] + m$fitted.values)/2

  plot(m$model[[1]][,1:2],
       xlim=xlim,ylim=ylim,
       cex=points.cex,
       col="blue",
       asp=asp)

  points(m$fitted.values[,1:2],
       xlim=xlim,ylim=ylim,
       cex=points.cex,
       col="red")

  arrows(m$fitted.values[,1],m$fitted.values[,2],
         m$model[[1]][,1],m$model[[1]][,2],
         length = arrow.length,
         col="black")

  text(centers[,1],centers[,2],
       rownames(m$fitted.values),
       xlim=xlim,ylim=ylim,
       cex=labels.cex,
       col="black",
       pos=3)

  anova = anova(m)
  v=anova[,"Sum Sq"]
  names(v)=rownames(anova)
  barplot(v/sum(v),las=2)
}

#' Anova function for `pm` objects.
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
anova.pm = function(m,...) {

  ctrace <- function(MAT) sum(MAT^2)

  Xs <- lapply(m$model,scale,scale = FALSE)
  Y  <- Xs[[1]]
  Xs <- Xs[-1]

  Ymean <- colMeans(Y)

  Xrots <- mapply(function(x,a) x %*% a,
                  Xs,m$A,
                  SIMPLIFY = FALSE)

  Chat = mapply(function(coef,xrot) sweep(coef * xrot,
                                          2,
                                          Ymean,
                                          '-'),
                m$coefficients, Xrots,
                SIMPLIFY = FALSE)

  VarY  = ctrace(Y)

  VarYhats = sapply(Chat,ctrace)
  names(VarYhats) = names(m$coefficients)
  SChat = sum(VarYhats)

  SCE = sum(m$residuals^2)

  if (length(Xs)>1) {
    SCI = VarY - SCE - sum(SChat)
    SumSq  = c(VarYhats,Interactions=SCI,Residuals=SCE)
    Df     = c(rep(1,length(VarYhats)+1),m$df.residual)
  }
  else {
    SumSq  = c(VarYhats,Residuals=SCE)
    Df     = c(1,m$df.residual)
  }
  MeanSq = SumSq/Df
  Fvalue = c(MeanSq[-length(MeanSq)]/MeanSq[length(MeanSq)],NA)
  Pvalue = 1-pf(Fvalue,
                Df[-length(MeanSq)],
                Df[length(MeanSq)])

  result = data.frame(Df,
                      SumSq,
                      MeanSq,
                      Fvalue,
                      Pvalue)

  colnames(result)=c("Df","Sum Sq","Mean Sq","F value","Pr(>F)")


  attr(result, "heading")= paste("Analysis of Variance Table\n\nResponse:",
                                 all.vars(m$terms)[1]
                                )
  class(result)=c("anova",class(result))

  return(result)
}

summary.pm = function(object,
                      correlation = FALSE,
                      symbolic.cor = FALSE,
                      ...) {

  results = list(
    call = object$call,
    terms= object$terms

  )

  return(results)
}

AIC.pm = function(object, ..., k = 2) {

}
