R/mca.h.R

Defines functions MCA

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

MCAOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "MCAOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            actvars = NULL,
            quantisup = NULL,
            qualisup = NULL,
            individus = NULL,
            tuto = TRUE,
            nFactors = 2,
            abs = 1,
            ord = 2,
            varmodqualisup = TRUE,
            varmodvar = TRUE,
            proba = 5,
            indcoord = FALSE,
            indcontrib = FALSE,
            indcos = FALSE,
            varcoord = FALSE,
            varcontrib = FALSE,
            varcos = FALSE,
            quantimod = FALSE,
            ventil = 5,
            modality = "cos2 10",
            ncp = 5,
            graphclassif = FALSE,
            nbclust = -1, ...) {

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

            private$..actvars <- jmvcore::OptionVariables$new(
                "actvars",
                actvars,
                suggested=list(
                    "nominal",
                    "ordinal"),
                permitted=list(
                    "factor"))
            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$..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$..varmodqualisup <- jmvcore::OptionBool$new(
                "varmodqualisup",
                varmodqualisup,
                default=TRUE)
            private$..varmodvar <- jmvcore::OptionBool$new(
                "varmodvar",
                varmodvar,
                default=TRUE)
            private$..proba <- jmvcore::OptionNumber$new(
                "proba",
                proba,
                default=5)
            private$..indcoord <- jmvcore::OptionBool$new(
                "indcoord",
                indcoord,
                default=FALSE)
            private$..indcontrib <- jmvcore::OptionBool$new(
                "indcontrib",
                indcontrib,
                default=FALSE)
            private$..indcos <- jmvcore::OptionBool$new(
                "indcos",
                indcos,
                default=FALSE)
            private$..varcoord <- jmvcore::OptionBool$new(
                "varcoord",
                varcoord,
                default=FALSE)
            private$..varcontrib <- jmvcore::OptionBool$new(
                "varcontrib",
                varcontrib,
                default=FALSE)
            private$..varcos <- jmvcore::OptionBool$new(
                "varcos",
                varcos,
                default=FALSE)
            private$..quantimod <- jmvcore::OptionBool$new(
                "quantimod",
                quantimod,
                default=FALSE)
            private$..ventil <- jmvcore::OptionNumber$new(
                "ventil",
                ventil,
                default=5)
            private$..modality <- jmvcore::OptionString$new(
                "modality",
                modality,
                default="cos2 10")
            private$..ncp <- jmvcore::OptionInteger$new(
                "ncp",
                ncp,
                default=5)
            private$..graphclassif <- jmvcore::OptionBool$new(
                "graphclassif",
                graphclassif,
                default=FALSE)
            private$..newvar <- jmvcore::OptionOutput$new(
                "newvar")
            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$..nFactors)
            self$.addOption(private$..abs)
            self$.addOption(private$..ord)
            self$.addOption(private$..varmodqualisup)
            self$.addOption(private$..varmodvar)
            self$.addOption(private$..proba)
            self$.addOption(private$..indcoord)
            self$.addOption(private$..indcontrib)
            self$.addOption(private$..indcos)
            self$.addOption(private$..varcoord)
            self$.addOption(private$..varcontrib)
            self$.addOption(private$..varcos)
            self$.addOption(private$..quantimod)
            self$.addOption(private$..ventil)
            self$.addOption(private$..modality)
            self$.addOption(private$..ncp)
            self$.addOption(private$..graphclassif)
            self$.addOption(private$..newvar)
            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,
        nFactors = function() private$..nFactors$value,
        abs = function() private$..abs$value,
        ord = function() private$..ord$value,
        varmodqualisup = function() private$..varmodqualisup$value,
        varmodvar = function() private$..varmodvar$value,
        proba = function() private$..proba$value,
        indcoord = function() private$..indcoord$value,
        indcontrib = function() private$..indcontrib$value,
        indcos = function() private$..indcos$value,
        varcoord = function() private$..varcoord$value,
        varcontrib = function() private$..varcontrib$value,
        varcos = function() private$..varcos$value,
        quantimod = function() private$..quantimod$value,
        ventil = function() private$..ventil$value,
        modality = function() private$..modality$value,
        ncp = function() private$..ncp$value,
        graphclassif = function() private$..graphclassif$value,
        newvar = function() private$..newvar$value,
        nbclust = function() private$..nbclust$value,
        newvar2 = function() private$..newvar2$value),
    private = list(
        ..actvars = NA,
        ..quantisup = NA,
        ..qualisup = NA,
        ..individus = NA,
        ..tuto = NA,
        ..nFactors = NA,
        ..abs = NA,
        ..ord = NA,
        ..varmodqualisup = NA,
        ..varmodvar = NA,
        ..proba = NA,
        ..indcoord = NA,
        ..indcontrib = NA,
        ..indcos = NA,
        ..varcoord = NA,
        ..varcontrib = NA,
        ..varcos = NA,
        ..quantimod = NA,
        ..ventil = NA,
        ..modality = NA,
        ..ncp = NA,
        ..graphclassif = NA,
        ..newvar = NA,
        ..nbclust = NA,
        ..newvar2 = NA)
)

MCAResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "MCAResults",
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        plotindiv = function() private$.items[["plotindiv"]],
        plotvar = function() private$.items[["plotvar"]],
        plotitemvar = function() private$.items[["plotitemvar"]],
        plotquantisup = function() private$.items[["plotquantisup"]],
        eigengroup = function() private$.items[["eigengroup"]],
        dimdesc = function() private$.items[["dimdesc"]],
        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 Multiple Correspondence 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="plotindiv",
                title="Representation of the Individuals",
                width=700,
                height=500,
                renderFun=".plotindiv"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotvar",
                title="Representation of the Variables",
                width=700,
                height=500,
                renderFun=".plotvar"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotitemvar",
                title="Representation of the Categories",
                width=700,
                height=500,
                renderFun=".plotitemvar"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotquantisup",
                title="Representation of the Supplementary Variables",
                visible="(quantimod)",
                width=700,
                height=500,
                renderFun=".plotquantisup"))
            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="dimdesc",
                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="(indcoord)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="contribution",
                            title="Contributions Table",
                            visible="(indcontrib)",
                            clearWith=list(
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="cosinus",
                            title="Cosine Table",
                            visible="(indcos)",
                            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="(varcoord)",
                            clearWith=list(
                                "actvars",
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="contribution",
                            title="Contributions Table",
                            visible="(varcontrib)",
                            clearWith=list(
                                "actvars",
                                "nFactors"),
                            columns=list()))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="cosinus",
                            title="Cosine Table",
                            visible="(varcos)",
                            clearWith=list(
                                "actvars",
                                "nFactors"),
                            columns=list()))}))$new(options=options))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotclassif",
                title="Representation of the Rows According to Clusters",
                visible="(graphclassif)",
                width=700,
                height=500,
                renderFun=".plotclassif"))
            self$add(jmvcore::Output$new(
                options=options,
                name="newvar",
                title="Coordinates",
                measureType="continuous",
                initInRun=TRUE,
                clearWith=list(
                    "actvars",
                    "quantisup",
                    "qualisup",
                    "individus",
                    "nFactors",
                    "ventil")))
            self$add(jmvcore::Output$new(
                options=options,
                name="newvar2",
                title="Coordinates",
                measureType="continuous",
                initInRun=TRUE,
                clearWith=list(
                    "actvars",
                    "quantisup",
                    "qualisup",
                    "individus",
                    "nFactors",
                    "norme")))}))

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

#' Multiple Correspondence Analysis
#'
#' 
#' @param data .
#' @param actvars .
#' @param quantisup .
#' @param qualisup .
#' @param individus .
#' @param tuto .
#' @param nFactors .
#' @param abs .
#' @param ord .
#' @param varmodqualisup .
#' @param varmodvar .
#' @param proba .
#' @param indcoord .
#' @param indcontrib .
#' @param indcos .
#' @param varcoord .
#' @param varcontrib .
#' @param varcos .
#' @param quantimod .
#' @param ventil .
#' @param modality .
#' @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$plotindiv} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotvar} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotitemvar} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotquantisup} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$eigengroup$eigen} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$dimdesc} \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
MCA <- function(
    data,
    actvars,
    quantisup,
    qualisup,
    individus,
    tuto = TRUE,
    nFactors = 2,
    abs = 1,
    ord = 2,
    varmodqualisup = TRUE,
    varmodvar = TRUE,
    proba = 5,
    indcoord = FALSE,
    indcontrib = FALSE,
    indcos = FALSE,
    varcoord = FALSE,
    varcontrib = FALSE,
    varcos = FALSE,
    quantimod = FALSE,
    ventil = 5,
    modality = "cos2 10",
    ncp = 5,
    graphclassif = FALSE,
    nbclust = -1) {

    if ( ! requireNamespace("jmvcore", quietly=TRUE))
        stop("MCA 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 actvars) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    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 <- MCAOptions$new(
        actvars = actvars,
        quantisup = quantisup,
        qualisup = qualisup,
        individus = individus,
        tuto = tuto,
        nFactors = nFactors,
        abs = abs,
        ord = ord,
        varmodqualisup = varmodqualisup,
        varmodvar = varmodvar,
        proba = proba,
        indcoord = indcoord,
        indcontrib = indcontrib,
        indcos = indcos,
        varcoord = varcoord,
        varcontrib = varcontrib,
        varcos = varcos,
        quantimod = quantimod,
        ventil = ventil,
        modality = modality,
        ncp = ncp,
        graphclassif = graphclassif,
        nbclust = nbclust)

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

    analysis$run()

    analysis$results
}
Sebastien-Le/MEDA documentation built on Dec. 15, 2024, 12:58 a.m.