#' @include procmod.frame.R
#' @import MASS
#'
NULL

library(MASS)

#' Project a distance matrix in a euclidean space (NMDS).
#'
#' Project a set of points defined by a distance matrix in
#' an eucleadean space using the Kruskal's Non-metric
#' Multidimensional Scaling. This function is mainly a simplified
#' interface on the \code{\link[MASS]{isoMDS}} function using as
#' much as possible dimensionsto limit the stress. The aims of this
#' NDMS being only to project point in an orthogonal space therefore
#' without any correlation between axis. Because a non-metric method
#' is used no condition is required on the used distance.
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
nmds = function(distances,
                maxit = 50, trace = TRUE,
                tol = 0.001, p = 2) {
  if (inherits(distances,"matrix"))
    distances=as.dist(distances)

  stopifnot(inherits(distances,"dist"))

  k = attributes(distances)$Size - 1

  y = suppressWarnings(cmdscale(distances,k))
  k = ncol(y)

  n = isoMDS(distances,
             y=y,
             k=k,
             maxit = maxit,
             trace = trace,
             tol = tol,
             p=p)

  p = n$points
  attributes(p)$stress = n$stress
  attributes(p)$projected='nmds'

  return(p)
}

#' Project a distance matrix in a euclidean space (PCOA).
#'
#' Project a set of points defined by a distance matrix in
#' an eucleadean space using the Principal Coordinates Analysis
#' method. This function is mainly a simplified
#' interface on the \code{\link[stats]{cmdscale}} function using as
#' much as possible dimensions for the projection. The aims of this
#' PCoA being only to project point in an orthogonal space therefore
#' without any correlation between axis. Because a metric method
#' is used the used distance must be euclidean
#' (cf \code{\link[ProcMod]{is.euclid}}).
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
pcoa = function(distances) {
  if (inherits(distances,"matrix"))
    distances=as.dist(distances)

  stopifnot(inherits(distances,"dist"))

  k = attributes(distances)$Size - 1
  x = suppressWarnings(cmdscale(distances,k=k))
  attributes(x)$projected='pcoa'

  return(x)
}

#' Project a set of points in a euclidean space (PCA).
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
pca = function(data,scale=FALSE) {
  k = min(nrow(data)-1,ncol(data))
  p = prcomp(data,
             retx = TRUE,
             center = TRUE,
             scale. = scale,
             tol=0)

  x = p$x
  attributes(x)$projected='pca'
  return(x)
}

#' Double centering of a matrix.
#'
#' colSums and rowSums of the returned matrix are all equal to zero.
#'
#' Inspired from the algorithm described in stackoverflow
#' \url{https://stackoverflow.com/questions/43639063/double-centering-in-r}
#'
#' @export
bicenter = function(m) {

  # compute the row-wise and column-wise mean matrices
  R = m*0 + rowMeans(m)
  C = t(m*0 + colMeans(m))

  # substract them and add the grand mean
  return(m - R - C + mean(m[]))
}

#' Test if the distance matrix is euclidean.
#'
#' Actually a simplified version of the ADE4 implementation
#' (\code{\link[ade4]{is.euclid}}).
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
is.euclid = function (distances, tol = 1e-07)
{
  if (!inherits(distances, "dist"))
    stop("Object of class 'dist' expected")

  if (any(distances < tol))
    warning("Zero distance(s)")

  distances <- as.matrix(distances)
  n <- ncol(distances)
  delta <- -0.5 * ProcMod::bicenter(distances * distances)
  lambda <- eigen(delta, symmetric = TRUE, only.values = TRUE)$values
  w0 <- lambda[n]/lambda[1]
  return((w0 > -tol))
}

is.orthogonal = function(x) {
  stopifnot(is.procmod.frame(x))
  return(!is.null(attr(x,'projected')))
}

#' Project a dataset in a euclidean space.
#'
#' Project a set of points defined by a distance matrix
#' or a set of variables in an eucleadean space.
#' If the distance matrix is a metric, this is done using
#' the \code{\link[ProcMod]{pcoa}} function,
#' for other distance the \code{\link[ProcMod]{nmds}} is used.
#' When points are described by a set of variable the
#' \code{\link[ProcMod]{nmds}} is used.
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
ortho = function(data,...) {
  UseMethod("ortho",data)
}

#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
ortho.dist = function(x,tol = 1e-7) {
  if (ProcMod::is.euclid(x,tol = tol))
    return(ProcMod::pcoa(x))
  else
    return(ProcMod::nmds(x))
}

#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
ortho.matrix = function(x,scale=FALSE) {
  pca(x,scale = scale)
}

#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
ortho.data.frame = function(x,scale=FALSE) {
  if (!is.null(attributes(x)$is.dist) &&
      attributes(x)$is.dist==TRUE)
    return(ortho(as.dist(as.matrix(x))))

  pca(as.matrix(x),scale = scale)
}


#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
ortho.procmod.frame = function(x) {
  if (is.orthogonal(x))
    return(x)

  n = ncol(x)

  p = vector(mode = 'character', length = n)
  for (i in seq_len(n)) {
      xt=ortho(x[[i]])
      p[i]=attributes(xt)$projected
      x[[i]]=xt
  }

  names(p) = names(x)
  attributes(x)$projected=p

  return(x)
}
