R/summarize.R

In nfrerebeau/FactoHelpeR: Extract and Visualize FactoMineR Results

#' @include AllGenerics.R
NULL

# PCA ==========================================================================
#' @export
#' @rdname summarize
summarize.PCA <- function(x, select = c("individuals", "sup_individuals",
                                        "variables", "qualitative",
                                        "quantitative"),
                          rows = 1:10, axes = 1:3, ...) {
  # Validation
  select <- match.arg(select, several.ok = FALSE)
  object <- switch (
    select,
    individuals = x$ind,
    sup_individuals = x$ind.sup,
    variables = x$var,
    qualitative = x$quali.sup,
    quantitative = x$quanti.sup
  )

  if (!is.null(object)) {
    elements <- match.arg(
      names(object),
      c("dist", "inertia", "coord", "cos2", "contrib", "v.test", "vtest"),
      several.ok = TRUE
    )
    ncols <- sum(c("coord", "cos2", "contrib", "v.test") %in% elements)
    extra <- sum(c("dist", "inertia") %in% elements)

    max_rows <- nrow(object$coord)
    max_cols <- ncol(object$coord)
    rows <- rows[rows %in% 1:max_rows]
    columns <- axes[axes %in% 1:max_cols]

    nrows <- min(length(rows), max_rows)
    components <- length(columns)
    results <- matrix(NA, nrow = nrows, ncol = extra + ncols * components)
    rownames(results) <- rownames(object$coord)[rows]
    colnames(results) <- paste("V", 1:ncol(results), sep = "")

    comment <- ""
    if (nrows < max_rows) {
      comment <- paste("(", nrows, " out of ", max_rows, ")", sep = "")
    }

    index <- 1
    k <- ncols * (0:(components - 1))
    if (extra) {
      if ("dist" %in% elements) {
        if (!is.null(object$dist))
          results[, index] <- object$dist[rows]
        colnames(results)[index] <- "dist"
      }
      if ("inertia" %in% elements) {
        if (!is.null(object$inertia))
          results[, index] <- object$inertia[rows] * 1000
        colnames(results)[index] <- "Inertia (x1000)"
      }
      index <- index + 1
    }
    if ("coord" %in% elements) {
      if (!is.null(object$coord))
        results[, index + k] <- object$coord[rows, columns, drop = FALSE]
      colnames(results)[index + k] <- paste("PC", columns, ".coord", sep = "")
      index <- index + 1
    }
    if ("cos2" %in% elements) {
      if (!is.null(object$cos2))
        results[, index + k] <- object$cos2[rows, columns, drop = FALSE]
      colnames(results)[index + k] <- paste("PC", columns, ".cos2", sep = "")
      index <- index + 1
    }
    if ("contrib" %in% elements) {
      if (!is.null(object$contrib))
        results[, index + k] <- object$contrib[rows, columns, drop = FALSE]
      colnames(results)[index + k] <- paste("PC", columns, ".contrib", sep = "")
      index <- index + 1
    }
    if ("v.test" %in% elements) {
      if (!is.null(object$v.test))
        results[, index + k] <- object$v.test[rows, columns, drop = FALSE]
      colnames(results)[index + k] <- paste("PC", columns, ".vtest", sep = "")
      index <- index + 1
    }

    final <- as.data.frame(results)
    attr(final, "comment") <- comment
  } else {
    final <- NULL
  }
  return(final)
}