R/textual.h.R

In Sebastien-Le/MEDA: Multivariate Exploratory Data Analysis

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

textualOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "textualOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            individuals = NULL,
            words = NULL,
            tuto = TRUE,
            thres = 5,
            lowfreq = 0,
            highfreq = 0, ...) {

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

            private$..individuals <- jmvcore::OptionVariable$new(
                "individuals",
                individuals,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..words <- jmvcore::OptionVariable$new(
                "words",
                words)
            private$..tuto <- jmvcore::OptionBool$new(
                "tuto",
                tuto,
                default=TRUE)
            private$..thres <- jmvcore::OptionNumber$new(
                "thres",
                thres,
                default=5)
            private$..lowfreq <- jmvcore::OptionNumber$new(
                "lowfreq",
                lowfreq,
                default=0)
            private$..highfreq <- jmvcore::OptionNumber$new(
                "highfreq",
                highfreq,
                default=0)

            self$.addOption(private$..individuals)
            self$.addOption(private$..words)
            self$.addOption(private$..tuto)
            self$.addOption(private$..thres)
            self$.addOption(private$..lowfreq)
            self$.addOption(private$..highfreq)
        }),
    active = list(
        individuals = function() private$..individuals$value,
        words = function() private$..words$value,
        tuto = function() private$..tuto$value,
        thres = function() private$..thres$value,
        lowfreq = function() private$..lowfreq$value,
        highfreq = function() private$..highfreq$value),
    private = list(
        ..individuals = NA,
        ..words = NA,
        ..tuto = NA,
        ..thres = NA,
        ..lowfreq = NA,
        ..highfreq = NA)
)

textualResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "textualResults",
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        tc = function() private$.items[["tc"]],
        textualgroup = function() private$.items[["textualgroup"]],
        chideuxgroup = function() private$.items[["chideuxgroup"]],
        dfresgroup = function() private$.items[["dfresgroup"]],
        plottext = function() private$.items[["plottext"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Results of the Categorical Variable Description",
                refs=list(
                    "factominer",
                    "explo"))
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                visible="(tuto)"))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="tc",
                title="Words and their Occurrences"))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    textual = function() private$.items[["textual"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="textualgroup",
                            title="Categories by Words Data Table")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="textual",
                            title="Contingency Table",
                            visible="(individuals)",
                            clearWith=list(
                                "individuals",
                                "words"),
                            columns=list()))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    chideux = function() private$.items[["chideux"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="chideuxgroup",
                            title="Chi-Squared Test")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="chideux",
                            title="Pearson's Chi-Squared Test",
                            visible="(individuals)",
                            clearWith=list(
                                "individuals",
                                "words"),
                            rows=1,
                            columns=list(
                                list(
                                    `name`="value", 
                                    `title`="X-squared", 
                                    `type`="Integer"),
                                list(
                                    `name`="df", 
                                    `title`="df", 
                                    `type`="Integer"),
                                list(
                                    `name`="pvalue", 
                                    `title`="p", 
                                    `format`="zto,pvalue"))))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    dfres = function() private$.items[["dfres"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="dfresgroup",
                            title="Description of the Categories")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="dfres",
                            title="Description of the Rows of the Contingency Table",
                            visible="(individuals)",
                            columns=list(
                                list(
                                    `name`="component", 
                                    `title`="", 
                                    `type`="text", 
                                    `combineBelow`=TRUE),
                                list(
                                    `name`="word", 
                                    `title`="Word", 
                                    `type`="text"),
                                list(
                                    `name`="internper", 
                                    `title`="Intern %", 
                                    `type`="Number"),
                                list(
                                    `name`="globper", 
                                    `title`="Global %", 
                                    `type`="Number"),
                                list(
                                    `name`="internfreq", 
                                    `title`="Intern frequency", 
                                    `type`="Number"),
                                list(
                                    `name`="globfreq", 
                                    `title`="Global frequency", 
                                    `type`="Number"),
                                list(
                                    `name`="pvaluedfres", 
                                    `title`="p", 
                                    `format`="zto,pvalue"),
                                list(
                                    `name`="vtest", 
                                    `title`="Vtest", 
                                    `type`="Number"))))}))$new(options=options))
            self$add(jmvcore::Image$new(
                options=options,
                name="plottext",
                title="Representation of the Words and the Categories",
                width=600,
                height=500,
                renderFun=".plottextual"))}))

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

#' Categorical Variable Described by Textual Data
#'
#' 
#' @param data .
#' @param individuals .
#' @param words .
#' @param tuto .
#' @param thres .
#' @param lowfreq .
#' @param highfreq .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$tc} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$textualgroup$textual} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$chideuxgroup$chideux} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$dfresgroup$dfres} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$plottext} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' @export
textual <- function(
    data,
    individuals,
    words,
    tuto = TRUE,
    thres = 5,
    lowfreq = 0,
    highfreq = 0) {

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

    if ( ! missing(individuals)) individuals <- jmvcore::resolveQuo(jmvcore::enquo(individuals))
    if ( ! missing(words)) words <- jmvcore::resolveQuo(jmvcore::enquo(words))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(individuals), individuals, NULL),
            `if`( ! missing(words), words, NULL))

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

    options <- textualOptions$new(
        individuals = individuals,
        words = words,
        tuto = tuto,
        thres = thres,
        lowfreq = lowfreq,
        highfreq = highfreq)

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

    analysis$run()

    analysis$results
}