R/mod.h.R

Defines functions mod

Documented in mod

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

modOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
    "modOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            dep = NULL,
            mod = NULL,
            pred = NULL,
            estMethod = "standard",
            bootstrap = 1000,
            test = TRUE,
            ci = FALSE,
            ciWidth = 95,
            simpleSlopeEst = FALSE,
            simpleSlopePlot = FALSE, ...) {

            super$initialize(
                package='medmod',
                name='mod',
                requiresData=TRUE,
                ...)
        
            private$..dep <- jmvcore::OptionVariable$new(
                "dep",
                dep,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous",
                    "nominal",
                    "ordinal"))
            private$..mod <- jmvcore::OptionVariable$new(
                "mod",
                mod,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous",
                    "nominal",
                    "ordinal"))
            private$..pred <- jmvcore::OptionVariable$new(
                "pred",
                pred,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous",
                    "nominal",
                    "ordinal"))
            private$..estMethod <- jmvcore::OptionList$new(
                "estMethod",
                estMethod,
                options=list(
                    "standard",
                    "bootstrap"),
                default="standard")
            private$..bootstrap <- jmvcore::OptionInteger$new(
                "bootstrap",
                bootstrap,
                min=1,
                default=1000)
            private$..test <- jmvcore::OptionBool$new(
                "test",
                test,
                default=TRUE)
            private$..ci <- jmvcore::OptionBool$new(
                "ci",
                ci,
                default=FALSE)
            private$..ciWidth <- jmvcore::OptionNumber$new(
                "ciWidth",
                ciWidth,
                min=50,
                max=99.9,
                default=95)
            private$..simpleSlopeEst <- jmvcore::OptionBool$new(
                "simpleSlopeEst",
                simpleSlopeEst,
                default=FALSE)
            private$..simpleSlopePlot <- jmvcore::OptionBool$new(
                "simpleSlopePlot",
                simpleSlopePlot,
                default=FALSE)
        
            self$.addOption(private$..dep)
            self$.addOption(private$..mod)
            self$.addOption(private$..pred)
            self$.addOption(private$..estMethod)
            self$.addOption(private$..bootstrap)
            self$.addOption(private$..test)
            self$.addOption(private$..ci)
            self$.addOption(private$..ciWidth)
            self$.addOption(private$..simpleSlopeEst)
            self$.addOption(private$..simpleSlopePlot)
        }),
    active = list(
        dep = function() private$..dep$value,
        mod = function() private$..mod$value,
        pred = function() private$..pred$value,
        estMethod = function() private$..estMethod$value,
        bootstrap = function() private$..bootstrap$value,
        test = function() private$..test$value,
        ci = function() private$..ci$value,
        ciWidth = function() private$..ciWidth$value,
        simpleSlopeEst = function() private$..simpleSlopeEst$value,
        simpleSlopePlot = function() private$..simpleSlopePlot$value),
    private = list(
        ..dep = NA,
        ..mod = NA,
        ..pred = NA,
        ..estMethod = NA,
        ..bootstrap = NA,
        ..test = NA,
        ..ci = NA,
        ..ciWidth = NA,
        ..simpleSlopeEst = NA,
        ..simpleSlopePlot = NA)
)

modResults <- if (requireNamespace('jmvcore')) R6::R6Class(
    inherit = jmvcore::Group,
    active = list(
        mod = function() private$..mod,
        simpleSlope = function() private$..simpleSlope,
        modelSyntax = function() private$..modelSyntax),
    private = list(
        ..mod = NA,
        ..simpleSlope = NA,
        ..modelSyntax = NA),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Moderation")
            private$..mod <- jmvcore::Table$new(
                options=options,
                name="mod",
                title="Moderation Estimates",
                clearWith=list(
                    "dep",
                    "pred",
                    "mod",
                    "estMethod"),
                columns=list(
                    list(
                        `name`="term", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="est", 
                        `title`="Estimate", 
                        `type`="number"),
                    list(
                        `name`="se", 
                        `title`="SE", 
                        `type`="number"),
                    list(
                        `name`="lower", 
                        `title`="Lower", 
                        `type`="number", 
                        `visible`="(ci)"),
                    list(
                        `name`="upper", 
                        `title`="Upper", 
                        `type`="number", 
                        `visible`="(ci)"),
                    list(
                        `name`="z", 
                        `title`="Z", 
                        `type`="number", 
                        `visible`="(test)"),
                    list(
                        `name`="p", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue", 
                        `visible`="(test)")))
            private$..simpleSlope <- R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    estimates = function() private$..estimates,
                    plot = function() private$..plot),
                private = list(
                    ..estimates = NA,
                    ..plot = NA),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="simpleSlope",
                            title="Simple Slope Analysis")
                        private$..estimates <- jmvcore::Table$new(
                            options=options,
                            name="estimates",
                            title="Simple Slope Estimates",
                            visible="(simpleSlopeEst)",
                            clearWith=list(
                                "dep",
                                "pred",
                                "mod",
                                "estMethod"),
                            columns=list(
                                list(
                                    `name`="term", 
                                    `title`="", 
                                    `type`="text"),
                                list(
                                    `name`="est", 
                                    `title`="Estimate", 
                                    `type`="number"),
                                list(
                                    `name`="se", 
                                    `title`="SE", 
                                    `type`="number"),
                                list(
                                    `name`="lower", 
                                    `title`="Lower", 
                                    `type`="number", 
                                    `visible`="(ci)"),
                                list(
                                    `name`="upper", 
                                    `title`="Upper", 
                                    `type`="number", 
                                    `visible`="(ci)"),
                                list(
                                    `name`="z", 
                                    `title`="Z", 
                                    `type`="number", 
                                    `visible`="(test)"),
                                list(
                                    `name`="p", 
                                    `title`="p", 
                                    `type`="number", 
                                    `format`="zto,pvalue", 
                                    `visible`="(test)")))
                        private$..plot <- jmvcore::Image$new(
                            options=options,
                            name="plot",
                            title="Simple Slope Plot",
                            width=550,
                            height=400,
                            renderFun=".simpleSlopePlot",
                            visible="(simpleSlopePlot)",
                            clearWith=list(
                                "dep",
                                "pred",
                                "mod",
                                "estMethod",
                                "ciWidth"))
                        self$add(private$..estimates)
                        self$add(private$..plot)}))$new(options=options)
            private$..modelSyntax <- NULL
            self$add(private$..mod)
            self$add(private$..simpleSlope)},
        .setModelSyntax=function(x) private$..modelSyntax <- x))

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

#' Moderation
#'
#' Simple mediation analysis
#'
#' @examples
#' set.seed(1234)
#' X <- rnorm(10)
#' M <- rnorm(10)
#' X_M <- X*M
#' Y <- 0.7*X + 0.1*M + 4.2*X_M + rnorm(10)
#' dat <- data.frame(X=X, M=M, Y=Y)   
#' 
#' mod(dat, dep = "Y", pred = "X", mod = "M")
#' 
#' #
#' #  Moderation Estimates                               
#' #  -------------------------------------------------- 
#' #             Estimate    SE        Z        p        
#' #  -------------------------------------------------- 
#' #    X           0.951    0.0965     9.86    < .001   
#' #    M          -0.471    0.0923    -5.10    < .001   
#' #    X:M         4.185    0.1009    41.50    < .001   
#' #  -------------------------------------------------- 
#' # 
#' # 
#' 
#' @param data the data as a data frame
#' @param dep a string naming the dependent variable
#' @param mod a string naming the moderator variable
#' @param pred a string naming the predictor variable
#' @param estMethod \code{'standard'} (default), or \code{'bootstrap'}, the 
#'   estimation method to use 
#' @param bootstrap a number between 1 and 100000 (default: 1000) specifying 
#'   the number of  samples that need to been drawn in the bootstrap method 
#' @param test \code{TRUE} (default) or \code{FALSE}, provide 'Z' and 'p' 
#'   values for the mediation estimates 
#' @param ci \code{TRUE} or \code{FALSE} (default), provide a confidence 
#'   interval for the mediation estimates 
#' @param ciWidth a number between 50 and 99.9 (default: 95) specifying the 
#'   confidence interval width that is used as \code{'ci'} 
#' @param simpleSlopeEst \code{TRUE} or \code{FALSE} (default), provide the 
#'   estimates of the simple slopes. 
#' @param simpleSlopePlot \code{TRUE} or \code{FALSE} (default), provide a 
#'   plot of the simple slopes. 
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$mod} \tab \tab \tab \tab \tab a table containing moderation estimates \cr
#'   \code{results$simpleSlope$estimates} \tab \tab \tab \tab \tab a table containing the simple slope estimates \cr
#'   \code{results$simpleSlope$plot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$modelSyntax} \tab \tab \tab \tab \tab the lavaan syntax used to fit the moderation model \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$mod$asDF}
#'
#' \code{as.data.frame(results$mod)}
#'
#' @export
mod <- function(
    data,
    dep,
    mod,
    pred,
    estMethod = "standard",
    bootstrap = 1000,
    test = TRUE,
    ci = FALSE,
    ciWidth = 95,
    simpleSlopeEst = FALSE,
    simpleSlopePlot = FALSE) {

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

    options <- modOptions$new(
        dep = dep,
        mod = mod,
        pred = pred,
        estMethod = estMethod,
        bootstrap = bootstrap,
        test = test,
        ci = ci,
        ciWidth = ciWidth,
        simpleSlopeEst = simpleSlopeEst,
        simpleSlopePlot = simpleSlopePlot)

    results <- modResults$new(
        options = options)

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

    analysis$run()

    analysis$results
}

Try the medmod package in your browser

Any scripts or data that you put into this service are public.

medmod documentation built on May 1, 2019, 10:25 p.m.