#' @include mprocuste.R
#' @import permute
#' @import foreach
#' @import stats
NULL


# anova.pm <- function(object, permutations = how(nperm = 999), ...) {
#   mf <- object$model
#   coef <- object$coefficients
#
#   sdxy <- sqrt(diag(object$cov))
#
#   mt <- terms(mf)
#
#   reponse <- attr(mt, "response")
#   explicatives <- attr(mt, "term.labels")
#   nXs <- length(explicatives)
#
#   coef_norm <- coef * sdxy[explicatives] / sdxy[reponse]
#
#
#   cors <- object$cov / outer(sdxy, sdxy)
#
#   # print(reponse)
#   # print(explicatives)
#
#   cors_Y <- cors[reponse, explicatives]
#
#   TSS <- object$TSS
#   RSS <- sum(object$residuals ^ 2)
#   nvar <- ncol(object$residuals)
#
#   ESS <- TSS * abs(coef_norm * cors_Y)
#
#   names(ESS) <- explicatives
#
#   SumSq <- c(ESS, Residuals = RSS)
#   Df <- c(rep(nvar, nXs), object$df.residual)
#   MeanSq <- SumSq / Df
#   Fvalue <- c(MeanSq[-length(MeanSq)] / MeanSq[length(MeanSq)], NA)
#   Pvalue <- 1 - ecdf(rnorm(1000000,1,1/sqrt(nvar))/rnorm(1000000,1,1/sqrt(m$df.residual)))(Fvalue)
#
#   Pvalue2 <- 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(object$terms)[1])
#   class(result) <- c("anova", class(result))
#
#   return(result)
# }

#' Generate permutation matrix according to a schema.
#'
#' @param perm can be a single number for the number of simple permutations, a
#'   result of \code{\link[permute]{how}} defining a permutation scheme or a
#'   permutation matrix
#'
#' @param N a single number indicating the number of elements to permute
#'
#' @param strata A factor, or an object that can be coerced to a factor via
#'   as.factor, specifying the strata for permutation.
#'
#' The permutation schema is defined using the \code{\link[permute]{how}}
#' function. The implementation of this function is currectly extraced from
#' the VEGAN package and just copied pasted here to avoid dependency on an
#' hidden vegan function.
#'
#' @examples
#'
#'   ProcMod:::.getPermuteMatrix(4,5)
#'
#' @rdname internal.getPermuteMatrix
#' @author Gavin Simpson (VEGAN developper)
#'
.getPermuteMatrix <- function(perm, N, strata = NULL) {
  if (length(perm) == 1) {
    perm <- how(nperm = perm)
  }
  if (!missing(strata) && !is.null(strata)) {
    if (inherits(perm, "how") && is.null(getBlocks(perm))) {
      setBlocks(perm) <- strata
    }
  }
  if (inherits(perm, "how")) {
    perm <- shuffleSet(N, control = perm)
  } else {
    if (!is.integer(perm) && !all(perm == round(perm))) {
      stop("permutation matrix must be strictly integers: use round()")
    }
  }
  if (is.null(attr(perm, "control"))) {
    attr(perm, "control") <- structure(list(
      within = list(type = "supplied matrix"),
      nperm = nrow(perm)
    ), class = "how")
  }
  perm
}


#' Anova function for `pm` objects.
#'
#'
#' @param object an object containing the results returned by the
#'   \code{\link[ProcMod]{pm}} model fitting function.
#' @param permutations can be a single number for the number of simple permutations, a
#'   result of \code{\link[permute]{how}} defining a permutation scheme or a
#'   permutation matrix
#'
#' @examples
#'   A <- simulate_matrix(n=15,p=50)
#'   B <- simulate_correlation(A,p=40,r2=0.5)
#'   C <- simulate_correlation(A,p=40,r2=0.1)
#'   D <- simulate_correlation(A,p=40,r2=0.01)
#'   E <- simulate_matrix(n=15,p=50)
#'
#'   data <- procmod_frame(A=A, B=B, C=C, D=D, E=E)
#'
#'   m <- pm(A ~ B + C + D + E, data = data, nrand=300)
#'
#'   anova(m,permutation=300)
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @export
anova.pm <- function(object, permutations = how(nperm = 999), ...) {
  mf <- object$model
  mt <- terms(object)

  cov <- object$cov
  cors <- cov2cor(cov)
  rcov <- attr(cov,"rcovls")

  parts <- abs(qr.coef(qr(cors[-1, -1]), cors[-1, 1])) * cors[-1, 1]
  pseudo_f <- parts / (1 - sum(parts))

  explicatives <- attr(mt, "term.labels")
  nXs <- length(explicatives)
  reponse <- attr(mt, "response")

  data  <- vars_procmod(mt,mf)
  rdata <- as_procmod_data_matrix(mf[reponse])

  n = nrow(mf)

  extra_param <- list(...)
  strata = extra_param$strata

  p <- if (is.null(strata))
         .getPermuteMatrix(permutations, n)
       else
         .getPermuteMatrix(permutations, n,
                           strata = strata)

  n_rand <- nrow(p)

  flike <- matrix(0,nrow = n_rand, ncol = length(data))
  if (.has_doParallel && getDoParRegistered()) {
      `%dp%` <- `%dopar%`
    }
  else{
      `%dp%` <- `%do%`
    }

  alldata <- as_procmod_frame(c(list(rdata),data))

  flike <- foreach(ip = seq_len(n_rand),
                     .combine = rbind) %dp% {
      f = numeric(length(data))
      pd <- data[p[ip,],]
      for (id in seq_along(data)) {
        v <- alldata
        v[[id + 1]] <- pd[[id]]
        r <- varls(v, nrand = 0) - rcov
        #r[r < 0] <- 0
        r <- cov2cor(r)
        rparts <- abs(qr.coef(qr(r[-1, -1]), r[-1, 1])) * r[-1, 1]
        f[id] <- rparts[id] / (1 - sum(rparts))
      }

      f
  }

  # return(flike)
  #ecf   <- apply(flike,2,ecdf)
  #p_val <- 1 - mapply(function(f,x) f(x),ecf,pseudo_f)

  p_val <- (colSums(sweep(flike,
                          MARGIN = 2,
                          STATS = pseudo_f,
                          FUN = ">=")) + 1) / (n_rand + 1)


# cors_Y <- cors[reponse, explicatives]

  TSS <- object$TSS
  ESS <- TSS * parts
  RSS <- TSS - sum(ESS)

  names(ESS) <- explicatives

  SumSq <- c(ESS, Residuals = RSS)
  Df <- c(rep(1, nXs), object$df.residual)
  MeanSq <- SumSq / Df
  Qvalue <- c(pseudo_f, NA)
  Pvalue <- c(p_val,NA)

  result <- data.frame(Df,
                       SumSq,
                       MeanSq,
                       Qvalue,
                       Pvalue)

  colnames(result) <-
    c("peudo Df", "Sum Sq", "Mean Sq", "Q value", "Pr(>Q)")


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

  return(result)
}

