R/betabinomial.h.R

In WLenhard/cNORM_JAMOVI: Continuous Norming with cNORM for JAMOVI

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

betabinomialOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "betabinomialOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            raw = NULL,
            explanatory = NULL,
            weights = NULL,
            scale = "T",
            alpha = "3",
            beta = "3",
            itemnumber = NULL,
            model = TRUE,
            normAge = NULL, ...) {

            super$initialize(
                package="cNORMj",
                name="betabinomial",
                requiresData=TRUE,
                ...)

            private$..raw <- jmvcore::OptionVariable$new(
                "raw",
                raw,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..explanatory <- jmvcore::OptionVariable$new(
                "explanatory",
                explanatory,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..weights <- jmvcore::OptionVariable$new(
                "weights",
                weights,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..scale <- jmvcore::OptionList$new(
                "scale",
                scale,
                options=list(
                    "T",
                    "IQ",
                    "z"),
                default="T")
            private$..alpha <- jmvcore::OptionList$new(
                "alpha",
                alpha,
                options=list(
                    "1",
                    "2",
                    "3",
                    "4",
                    "5",
                    "6"),
                default="3")
            private$..beta <- jmvcore::OptionList$new(
                "beta",
                beta,
                options=list(
                    "1",
                    "2",
                    "3",
                    "4",
                    "5",
                    "6"),
                default="3")
            private$..itemnumber <- jmvcore::OptionString$new(
                "itemnumber",
                itemnumber)
            private$..model <- jmvcore::OptionBool$new(
                "model",
                model,
                default=TRUE)
            private$..normAge <- jmvcore::OptionString$new(
                "normAge",
                normAge)
            private$..savePredicted <- jmvcore::OptionOutput$new(
                "savePredicted")
            private$..savePredictedPerc <- jmvcore::OptionOutput$new(
                "savePredictedPerc")

            self$.addOption(private$..raw)
            self$.addOption(private$..explanatory)
            self$.addOption(private$..weights)
            self$.addOption(private$..scale)
            self$.addOption(private$..alpha)
            self$.addOption(private$..beta)
            self$.addOption(private$..itemnumber)
            self$.addOption(private$..model)
            self$.addOption(private$..normAge)
            self$.addOption(private$..savePredicted)
            self$.addOption(private$..savePredictedPerc)
        }),
    active = list(
        raw = function() private$..raw$value,
        explanatory = function() private$..explanatory$value,
        weights = function() private$..weights$value,
        scale = function() private$..scale$value,
        alpha = function() private$..alpha$value,
        beta = function() private$..beta$value,
        itemnumber = function() private$..itemnumber$value,
        model = function() private$..model$value,
        normAge = function() private$..normAge$value,
        savePredicted = function() private$..savePredicted$value,
        savePredictedPerc = function() private$..savePredictedPerc$value),
    private = list(
        ..raw = NA,
        ..explanatory = NA,
        ..weights = NA,
        ..scale = NA,
        ..alpha = NA,
        ..beta = NA,
        ..itemnumber = NA,
        ..model = NA,
        ..normAge = NA,
        ..savePredicted = NA,
        ..savePredictedPerc = NA)
)

betabinomialResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "betabinomialResults",
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        plot = function() private$.items[["plot"]],
        norms = function() private$.items[["norms"]],
        modelTab = function() private$.items[["modelTab"]],
        savePredicted = function() private$.items[["savePredicted"]],
        savePredictedPerc = function() private$.items[["savePredictedPerc"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Continuous Norming (Beta Binomial)")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                visible=TRUE))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot",
                width=600,
                height=400,
                visible=TRUE,
                renderFun=".plot"))
            self$add(jmvcore::Table$new(
                options=options,
                name="norms",
                title="Norm Score Table",
                rows=1,
                visible=TRUE,
                columns=list(
                    list(
                        `name`="Raw", 
                        `type`="number"),
                    list(
                        `name`="Norm", 
                        `type`="number"),
                    list(
                        `name`="Percentile", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="modelTab",
                title="Model Summary",
                visible=TRUE))
            self$add(jmvcore::Output$new(
                options=options,
                name="savePredicted",
                title="Fitted Norm Scores",
                varTitle="BetaBinFittedNorm",
                varDescription="Beta-binomial fitted norm score",
                measureType="continuous",
                clearWith=list(
                    "raw",
                    "explanatory",
                    "weights",
                    "alpha",
                    "beta",
                    "itemnumber")))
            self$add(jmvcore::Output$new(
                options=options,
                name="savePredictedPerc",
                title="Fitted Percentile Scores",
                varTitle="BetaBinFittedPercentile",
                varDescription="Beta-binomial fitted percentile score",
                measureType="continuous",
                clearWith=list(
                    "raw",
                    "explanatory",
                    "weights",
                    "alpha",
                    "beta",
                    "itemnumber")))}))

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

#' Continuous Norming (Beta Binomial)
#'
#' 
#' @param data the data as a data frame
#' @param raw the raw score variable in the data
#' @param explanatory the explanatory variable in the data, e. g. age
#' @param weights an optional weighting variable, specifying the weights of
#'   the single cases
#' @param scale \code{'T'}, \code{'IQ'}, 'z'
#' @param alpha .
#' @param beta .
#' @param itemnumber the total number of items in the test
#' @param model .
#' @param normAge a number specifying the explanatory variable value for the
#'   norm score table
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$norms} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$modelTab} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$savePredicted} \tab \tab \tab \tab \tab an output \cr
#'   \code{results$savePredictedPerc} \tab \tab \tab \tab \tab an output \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$norms$asDF}
#'
#' \code{as.data.frame(results$norms)}
#'
#' @export
betabinomial <- function(
    data,
    raw,
    explanatory,
    weights,
    scale = "T",
    alpha = "3",
    beta = "3",
    itemnumber,
    model = TRUE,
    normAge) {

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

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


    options <- betabinomialOptions$new(
        raw = raw,
        explanatory = explanatory,
        weights = weights,
        scale = scale,
        alpha = alpha,
        beta = beta,
        itemnumber = itemnumber,
        model = model,
        normAge = normAge)

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

    analysis$run()

    analysis$results
}