R/surveyplot.h.R

In raviselker/survejmv: Survey Plots

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

surveyPlotOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "surveyPlotOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            group = NULL,
            type = "grouped",
            freq = "count",
            labels = "inPlot",
            desc = TRUE,
            hideNA = TRUE,
            box = TRUE,
            violin = TRUE,
            dot = TRUE, ...) {

            super$initialize(
                package="surveymv",
                name="surveyPlot",
                requiresData=TRUE,
                ...)

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars,
                required=TRUE)
            private$..group <- jmvcore::OptionVariable$new(
                "group",
                group,
                default=NULL,
                suggested=list(
                    "nominal",
                    "ordinal"),
                permitted=list(
                    "factor"))
            private$..type <- jmvcore::OptionList$new(
                "type",
                type,
                options=list(
                    "grouped",
                    "stacked"),
                default="grouped")
            private$..freq <- jmvcore::OptionList$new(
                "freq",
                freq,
                options=list(
                    "count",
                    "perc"),
                default="count")
            private$..labels <- jmvcore::OptionList$new(
                "labels",
                labels,
                options=list(
                    "inPlot",
                    "onAxis"),
                default="inPlot")
            private$..desc <- jmvcore::OptionBool$new(
                "desc",
                desc,
                default=TRUE)
            private$..hideNA <- jmvcore::OptionBool$new(
                "hideNA",
                hideNA,
                default=TRUE)
            private$..box <- jmvcore::OptionBool$new(
                "box",
                box,
                default=TRUE)
            private$..violin <- jmvcore::OptionBool$new(
                "violin",
                violin,
                default=TRUE)
            private$..dot <- jmvcore::OptionBool$new(
                "dot",
                dot,
                default=TRUE)

            self$.addOption(private$..vars)
            self$.addOption(private$..group)
            self$.addOption(private$..type)
            self$.addOption(private$..freq)
            self$.addOption(private$..labels)
            self$.addOption(private$..desc)
            self$.addOption(private$..hideNA)
            self$.addOption(private$..box)
            self$.addOption(private$..violin)
            self$.addOption(private$..dot)
        }),
    active = list(
        vars = function() private$..vars$value,
        group = function() private$..group$value,
        type = function() private$..type$value,
        freq = function() private$..freq$value,
        labels = function() private$..labels$value,
        desc = function() private$..desc$value,
        hideNA = function() private$..hideNA$value,
        box = function() private$..box$value,
        violin = function() private$..violin$value,
        dot = function() private$..dot$value),
    private = list(
        ..vars = NA,
        ..group = NA,
        ..type = NA,
        ..freq = NA,
        ..labels = NA,
        ..desc = NA,
        ..hideNA = NA,
        ..box = NA,
        ..violin = NA,
        ..dot = NA)
)

surveyPlotResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "surveyPlotResults",
    inherit = jmvcore::Group,
    active = list(
        plots = function() private$.items[["plots"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Survey Plots")
            self$add(jmvcore::Array$new(
                options=options,
                name="plots",
                title="",
                items="(vars)",
                clearWith=list(
                    "group",
                    "type",
                    "labels",
                    "freq",
                    "labels",
                    "hideNA",
                    "desc",
                    "violin",
                    "box",
                    "dot"),
                template=jmvcore::Image$new(
                    options=options,
                    name="$key",
                    renderFun=".surveyplot",
                    clearWith=list())))}))

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

#' Survey Plots
#'
#' 
#' @param data .
#' @param vars .
#' @param group .
#' @param type \code{grouped} (default), or \code{stacked}, provide
#'   respectively grouped, or stacked bar plots
#' @param freq \code{count} (default), or \code{perc}, provide respectively
#'   counts,  or percentages as the frequencies
#' @param labels \code{inPlot} (default), or \code{onAxis}, show the bar
#'   labels respectively in the plot  near the labels, or on the x-axis
#' @param desc \code{TRUE} (default) or \code{FALSE}, show variable
#'   description in the plot
#' @param hideNA \code{TRUE} (default) or \code{FALSE}, hide missing values in
#'   the plot
#' @param box \code{TRUE} (default) or \code{FALSE}, add box plot element to
#'   continuous plots
#' @param violin \code{TRUE} (default) or \code{FALSE}, add violin plot
#'   element to continuous plots
#' @param dot \code{TRUE} (default) or \code{FALSE}, add data dot plot element
#'   to continuous plots
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$plots} \tab \tab \tab \tab \tab an array of survey plots \cr
#' }
#'
#' @export
surveyPlot <- function(
    data,
    vars,
    group = NULL,
    type = "grouped",
    freq = "count",
    labels = "inPlot",
    desc = TRUE,
    hideNA = TRUE,
    box = TRUE,
    violin = TRUE,
    dot = TRUE) {

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

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

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

    options <- surveyPlotOptions$new(
        vars = vars,
        group = group,
        type = type,
        freq = freq,
        labels = labels,
        desc = desc,
        hideNA = hideNA,
        box = box,
        violin = violin,
        dot = dot)

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

    analysis$run()

    analysis$results
}