R/rdesc.h.R

Defines functions rdesc

Documented in rdesc

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

rdescOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "rdescOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            splitBy = NULL,
            mean = TRUE,
            trim = TRUE,
            tr = 0.2,
            win = FALSE,
            wl = 0.2,
            mest = FALSE,
            bend = 1.28,
            med = FALSE, ...) {

            super$initialize(
                package="walrus",
                name="rdesc",
                requiresData=TRUE,
                ...)

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..splitBy <- jmvcore::OptionVariable$new(
                "splitBy",
                splitBy,
                default=NULL,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..mean <- jmvcore::OptionBool$new(
                "mean",
                mean,
                default=TRUE)
            private$..trim <- jmvcore::OptionBool$new(
                "trim",
                trim,
                default=TRUE)
            private$..tr <- jmvcore::OptionNumber$new(
                "tr",
                tr,
                default=0.2,
                min=0,
                max=0.5)
            private$..win <- jmvcore::OptionBool$new(
                "win",
                win,
                default=FALSE)
            private$..wl <- jmvcore::OptionNumber$new(
                "wl",
                wl,
                default=0.2,
                min=0,
                max=0.5)
            private$..mest <- jmvcore::OptionBool$new(
                "mest",
                mest,
                default=FALSE)
            private$..bend <- jmvcore::OptionNumber$new(
                "bend",
                bend,
                default=1.28)
            private$..med <- jmvcore::OptionBool$new(
                "med",
                med,
                default=FALSE)

            self$.addOption(private$..vars)
            self$.addOption(private$..splitBy)
            self$.addOption(private$..mean)
            self$.addOption(private$..trim)
            self$.addOption(private$..tr)
            self$.addOption(private$..win)
            self$.addOption(private$..wl)
            self$.addOption(private$..mest)
            self$.addOption(private$..bend)
            self$.addOption(private$..med)
        }),
    active = list(
        vars = function() private$..vars$value,
        splitBy = function() private$..splitBy$value,
        mean = function() private$..mean$value,
        trim = function() private$..trim$value,
        tr = function() private$..tr$value,
        win = function() private$..win$value,
        wl = function() private$..wl$value,
        mest = function() private$..mest$value,
        bend = function() private$..bend$value,
        med = function() private$..med$value),
    private = list(
        ..vars = NA,
        ..splitBy = NA,
        ..mean = NA,
        ..trim = NA,
        ..tr = NA,
        ..win = NA,
        ..wl = NA,
        ..mest = NA,
        ..bend = NA,
        ..med = NA)
)

rdescResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "rdescResults",
    inherit = jmvcore::Group,
    active = list(
        table = function() private$.items[["table"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Robust Descriptives")
            self$add(jmvcore::Table$new(
                options=options,
                name="table",
                title="Robust Descriptives",
                clearWith=list(
                    "tr",
                    "wl",
                    "bend",
                    "splitBy"),
                columns=list(
                    list(
                        `name`="var", 
                        `title`="", 
                        `type`="text", 
                        `combineBelow`=TRUE),
                    list(
                        `name`="level", 
                        `title`="", 
                        `type`="text", 
                        `visible`="(splitBy)"),
                    list(
                        `name`="s[m]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Mean", 
                        `visible`="(mean)"),
                    list(
                        `name`="m[m]", 
                        `title`="", 
                        `visible`="(mean)"),
                    list(
                        `name`="se[m]", 
                        `title`="SE", 
                        `visible`="(mean)"),
                    list(
                        `name`="s[tr]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Trimmed mean", 
                        `visible`="(trim)"),
                    list(
                        `name`="m[tr]", 
                        `title`="", 
                        `visible`="(trim)"),
                    list(
                        `name`="se[tr]", 
                        `title`="SE", 
                        `visible`="(trim)"),
                    list(
                        `name`="s[w]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Winsorized mean", 
                        `visible`="(win)"),
                    list(
                        `name`="m[w]", 
                        `title`="", 
                        `visible`="(win)"),
                    list(
                        `name`="se[w]", 
                        `title`="SE", 
                        `visible`="(win)"),
                    list(
                        `name`="s[est]", 
                        `title`="", 
                        `type`="text", 
                        `content`="M-estimator", 
                        `visible`="(mest)"),
                    list(
                        `name`="m[est]", 
                        `title`="", 
                        `visible`="(mest)"),
                    list(
                        `name`="se[est]", 
                        `title`="SE", 
                        `visible`="(mest)"),
                    list(
                        `name`="s[med]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Median", 
                        `visible`="(med)"),
                    list(
                        `name`="m[med]", 
                        `title`="", 
                        `visible`="(med)"),
                    list(
                        `name`="se[med]", 
                        `title`="SE", 
                        `visible`="(med)"))))}))

rdescBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "rdescBase",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = "walrus",
                name = "rdesc",
                version = c(1,0,0),
                options = options,
                results = rdescResults$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE,
                requiresMissings = FALSE)
        }))

#' Robust Descriptives
#'
#' Robust Descriptives
#'
#' @examples
#' 
#' data('eurosoccer', package='WRS2')
#'
#' SpainGermany <- subset(eurosoccer, eurosoccer$League == 'Spain' | eurosoccer$League == 'Germany')
#' SpainGermany <- droplevels(SpainGermany)
#'
#' walrus::rdesc(
#'     data = SpainGermany,
#'     vars = "GoalsGame",
#'     splitBy = "League",
#'     med = TRUE)
#'
#' #
#' #  ROBUST DESCRIPTIVES
#' #
#' #  Robust Descriptives
#' #  ----------------------------------------------------------
#' #                                                    SE
#' #  ----------------------------------------------------------
#' #    GoalsGame    Germany    Mean            1.46     0.105
#' #                            Trimmed mean    1.45    0.1341
#' #                            Median          1.43    0.1599
#' #
#' #                 Spain      Mean            1.45     0.101
#' #                            Trimmed mean    1.33    0.0601
#' #                            Median          1.30    0.0766
#' #  ----------------------------------------------------------
#' #
#'
#' @param data the data as a data frame
#' @param vars a vector of strings naming the variables in \code{data} of
#'   interest
#' @param splitBy a string naming the variable in \code{data} to split the
#'   data by
#' @param mean \code{TRUE} (default) or \code{FALSE}, provide a 'normal'
#'   arithmetic mean
#' @param trim \code{TRUE} (default) or \code{FALSE}, provide a trimmed mean
#' @param tr a number between 0 and 0.5 (default: 0.2); the proportion of
#'   measurements to trim from each end when producing trimmed means
#' @param win \code{TRUE} or \code{FALSE} (default), provide a 'Winsorized'
#'   mean
#' @param wl a number between 0 and 0.5 (default: 0.2); the level of
#'   'winsorizing' when producing winsorized means
#' @param mest \code{TRUE} or \code{FALSE} (default), provide an 'M-estimated'
#'   value
#' @param bend a number (default: 1.28), the bending constant to use when
#'   using M-estimators
#' @param med \code{TRUE} or \code{FALSE} (default), provide medians
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$table} \tab \tab \tab \tab \tab the table of descriptives \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$table$asDF}
#'
#' \code{as.data.frame(results$table)}
#'
#' @export
rdesc <- function(
    data,
    vars,
    splitBy = NULL,
    mean = TRUE,
    trim = TRUE,
    tr = 0.2,
    win = FALSE,
    wl = 0.2,
    mest = FALSE,
    bend = 1.28,
    med = FALSE) {

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

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

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

    options <- rdescOptions$new(
        vars = vars,
        splitBy = splitBy,
        mean = mean,
        trim = trim,
        tr = tr,
        win = win,
        wl = wl,
        mest = mest,
        bend = bend,
        med = med)

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

    analysis$run()

    analysis$results
}
jamovi/walrus documentation built on July 21, 2023, 7:31 p.m.