R/med.h.R

Defines functions med

Documented in med

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

medOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
    "medOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            dep = NULL,
            med = NULL,
            pred = NULL,
            estMethod = "standard",
            bootstrap = 1000,
            test = TRUE,
            ci = FALSE,
            ciWidth = 95,
            pm = FALSE,
            paths = FALSE,
            label = FALSE,
            estPlot = FALSE, ...) {

            super$initialize(
                package='medmod',
                name='med',
                requiresData=TRUE,
                ...)
        
            private$..dep <- jmvcore::OptionVariable$new(
                "dep",
                dep,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous",
                    "nominal",
                    "ordinal"))
            private$..med <- jmvcore::OptionVariable$new(
                "med",
                med,
                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$..pm <- jmvcore::OptionBool$new(
                "pm",
                pm,
                default=FALSE)
            private$..paths <- jmvcore::OptionBool$new(
                "paths",
                paths,
                default=FALSE)
            private$..label <- jmvcore::OptionBool$new(
                "label",
                label,
                default=FALSE)
            private$..estPlot <- jmvcore::OptionBool$new(
                "estPlot",
                estPlot,
                default=FALSE)
        
            self$.addOption(private$..dep)
            self$.addOption(private$..med)
            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$..pm)
            self$.addOption(private$..paths)
            self$.addOption(private$..label)
            self$.addOption(private$..estPlot)
        }),
    active = list(
        dep = function() private$..dep$value,
        med = function() private$..med$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,
        pm = function() private$..pm$value,
        paths = function() private$..paths$value,
        label = function() private$..label$value,
        estPlot = function() private$..estPlot$value),
    private = list(
        ..dep = NA,
        ..med = NA,
        ..pred = NA,
        ..estMethod = NA,
        ..bootstrap = NA,
        ..test = NA,
        ..ci = NA,
        ..ciWidth = NA,
        ..pm = NA,
        ..paths = NA,
        ..label = NA,
        ..estPlot = NA)
)

medResults <- if (requireNamespace('jmvcore')) R6::R6Class(
    inherit = jmvcore::Group,
    active = list(
        med = function() private$..med,
        paths = function() private$..paths,
        estPlot = function() private$..estPlot,
        modelSyntax = function() private$..modelSyntax),
    private = list(
        ..med = NA,
        ..paths = NA,
        ..estPlot = NA,
        ..modelSyntax = NA),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Mediation")
            private$..med <- jmvcore::Table$new(
                options=options,
                name="med",
                title="Mediation Estimates",
                clearWith=list(
                    "dep",
                    "pred",
                    "med",
                    "estMethod"),
                columns=list(
                    list(
                        `name`="effect", 
                        `title`="Effect", 
                        `type`="text"),
                    list(
                        `name`="label", 
                        `title`="Label", 
                        `type`="text", 
                        `format`="narrow", 
                        `visible`="(label)"),
                    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)"),
                    list(
                        `name`="pm", 
                        `title`="% Mediation", 
                        `type`="number", 
                        `visible`="(pm)")))
            private$..paths <- jmvcore::Table$new(
                options=options,
                name="paths",
                title="Path Estimates",
                rows=3,
                visible="(paths)",
                clearWith=list(
                    "dep",
                    "pred",
                    "med",
                    "estMethod"),
                columns=list(
                    list(
                        `name`="var1", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="arrow", 
                        `title`="", 
                        `type`="text", 
                        `format`="narrow"),
                    list(
                        `name`="var2", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="label", 
                        `title`="Label", 
                        `type`="text", 
                        `format`="narrow", 
                        `visible`="(label)"),
                    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$..estPlot <- jmvcore::Image$new(
                options=options,
                name="estPlot",
                title="Estimate Plot",
                width=550,
                height=250,
                renderFun=".estPlot",
                visible="(estPlot)",
                clearWith=list(
                    "dep",
                    "pred",
                    "med",
                    "estMethod",
                    "ciWidth"))
            private$..modelSyntax <- NULL
            self$add(private$..med)
            self$add(private$..paths)
            self$add(private$..estPlot)},
        .setModelSyntax=function(x) private$..modelSyntax <- x))

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

#' Mediation
#'
#' Simple mediation analysis
#'
#' @examples
#' set.seed(1234)
#' X <- rnorm(10)
#' M <- 0.5*X + rnorm(10)
#' Y <- 0.7*M + rnorm(10)
#' dat <- data.frame(X=X, M=M, Y=Y)
#' 
#' med(dat, dep = "Y", pred = "X", med = "M")
#' 
#' #
#' #  Mediation Estimates                                   
#' #  ----------------------------------------------------- 
#' #    Effect      Estimate    SE        Z        p        
#' #  ----------------------------------------------------- 
#' #    Indirect      0.3736    0.0920    4.059    < .001   
#' #    Direct        0.0364    0.1044    0.348     0.728   
#' #    Total         0.4100    0.1247    3.287     0.001   
#' #  ----------------------------------------------------- 
#' # 
#' #
#' 
#' @param data the data as a data frame
#' @param dep a string naming the dependent variable
#' @param med a string naming the mediator 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 pm \code{TRUE} or \code{FALSE} (default), provide the percent 
#'   mediation  effect size for the mediation estimates 
#' @param paths \code{TRUE} or \code{FALSE} (default), provide the individual 
#'   estimates of the  paths in the mediation model 
#' @param label \code{TRUE} (default) or \code{FALSE}, provide insightful 
#'   labels for all estimates 
#' @param estPlot \code{TRUE} or \code{FALSE} (default), provide an estimate 
#'   plot where for each estimator the estimated coefficient and confidence 
#'   intervals are plotted. 
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$med} \tab \tab \tab \tab \tab a table containing mediation estimates \cr
#'   \code{results$paths} \tab \tab \tab \tab \tab a table containing the individual path estimates \cr
#'   \code{results$estPlot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$modelSyntax} \tab \tab \tab \tab \tab the lavaan syntax used to fit the mediation model \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$med$asDF}
#'
#' \code{as.data.frame(results$med)}
#'
#' @export
med <- function(
    data,
    dep,
    med,
    pred,
    estMethod = "standard",
    bootstrap = 1000,
    test = TRUE,
    ci = FALSE,
    ciWidth = 95,
    pm = FALSE,
    paths = FALSE,
    label = FALSE,
    estPlot = FALSE) {

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

    options <- medOptions$new(
        dep = dep,
        med = med,
        pred = pred,
        estMethod = estMethod,
        bootstrap = bootstrap,
        test = test,
        ci = ci,
        ciWidth = ciWidth,
        pm = pm,
        paths = paths,
        label = label,
        estPlot = estPlot)

    results <- medResults$new(
        options = options)

    analysis <- medClass$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.