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", quietly=TRUE)) 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,
            pathDiagram = FALSE,
            pathDiagramLabel = TRUE,
            pathDiagramEst = TRUE,
            pathDiagramSig = TRUE, ...) {

            super$initialize(
                package="medmod",
                name="med",
                requiresData=TRUE,
                ...)

            private$..dep <- jmvcore::OptionVariable$new(
                "dep",
                dep,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..med <- jmvcore::OptionVariable$new(
                "med",
                med,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..pred <- jmvcore::OptionVariable$new(
                "pred",
                pred,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            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)
            private$..pathDiagram <- jmvcore::OptionBool$new(
                "pathDiagram",
                pathDiagram,
                default=FALSE)
            private$..pathDiagramLabel <- jmvcore::OptionBool$new(
                "pathDiagramLabel",
                pathDiagramLabel,
                default=TRUE)
            private$..pathDiagramEst <- jmvcore::OptionBool$new(
                "pathDiagramEst",
                pathDiagramEst,
                default=TRUE)
            private$..pathDiagramSig <- jmvcore::OptionBool$new(
                "pathDiagramSig",
                pathDiagramSig,
                default=TRUE)

            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)
            self$.addOption(private$..pathDiagram)
            self$.addOption(private$..pathDiagramLabel)
            self$.addOption(private$..pathDiagramEst)
            self$.addOption(private$..pathDiagramSig)
        }),
    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,
        pathDiagram = function() private$..pathDiagram$value,
        pathDiagramLabel = function() private$..pathDiagramLabel$value,
        pathDiagramEst = function() private$..pathDiagramEst$value,
        pathDiagramSig = function() private$..pathDiagramSig$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,
        ..pathDiagram = NA,
        ..pathDiagramLabel = NA,
        ..pathDiagramEst = NA,
        ..pathDiagramSig = NA)
)

medResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "medResults",
    inherit = jmvcore::Group,
    active = list(
        med = function() private$.items[["med"]],
        paths = function() private$.items[["paths"]],
        pathDiagram = function() private$.items[["pathDiagram"]],
        estPlot = function() private$.items[["estPlot"]],
        modelSyntax = function() private$..modelSyntax),
    private = list(
        ..modelSyntax = NA),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Mediation")
            self$add(jmvcore::Table$new(
                options=options,
                name="med",
                title="Mediation Estimates",
                clearWith=list(
                    "dep",
                    "pred",
                    "med",
                    "estMethod",
                    "bootstrap",
                    "ciWidth"),
                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)"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="paths",
                title="Path Estimates",
                rows=3,
                visible="(paths)",
                clearWith=list(
                    "dep",
                    "pred",
                    "med",
                    "estMethod",
                    "bootstrap",
                    "ciWidth"),
                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)"))))
            self$add(jmvcore::Image$new(
                options=options,
                name="pathDiagram",
                title="Path Diagram",
                width=500,
                height=300,
                renderFun=".pathDiagram",
                visible="(pathDiagram)",
                clearWith=list(
                    "dep",
                    "pred",
                    "pathDiagramLabel",
                    "pathDiagramEst",
                    "pathDiagramSig",
                    "med",
                    "estMethod",
                    "bootstrap")))
            self$add(jmvcore::Image$new(
                options=options,
                name="estPlot",
                title="Estimate Plot",
                width=550,
                height=250,
                renderFun=".estPlot",
                visible="(estPlot)",
                clearWith=list(
                    "dep",
                    "pred",
                    "med",
                    "estMethod",
                    "bootstrap",
                    "ciWidth",
                    "label")))
            private$..modelSyntax <- NULL},
        .setModelSyntax=function(x) private$..modelSyntax <- x))

medBase <- if (requireNamespace("jmvcore", quietly=TRUE)) 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,
                requiresMissings = FALSE,
                weightsSupport = 'auto')
        }))

#' Mediation
#'
#' Simple mediation analysis. Estimates the indirect, direct and total effects 
#' of a model in which a predictor influences the dependent variable through a 
#' mediator. The model is fitted with the lavaan package (Rosseel, 2012); 
#' standard errors are computed with the delta method (equivalent to the Sobel 
#' test for the indirect effect) or by bootstrapping. Optionally provides the 
#' individual path estimates, an estimate plot, and an annotated path diagram 
#' of the model.
#'
#' @examples
#' set.seed(1234)
#' X <- rnorm(100)
#' M <- 0.5*X + rnorm(100)
#' Y <- 0.7*M + rnorm(100)
#' 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.
#' @param pathDiagram \code{TRUE} or \code{FALSE} (default), provide a path
#'   diagram of the mediation model.
#' @param pathDiagramLabel \code{TRUE} (default) or \code{FALSE}, annotate the
#'   path diagram arrows with the path labels.
#' @param pathDiagramEst \code{TRUE} (default) or \code{FALSE}, annotate the
#'   path diagram arrows with the estimated coefficients.
#' @param pathDiagramSig \code{TRUE} (default) or \code{FALSE}, annotate the
#'   path diagram arrows with significance stars.
#' @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$pathDiagram} \tab \tab \tab \tab \tab an image \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,
    pathDiagram = FALSE,
    pathDiagramLabel = TRUE,
    pathDiagramEst = TRUE,
    pathDiagramSig = TRUE) {

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

    if ( ! missing(dep)) dep <- jmvcore::resolveQuo(jmvcore::enquo(dep))
    if ( ! missing(med)) med <- jmvcore::resolveQuo(jmvcore::enquo(med))
    if ( ! missing(pred)) pred <- jmvcore::resolveQuo(jmvcore::enquo(pred))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(dep), dep, NULL),
            `if`( ! missing(med), med, NULL),
            `if`( ! missing(pred), pred, NULL))


    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,
        pathDiagram = pathDiagram,
        pathDiagramLabel = pathDiagramLabel,
        pathDiagramEst = pathDiagramEst,
        pathDiagramSig = pathDiagramSig)

    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 July 16, 2026, 9:07 a.m.