MEDA: Multivariate Exploratory Data Analysis

# This file is automatically generated, you probably don't want to edit this

PCAOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "PCAOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            actvars = NULL,
            quantisup = NULL,
            qualisup = NULL,
            individus = NULL,
            tuto = TRUE,
            norme = TRUE,
            coordvar = FALSE,
            contribvar = FALSE,
            cosvar = FALSE,
            coordind = FALSE,
            contribind = FALSE,
            cosind = FALSE,
            proba = 5,
            nFactors = 2,
            abs = 1,
            ord = 2,
            varact = TRUE,
            varillus = TRUE,
            indact = TRUE,
            modillus = TRUE,
            habillage = NULL,
            ncp = 5,
            graphclassif = FALSE,
            nbclust = -1, ...) {

            super$initialize(
                package="MEDA",
                name="PCA",
                requiresData=TRUE,
                ...)

            private$..actvars <- jmvcore::OptionVariables$new(
                "actvars",
                actvars,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..quantisup <- jmvcore::OptionVariables$new(
                "quantisup",
                quantisup,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..qualisup <- jmvcore::OptionVariables$new(
                "qualisup",
                qualisup,
                suggested=list(
                    "nominal",
                    "ordinal"),
                permitted=list(
                    "factor"))
            private$..individus <- jmvcore::OptionVariable$new(
                "individus",
                individus,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..tuto <- jmvcore::OptionBool$new(
                "tuto",
                tuto,
                default=TRUE)
            private$..norme <- jmvcore::OptionBool$new(
                "norme",
                norme,
                default=TRUE)
            private$..coordvar <- jmvcore::OptionBool$new(
                "coordvar",
                coordvar,
                default=FALSE)
            private$..contribvar <- jmvcore::OptionBool$new(
                "contribvar",
                contribvar,
                default=FALSE)
            private$..cosvar <- jmvcore::OptionBool$new(
                "cosvar",
                cosvar,
                default=FALSE)
            private$..coordind <- jmvcore::OptionBool$new(
                "coordind",
                coordind,
                default=FALSE)
            private$..contribind <- jmvcore::OptionBool$new(
                "contribind",
                contribind,
                default=FALSE)
            private$..cosind <- jmvcore::OptionBool$new(
                "cosind",
                cosind,
                default=FALSE)
            private$..proba <- jmvcore::OptionNumber$new(
                "proba",
                proba,
                default=5)
            private$..nFactors <- jmvcore::OptionInteger$new(
                "nFactors",
                nFactors,
                default=2)
            private$..abs <- jmvcore::OptionInteger$new(
                "abs",
                abs,
                default=1)
            private$..ord <- jmvcore::OptionInteger$new(
                "ord",
                ord,
                default=2)
            private$..varact <- jmvcore::OptionBool$new(
                "varact",
                varact,
                default=TRUE)
            private$..varillus <- jmvcore::OptionBool$new(
                "varillus",
                varillus,
                default=TRUE)
            private$..indact <- jmvcore::OptionBool$new(
                "indact",
                indact,
                default=TRUE)
            private$..modillus <- jmvcore::OptionBool$new(
                "modillus",
                modillus,
                default=TRUE)
            private$..habillage <- jmvcore::OptionInteger$new(
                "habillage",
                habillage)
            private$..ncp <- jmvcore::OptionInteger$new(
                "ncp",
                ncp,
                default=5)
            private$..newvar <- jmvcore::OptionOutput$new(
                "newvar")
            private$..graphclassif <- jmvcore::OptionBool$new(
                "graphclassif",
                graphclassif,
                default=FALSE)
            private$..nbclust <- jmvcore::OptionInteger$new(
                "nbclust",
                nbclust,
                default=-1)
            private$..newvar2 <- jmvcore::OptionOutput$new(
                "newvar2")

            self$.addOption(private$..actvars)
            self$.addOption(private$..quantisup)
            self$.addOption(private$..qualisup)
            self$.addOption(private$..individus)
            self$.addOption(private$..tuto)
            self$.addOption(private$..norme)
            self$.addOption(private$..coordvar)
            self$.addOption(private$..contribvar)
            self$.addOption(private$..cosvar)
            self$.addOption(private$..coordind)
            self$.addOption(private$..contribind)
            self$.addOption(private$..cosind)
            self$.addOption(private$..proba)
            self$.addOption(private$..nFactors)
            self$.addOption(private$..abs)
            self$.addOption(private$..ord)
            self$.addOption(private$..varact)
            self$.addOption(private$..varillus)
            self$.addOption(private$..indact)
            self$.addOption(private$..modillus)
            self$.addOption(private$..habillage)
            self$.addOption(private$..ncp)
            self$.addOption(private$..newvar)
            self$.addOption(private$..graphclassif)
            self$.addOption(private$..nbclust)
            self$.addOption(private$..newvar2)
        }),
    active = list(
        actvars = function() private$..actvars$value,
        quantisup = function() private$..quantisup$value,
        qualisup = function() private$..qualisup$value,
        individus = function() private$..individus$value,
        tuto = function() private$..tuto$value,
        norme = function() private$..norme$value,
        coordvar = function() private$..coordvar$value,
        contribvar = function() private$..contribvar$value,
        cosvar = function() private$..cosvar$value,
        coordind = function() private$..coordind$value,
        contribind = function() private$..contribind$value,
        cosind = function() private$..cosind$value,
        proba = function() private$..proba$value,
        nFactors = function() private$..nFactors$value,
        abs = function() private$..abs$value,
        ord = function() private$..ord$value,
        varact = function() private$..varact$value,
        varillus = function() private$..varillus$value,
        indact = function() private$..indact$value,
        modillus = function() private$..modillus$value,
        habillage = function() private$..habillage$value,
        ncp = function() private$..ncp$value,
        newvar = function() private$..newvar$value,
        graphclassif = function() private$..graphclassif$value,
        nbclust = function() private$..nbclust$value,
        newvar2 = function() private$..newvar2$value),
    private = list(
        ..actvars = NA,
        ..quantisup = NA,
        ..qualisup = NA,
        ..individus = NA,
        ..tuto = NA,
        ..norme = NA,
        ..coordvar = NA,
        ..contribvar = NA,
        ..cosvar = NA,
        ..coordind = NA,
        ..contribind = NA,
        ..cosind = NA,
        ..proba = NA,
        ..nFactors = NA,
        ..abs = NA,
        ..ord = NA,
        ..varact = NA,
        ..varillus = NA,
        ..indact = NA,
        ..modillus = NA,
        ..habillage = NA,
        ..ncp = NA,
        ..newvar = NA,
        ..graphclassif = NA,
        ..nbclust = NA,
        ..newvar2 = NA)
)

PCAResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "PCAResults",
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        plotind = function() private$.items[["plotind"]],
        plotvar = function() private$.items[["plotvar"]],
        eigengroup = function() private$.items[["eigengroup"]],
        descdesdim = function() private$.items[["descdesdim"]],
        code = function() private$.items[["code"]],
        individus = function() private$.items[["individus"]],
        variables = function() private$.items[["variables"]],
        plotclassif = function() private$.items[["plotclassif"]],
        newvar = function() private$.items[["newvar"]],
        newvar2 = function() private$.items[["newvar2"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Results of the Principal Component Analysis",
                refs=list(
                    "factominer",
                    "explo"))
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                visible="(tuto)"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotind",
                title="Representation of the Individuals (and the Categories)",
                width=800,
                height=600,
                renderFun=".plotindividus"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotvar",
                title="Representation of the Variables",
                width=600,
                height=600,
                renderFun=".plotvariables"))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    eigen = function() private$.items[["eigen"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="eigengroup",
                            title="Eigenvalue Decomposition")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="eigen",
                            title="Eigenvalue and (Cumulative) Percentage of Variance",
                            columns=list(
                                list(
                                    `name`="component", 
                                    `title`="", 
                                    `type`="text"),
                                list(
                                    `name`="eigenvalue", 
                                    `title`="Eigenvalue", 
                                    `type`="number"),
                                list(
                                    `name`="purcent", 
                                    `title`="% of the variance", 
                                    `type`="number"),
                                list(
                                    `name`="purcentcum", 
                                    `title`="Cumulative %", 
                                    `type`="number"))))}))$new(options=options))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="descdesdim",
                title="Automatic Description of the Dimensions"))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="code",
                title="R code"))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    coordonnees = function() private$.items[["coordonnees"]],
                    contribution = function() private$.items[["contribution"]],
                    cosinus = function() private$.items[["cosinus"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="individus",
                            title="Individual Tables")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="coordonnees",
                            title="Coordinates Table",
                            visible="(coordind)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="contribution",
                            title="Contributions Table",
                            visible="(contribind)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="cosinus",
                            title="Cosine Table",
                            visible="(cosind)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    coordonnees = function() private$.items[["coordonnees"]],
                    contribution = function() private$.items[["contribution"]],
                    cosinus = function() private$.items[["cosinus"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="variables",
                            title="Variable Tables")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="coordonnees",
                            title="Coordinates Table",
                            visible="(coordvar)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="contribution",
                            title="Contributions Table",
                            visible="(contribvar)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="cosinus",
                            title="Cosine Table",
                            visible="(cosvar)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))}))$new(options=options))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotclassif",
                title="Representation of the Individuals According to Clusters",
                visible="(graphclassif)",
                width=800,
                height=600,
                renderFun=".plotclassif"))
            self$add(jmvcore::Output$new(
                options=options,
                name="newvar",
                title="Coordinates",
                measureType="continuous",
                initInRun=TRUE,
                clearWith=list(
                    "actvars",
                    "quantisup",
                    "qualisup",
                    "individus",
                    "nFactors",
                    "norme")))
            self$add(jmvcore::Output$new(
                options=options,
                name="newvar2",
                title="Coordinates",
                measureType="continuous",
                initInRun=TRUE,
                clearWith=list(
                    "actvars",
                    "quantisup",
                    "qualisup",
                    "individus",
                    "nFactors",
                    "norme")))}))

PCABase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "PCABase",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = "MEDA",
                name = "PCA",
                version = c(1,0,0),
                options = options,
                results = PCAResults$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE,
                requiresMissings = FALSE,
                weightsSupport = 'none')
        }))

#' Principal Component Analysis
#'
#' 
#' @param data .
#' @param actvars .
#' @param quantisup .
#' @param qualisup .
#' @param individus .
#' @param tuto .
#' @param norme .
#' @param coordvar .
#' @param contribvar .
#' @param cosvar .
#' @param coordind .
#' @param contribind .
#' @param cosind .
#' @param proba .
#' @param nFactors .
#' @param abs .
#' @param ord .
#' @param varact .
#' @param varillus .
#' @param indact .
#' @param modillus .
#' @param habillage .
#' @param ncp .
#' @param graphclassif .
#' @param nbclust .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$plotind} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotvar} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$eigengroup$eigen} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$descdesdim} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$code} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$individus$coordonnees} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$individus$contribution} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$individus$cosinus} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$variables$coordonnees} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$variables$contribution} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$variables$cosinus} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$plotclassif} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$newvar} \tab \tab \tab \tab \tab an output \cr
#'   \code{results$newvar2} \tab \tab \tab \tab \tab an output \cr
#' }
#'
#' @export
PCA <- function(
    data,
    actvars,
    quantisup,
    qualisup,
    individus,
    tuto = TRUE,
    norme = TRUE,
    coordvar = FALSE,
    contribvar = FALSE,
    cosvar = FALSE,
    coordind = FALSE,
    contribind = FALSE,
    cosind = FALSE,
    proba = 5,
    nFactors = 2,
    abs = 1,
    ord = 2,
    varact = TRUE,
    varillus = TRUE,
    indact = TRUE,
    modillus = TRUE,
    habillage,
    ncp = 5,
    graphclassif = FALSE,
    nbclust = -1) {

    if ( ! requireNamespace("jmvcore", quietly=TRUE))
        stop("PCA requires jmvcore to be installed (restart may be required)")

    if ( ! missing(actvars)) actvars <- jmvcore::resolveQuo(jmvcore::enquo(actvars))
    if ( ! missing(quantisup)) quantisup <- jmvcore::resolveQuo(jmvcore::enquo(quantisup))
    if ( ! missing(qualisup)) qualisup <- jmvcore::resolveQuo(jmvcore::enquo(qualisup))
    if ( ! missing(individus)) individus <- jmvcore::resolveQuo(jmvcore::enquo(individus))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(actvars), actvars, NULL),
            `if`( ! missing(quantisup), quantisup, NULL),
            `if`( ! missing(qualisup), qualisup, NULL),
            `if`( ! missing(individus), individus, NULL))

    for (v in qualisup) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in individus) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])

    options <- PCAOptions$new(
        actvars = actvars,
        quantisup = quantisup,
        qualisup = qualisup,
        individus = individus,
        tuto = tuto,
        norme = norme,
        coordvar = coordvar,
        contribvar = contribvar,
        cosvar = cosvar,
        coordind = coordind,
        contribind = contribind,
        cosind = cosind,
        proba = proba,
        nFactors = nFactors,
        abs = abs,
        ord = ord,
        varact = varact,
        varillus = varillus,
        indact = indact,
        modillus = modillus,
        habillage = habillage,
        ncp = ncp,
        graphclassif = graphclassif,
        nbclust = nbclust)

    analysis <- PCAClass$new(
        options = options,
        data = data)

    analysis$run()

    analysis$results
}