R/continuous.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

continuousOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "continuousOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            raw = NULL,
            group = NULL,
            weights = NULL,
            scale = "T",
            k = "5",
            t = "3",
            selectionType = NULL,
            terms = 4,
            descend = FALSE,
            model = TRUE,
            normAge = NULL,
            range = 3,
            minRaw = 0,
            maxRaw = 0,
            stepping = 1, ...) {

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

            private$..raw <- jmvcore::OptionVariable$new(
                "raw",
                raw,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..group <- jmvcore::OptionVariable$new(
                "group",
                group,
                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",
                    "Wechsler",
                    "PISA"),
                default="T")
            private$..k <- jmvcore::OptionList$new(
                "k",
                k,
                options=list(
                    "1",
                    "2",
                    "3",
                    "4",
                    "5",
                    "6"),
                default="5")
            private$..t <- jmvcore::OptionList$new(
                "t",
                t,
                options=list(
                    "1",
                    "2",
                    "3",
                    "4",
                    "5",
                    "6"),
                default="3")
            private$..selectionType <- jmvcore::OptionList$new(
                "selectionType",
                selectionType,
                options=list(
                    "automaticSelection",
                    "manualSelection"))
            private$..terms <- jmvcore::OptionNumber$new(
                "terms",
                terms,
                default=4)
            private$..descend <- jmvcore::OptionBool$new(
                "descend",
                descend,
                default=FALSE)
            private$..model <- jmvcore::OptionBool$new(
                "model",
                model,
                default=TRUE)
            private$..normAge <- jmvcore::OptionString$new(
                "normAge",
                normAge)
            private$..range <- jmvcore::OptionNumber$new(
                "range",
                range,
                default=3)
            private$..minRaw <- jmvcore::OptionNumber$new(
                "minRaw",
                minRaw,
                default=0)
            private$..maxRaw <- jmvcore::OptionNumber$new(
                "maxRaw",
                maxRaw,
                default=0)
            private$..stepping <- jmvcore::OptionNumber$new(
                "stepping",
                stepping,
                default=1)
            private$..saveManifest <- jmvcore::OptionOutput$new(
                "saveManifest")
            private$..saveManifestPerc <- jmvcore::OptionOutput$new(
                "saveManifestPerc")
            private$..savePredicted <- jmvcore::OptionOutput$new(
                "savePredicted")
            private$..savePredictedPerc <- jmvcore::OptionOutput$new(
                "savePredictedPerc")

            self$.addOption(private$..raw)
            self$.addOption(private$..group)
            self$.addOption(private$..weights)
            self$.addOption(private$..scale)
            self$.addOption(private$..k)
            self$.addOption(private$..t)
            self$.addOption(private$..selectionType)
            self$.addOption(private$..terms)
            self$.addOption(private$..descend)
            self$.addOption(private$..model)
            self$.addOption(private$..normAge)
            self$.addOption(private$..range)
            self$.addOption(private$..minRaw)
            self$.addOption(private$..maxRaw)
            self$.addOption(private$..stepping)
            self$.addOption(private$..saveManifest)
            self$.addOption(private$..saveManifestPerc)
            self$.addOption(private$..savePredicted)
            self$.addOption(private$..savePredictedPerc)
        }),
    active = list(
        raw = function() private$..raw$value,
        group = function() private$..group$value,
        weights = function() private$..weights$value,
        scale = function() private$..scale$value,
        k = function() private$..k$value,
        t = function() private$..t$value,
        selectionType = function() private$..selectionType$value,
        terms = function() private$..terms$value,
        descend = function() private$..descend$value,
        model = function() private$..model$value,
        normAge = function() private$..normAge$value,
        range = function() private$..range$value,
        minRaw = function() private$..minRaw$value,
        maxRaw = function() private$..maxRaw$value,
        stepping = function() private$..stepping$value,
        saveManifest = function() private$..saveManifest$value,
        saveManifestPerc = function() private$..saveManifestPerc$value,
        savePredicted = function() private$..savePredicted$value,
        savePredictedPerc = function() private$..savePredictedPerc$value),
    private = list(
        ..raw = NA,
        ..group = NA,
        ..weights = NA,
        ..scale = NA,
        ..k = NA,
        ..t = NA,
        ..selectionType = NA,
        ..terms = NA,
        ..descend = NA,
        ..model = NA,
        ..normAge = NA,
        ..range = NA,
        ..minRaw = NA,
        ..maxRaw = NA,
        ..stepping = NA,
        ..saveManifest = NA,
        ..saveManifestPerc = NA,
        ..savePredicted = NA,
        ..savePredictedPerc = NA)
)

continuousResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "continuousResults",
    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"]],
        saveManifest = function() private$.items[["saveManifest"]],
        saveManifestPerc = function() private$.items[["saveManifestPerc"]],
        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 (Distribution Free)")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                refs="assessment",
                visible=TRUE))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot",
                refs="cNORM",
                width=600,
                height=400,
                visible=TRUE,
                renderFun=".plot"))
            self$add(jmvcore::Table$new(
                options=options,
                name="norms",
                refs="epm",
                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::Table$new(
                options=options,
                name="modelTab",
                title="Model Summary",
                visible=TRUE,
                rows=1,
                refs="plos",
                columns=list(
                    list(
                        `name`="Variable", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="Weight", 
                        `type`="number"),
                    list(
                        `name`="Terms", 
                        `type`="integer"),
                    list(
                        `name`="RMSE", 
                        `type`="number"),
                    list(
                        `name`="R2adj", 
                        `type`="number"),
                    list(
                        `name`="BIC", 
                        `type`="number"))))
            self$add(jmvcore::Output$new(
                options=options,
                name="saveManifest",
                title="Manifest Norm Scores",
                varTitle="ManifestNorm",
                varDescription="Manifest norm score",
                measureType="continuous",
                clearWith=list(
                    "raw",
                    "weights",
                    "scale",
                    "descend",
                    "group",
                    "t")))
            self$add(jmvcore::Output$new(
                options=options,
                name="saveManifestPerc",
                title="Manifest Percentile Scores",
                varTitle="ManifestPercentile",
                varDescription="Manifest percentile score",
                measureType="continuous",
                clearWith=list(
                    "raw",
                    "weights",
                    "scale",
                    "descend",
                    "group",
                    "t")))
            self$add(jmvcore::Output$new(
                options=options,
                name="savePredicted",
                title="Fitted Norm Scores",
                varTitle="FittedNorm",
                varDescription="Fitted norm score",
                measureType="continuous",
                clearWith=list(
                    "raw",
                    "weights",
                    "scale",
                    "k",
                    "descend",
                    "terms",
                    "group",
                    "t")))
            self$add(jmvcore::Output$new(
                options=options,
                name="savePredictedPerc",
                title="Fitted Percentile Scores",
                varTitle="FittedPercentile",
                varDescription="Fitted percentile score",
                measureType="continuous",
                clearWith=list(
                    "raw",
                    "weights",
                    "scale",
                    "k",
                    "descend",
                    "terms",
                    "group",
                    "t")))}))

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

#' Continuous Norming (Distribution Free)
#'
#' 
#' @param data the data as a data frame
#' @param raw the raw score variable in the data
#' @param group the explanatory variable in the data, e. g. age group
#' @param weights on optional weighting variable, specifying the weights of
#'   the single cases
#' @param scale \code{'T'}, \code{'IQ'}, 'z', 'Wechsler subtest scale (m = 10,
#'   sd = 3)', or 'PISA (m = 500, sd = 100)'`
#' @param k .
#' @param t .
#' @param selectionType .
#' @param terms a number of terms in the regression function
#' @param descend .
#' @param model .
#' @param normAge a number specifying the age for the norm score table
#' @param range .
#' @param minRaw .
#' @param maxRaw .
#' @param stepping .
#' @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 table \cr
#'   \code{results$saveManifest} \tab \tab \tab \tab \tab an output \cr
#'   \code{results$saveManifestPerc} \tab \tab \tab \tab \tab an output \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
continuous <- function(
    data,
    raw,
    group,
    weights,
    scale = "T",
    k = "5",
    t = "3",
    selectionType,
    terms = 4,
    descend = FALSE,
    model = TRUE,
    normAge,
    range = 3,
    minRaw = 0,
    maxRaw = 0,
    stepping = 1) {

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

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


    options <- continuousOptions$new(
        raw = raw,
        group = group,
        weights = weights,
        scale = scale,
        k = k,
        t = t,
        selectionType = selectionType,
        terms = terms,
        descend = descend,
        model = model,
        normAge = normAge,
        range = range,
        minRaw = minRaw,
        maxRaw = maxRaw,
        stepping = stepping)

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

    analysis$run()

    analysis$results
}