R/mixture.h.R

Defines functions mixture

Documented in mixture

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

mixtureOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
    "mixtureOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            nc = 1,
            step = 1,
            type = "rating",
            aic = TRUE,
            bic = TRUE,
            caic = FALSE,
            imean = TRUE,
            imeasure = FALSE,
            ise = FALSE,
            infit = FALSE,
            outfit = FALSE,
            pbis = FALSE,
            bfit = FALSE,
            average = FALSE,
            pclass = FALSE,
            iplot = FALSE, ...) {

            super$initialize(
                package='RMM',
                name='mixture',
                requiresData=TRUE,
                ...)

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..nc <- jmvcore::OptionInteger$new(
                "nc",
                nc,
                min=1,
                default=1)
            private$..step <- jmvcore::OptionInteger$new(
                "step",
                step,
                min=1,
                default=1)
            private$..type <- jmvcore::OptionList$new(
                "type",
                type,
                options=list(
                    "rating",
                    "partial"),
                default="rating")
            private$..aic <- jmvcore::OptionBool$new(
                "aic",
                aic,
                default=TRUE)
            private$..bic <- jmvcore::OptionBool$new(
                "bic",
                bic,
                default=TRUE)
            private$..caic <- jmvcore::OptionBool$new(
                "caic",
                caic,
                default=FALSE)
            private$..imean <- jmvcore::OptionBool$new(
                "imean",
                imean,
                default=TRUE)
            private$..imeasure <- jmvcore::OptionBool$new(
                "imeasure",
                imeasure,
                default=FALSE)
            private$..ise <- jmvcore::OptionBool$new(
                "ise",
                ise,
                default=FALSE)
            private$..infit <- jmvcore::OptionBool$new(
                "infit",
                infit,
                default=FALSE)
            private$..outfit <- jmvcore::OptionBool$new(
                "outfit",
                outfit,
                default=FALSE)
            private$..pbis <- jmvcore::OptionBool$new(
                "pbis",
                pbis,
                default=FALSE)
            private$..bfit <- jmvcore::OptionBool$new(
                "bfit",
                bfit,
                default=FALSE)
            private$..average <- jmvcore::OptionBool$new(
                "average",
                average,
                default=FALSE)
            private$..pclass <- jmvcore::OptionBool$new(
                "pclass",
                pclass,
                default=FALSE)
            private$..iplot <- jmvcore::OptionBool$new(
                "iplot",
                iplot,
                default=FALSE)

            self$.addOption(private$..vars)
            self$.addOption(private$..nc)
            self$.addOption(private$..step)
            self$.addOption(private$..type)
            self$.addOption(private$..aic)
            self$.addOption(private$..bic)
            self$.addOption(private$..caic)
            self$.addOption(private$..imean)
            self$.addOption(private$..imeasure)
            self$.addOption(private$..ise)
            self$.addOption(private$..infit)
            self$.addOption(private$..outfit)
            self$.addOption(private$..pbis)
            self$.addOption(private$..bfit)
            self$.addOption(private$..average)
            self$.addOption(private$..pclass)
            self$.addOption(private$..iplot)
        }),
    active = list(
        vars = function() private$..vars$value,
        nc = function() private$..nc$value,
        step = function() private$..step$value,
        type = function() private$..type$value,
        aic = function() private$..aic$value,
        bic = function() private$..bic$value,
        caic = function() private$..caic$value,
        imean = function() private$..imean$value,
        imeasure = function() private$..imeasure$value,
        ise = function() private$..ise$value,
        infit = function() private$..infit$value,
        outfit = function() private$..outfit$value,
        pbis = function() private$..pbis$value,
        bfit = function() private$..bfit$value,
        average = function() private$..average$value,
        pclass = function() private$..pclass$value,
        iplot = function() private$..iplot$value),
    private = list(
        ..vars = NA,
        ..nc = NA,
        ..step = NA,
        ..type = NA,
        ..aic = NA,
        ..bic = NA,
        ..caic = NA,
        ..imean = NA,
        ..imeasure = NA,
        ..ise = NA,
        ..infit = NA,
        ..outfit = NA,
        ..pbis = NA,
        ..bfit = NA,
        ..average = NA,
        ..pclass = NA,
        ..iplot = NA)
)

mixtureResults <- if (requireNamespace('jmvcore')) R6::R6Class(
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        item = function() private$.items[["item"]],
        person = function() private$.items[["person"]],
        iplot = function() private$.items[["iplot"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Rasch Mixture Model")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                visible=TRUE,
                refs="RMM"))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    model = function() private$.items[["model"]],
                    items = function() private$.items[["items"]],
                    bfit = function() private$.items[["bfit"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="item",
                            title="Item Analysis")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="model",
                            title="Model Information",
                            rows=1,
                            clearWith=list(
                                "vars"),
                            refs="mixRasch",
                            columns=list(
                                list(
                                    `name`="class", 
                                    `title`="Class", 
                                    `visible`="(class)"),
                                list(
                                    `name`="aic", 
                                    `title`="AIC", 
                                    `visible`="(aic)"),
                                list(
                                    `name`="bic", 
                                    `title`="BIC", 
                                    `visible`="(bic)"),
                                list(
                                    `name`="caic", 
                                    `title`="CAIC", 
                                    `visible`="(caic)"))))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="items",
                            title="Item Statistics",
                            visible="(imean || imeasure || ise || infit || outfit || pbis)",
                            rows="(vars)",
                            clearWith=list(
                                "vars"),
                            refs="mixRasch",
                            columns=list(
                                list(
                                    `name`="name", 
                                    `title`="", 
                                    `type`="text", 
                                    `content`="($key)"),
                                list(
                                    `name`="imean", 
                                    `title`="Item mean", 
                                    `visible`="(imean)"),
                                list(
                                    `name`="imeasure", 
                                    `title`="Measure", 
                                    `visible`="(imeasure)"),
                                list(
                                    `name`="ise", 
                                    `title`="S.E.Measure", 
                                    `visible`="(ise)"),
                                list(
                                    `name`="infit", 
                                    `title`="Infit", 
                                    `visible`="(infit)"),
                                list(
                                    `name`="outfit", 
                                    `title`="Outfit", 
                                    `visible`="(outfit)"),
                                list(
                                    `name`="pbis", 
                                    `title`="Point biserial", 
                                    `visible`="(pbis)"))))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="bfit",
                            title="Bootstrap item fit",
                            visible="(bfit)",
                            rows=1,
                            clearWith=list(
                                "vars"),
                            columns=list(
                                list(
                                    `name`="binfit[in]", 
                                    `title`="", 
                                    `type`="text", 
                                    `content`="Infit"),
                                list(
                                    `name`="binfit[out]", 
                                    `title`="", 
                                    `type`="text", 
                                    `content`="Outfit"),
                                list(
                                    `name`="l[infit]", 
                                    `title`="Lower", 
                                    `type`="number", 
                                    `superTitle`="95% CI"),
                                list(
                                    `name`="u[infit]", 
                                    `title`="Upper", 
                                    `type`="number", 
                                    `superTitle`="95% CI"),
                                list(
                                    `name`="l[outfit]", 
                                    `title`="Lower", 
                                    `type`="number", 
                                    `superTitle`="95% CI"),
                                list(
                                    `name`="u[outfit]", 
                                    `title`="Upper", 
                                    `type`="number", 
                                    `superTitle`="95% CI"))))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    average = function() private$.items[["average"]],
                    pclass = function() private$.items[["pclass"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="person",
                            title="Person Analysis")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="average",
                            title="Mean ability level for each class",
                            visible="(average)",
                            rows="(nc)",
                            clearWith=list(
                                "vars"),
                            columns=list(
                                list(
                                    `name`="class", 
                                    `title`="Class", 
                                    `content`="($key)"),
                                list(
                                    `name`="value", 
                                    `title`="Theta", 
                                    `type`="number"))))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="pclass",
                            title="Person membership",
                            visible="(pclass)",
                            clearWith=list(
                                "vars"),
                            refs="mixRasch",
                            columns=list(
                                list(
                                    `name`="name", 
                                    `title`="Person number", 
                                    `type`="text", 
                                    `content`="($key)"),
                                list(
                                    `name`="pc1", 
                                    `title`="1", 
                                    `type`="number", 
                                    `superTitle`="Class"))))}))$new(options=options))
            self$add(jmvcore::Image$new(
                options=options,
                name="iplot",
                title="Item Plot",
                visible="(iplot)",
                width=700,
                height=500,
                renderFun=".itemPlot",
                refs="mixRaschTools"))}))

mixtureBase <- if (requireNamespace('jmvcore')) R6::R6Class(
    "mixtureBase",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = 'RMM',
                name = 'mixture',
                version = c(1,0,0),
                options = options,
                results = mixtureResults$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE,
                requiresMissings = FALSE)
        }))

#' Rasch Mixture Model
#'
#' 
#' @param data The data as a data frame.
#' @param vars .
#' @param nc .
#' @param step .
#' @param type .
#' @param aic .
#' @param bic .
#' @param caic .
#' @param imean .
#' @param imeasure .
#' @param ise .
#' @param infit .
#' @param outfit .
#' @param pbis .
#' @param bfit .
#' @param average .
#' @param pclass .
#' @param iplot .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$item$model} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$item$items} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$item$bfit} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$person$average} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$person$pclass} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$iplot} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' @export
mixture <- function(
    data,
    vars,
    nc = 1,
    step = 1,
    type = "rating",
    aic = TRUE,
    bic = TRUE,
    caic = FALSE,
    imean = TRUE,
    imeasure = FALSE,
    ise = FALSE,
    infit = FALSE,
    outfit = FALSE,
    pbis = FALSE,
    bfit = FALSE,
    average = FALSE,
    pclass = FALSE,
    iplot = FALSE) {

    if ( ! requireNamespace('jmvcore'))
        stop('mixture requires jmvcore to be installed (restart may be required)')

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


    options <- mixtureOptions$new(
        vars = vars,
        nc = nc,
        step = step,
        type = type,
        aic = aic,
        bic = bic,
        caic = caic,
        imean = imean,
        imeasure = imeasure,
        ise = ise,
        infit = infit,
        outfit = outfit,
        pbis = pbis,
        bfit = bfit,
        average = average,
        pclass = pclass,
        iplot = iplot)

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

    analysis$run()

    analysis$results
}
hyunsooseol/RMM documentation built on Aug. 8, 2020, 12:36 p.m.