R/metadichotomousmodel.h.R

Defines functions metaDichotomousModel

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

metaDichotomousModelOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
    "metaDichotomousModelOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            ai = NULL,
            n1i = NULL,
            ci = NULL,
            n2i = NULL,
            slab = NULL,
            moderatorcor = NULL,
            includemods = FALSE,
            methodmetamdms = "REML",
            mdmsmeasure = "OR",
            level = 95,
            showModelFit = FALSE,
            addcred = FALSE,
            addfit = TRUE,
            showweights = FALSE,
            xAxisTitle = NULL,
            forestOrder = "fit",
            fsntype = "Rosenthal",
            yaxis = "sei",
            yaxisInv = FALSE,
            enhanceFunnel = FALSE, ...) {

            super$initialize(
                package='MetaModel',
                name='metaDichotomousModel',
                requiresData=TRUE,
                ...)
        
            private$..ai <- jmvcore::OptionVariable$new(
                "ai",
                ai,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous"))
            private$..n1i <- jmvcore::OptionVariable$new(
                "n1i",
                n1i,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous"))
            private$..ci <- jmvcore::OptionVariable$new(
                "ci",
                ci,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous"))
            private$..n2i <- jmvcore::OptionVariable$new(
                "n2i",
                n2i,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous"))
            private$..slab <- jmvcore::OptionVariable$new(
                "slab",
                slab,
                suggested=list(
                    "nominaltext"))
            private$..moderatorcor <- jmvcore::OptionVariable$new(
                "moderatorcor",
                moderatorcor,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "continuous"))
            private$..includemods <- jmvcore::OptionBool$new(
                "includemods",
                includemods,
                default=FALSE)
            private$..methodmetamdms <- jmvcore::OptionList$new(
                "methodmetamdms",
                methodmetamdms,
                options=list(
                    "DL",
                    "HE",
                    "HS",
                    "SJ",
                    "ML",
                    "REML",
                    "EB",
                    "FE"),
                default="REML")
            private$..mdmsmeasure <- jmvcore::OptionList$new(
                "mdmsmeasure",
                mdmsmeasure,
                options=list(
                    "RR",
                    "OR",
                    "RD",
                    "AS",
                    "PETO"),
                default="OR")
            private$..level <- jmvcore::OptionNumber$new(
                "level",
                level,
                min=50,
                max=99.9,
                default=95)
            private$..showModelFit <- jmvcore::OptionBool$new(
                "showModelFit",
                showModelFit,
                default=FALSE)
            private$..addcred <- jmvcore::OptionBool$new(
                "addcred",
                addcred,
                default=FALSE)
            private$..addfit <- jmvcore::OptionBool$new(
                "addfit",
                addfit,
                default=TRUE)
            private$..showweights <- jmvcore::OptionBool$new(
                "showweights",
                showweights,
                default=FALSE)
            private$..xAxisTitle <- jmvcore::OptionString$new(
                "xAxisTitle",
                xAxisTitle)
            private$..forestOrder <- jmvcore::OptionList$new(
                "forestOrder",
                forestOrder,
                options=list(
                    "obs",
                    "fit",
                    "prec",
                    "resid",
                    "abs.resid"),
                default="fit")
            private$..fsntype <- jmvcore::OptionList$new(
                "fsntype",
                fsntype,
                options=list(
                    "Rosenthal",
                    "Orwin",
                    "Rosenberg"),
                default="Rosenthal")
            private$..yaxis <- jmvcore::OptionList$new(
                "yaxis",
                yaxis,
                options=list(
                    "sei",
                    "vi",
                    "ni",
                    "sqrtni",
                    "lni"),
                default="sei")
            private$..yaxisInv <- jmvcore::OptionBool$new(
                "yaxisInv",
                yaxisInv,
                default=FALSE)
            private$..enhanceFunnel <- jmvcore::OptionBool$new(
                "enhanceFunnel",
                enhanceFunnel,
                default=FALSE)
        
            self$.addOption(private$..ai)
            self$.addOption(private$..n1i)
            self$.addOption(private$..ci)
            self$.addOption(private$..n2i)
            self$.addOption(private$..slab)
            self$.addOption(private$..moderatorcor)
            self$.addOption(private$..includemods)
            self$.addOption(private$..methodmetamdms)
            self$.addOption(private$..mdmsmeasure)
            self$.addOption(private$..level)
            self$.addOption(private$..showModelFit)
            self$.addOption(private$..addcred)
            self$.addOption(private$..addfit)
            self$.addOption(private$..showweights)
            self$.addOption(private$..xAxisTitle)
            self$.addOption(private$..forestOrder)
            self$.addOption(private$..fsntype)
            self$.addOption(private$..yaxis)
            self$.addOption(private$..yaxisInv)
            self$.addOption(private$..enhanceFunnel)
        }),
    active = list(
        ai = function() private$..ai$value,
        n1i = function() private$..n1i$value,
        ci = function() private$..ci$value,
        n2i = function() private$..n2i$value,
        slab = function() private$..slab$value,
        moderatorcor = function() private$..moderatorcor$value,
        includemods = function() private$..includemods$value,
        methodmetamdms = function() private$..methodmetamdms$value,
        mdmsmeasure = function() private$..mdmsmeasure$value,
        level = function() private$..level$value,
        showModelFit = function() private$..showModelFit$value,
        addcred = function() private$..addcred$value,
        addfit = function() private$..addfit$value,
        showweights = function() private$..showweights$value,
        xAxisTitle = function() private$..xAxisTitle$value,
        forestOrder = function() private$..forestOrder$value,
        fsntype = function() private$..fsntype$value,
        yaxis = function() private$..yaxis$value,
        yaxisInv = function() private$..yaxisInv$value,
        enhanceFunnel = function() private$..enhanceFunnel$value),
    private = list(
        ..ai = NA,
        ..n1i = NA,
        ..ci = NA,
        ..n2i = NA,
        ..slab = NA,
        ..moderatorcor = NA,
        ..includemods = NA,
        ..methodmetamdms = NA,
        ..mdmsmeasure = NA,
        ..level = NA,
        ..showModelFit = NA,
        ..addcred = NA,
        ..addfit = NA,
        ..showweights = NA,
        ..xAxisTitle = NA,
        ..forestOrder = NA,
        ..fsntype = NA,
        ..yaxis = NA,
        ..yaxisInv = NA,
        ..enhanceFunnel = NA)
)

metaDichotomousModelResults <- if (requireNamespace('jmvcore')) R6::R6Class(
    inherit = jmvcore::Group,
    active = list(
        textRICH = function() private$..textRICH,
        tableTauSqaured = function() private$..tableTauSqaured,
        modelFitRICH = function() private$..modelFitRICH,
        plot = function() private$..plot,
        pubBias = function() private$..pubBias,
        funplot = function() private$..funplot),
    private = list(
        ..textRICH = NA,
        ..tableTauSqaured = NA,
        ..modelFitRICH = NA,
        ..plot = NA,
        ..pubBias = NA,
        ..funplot = NA),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Dichotomous Models")
            private$..textRICH <- jmvcore::Table$new(
                options=options,
                name="textRICH",
                title="Random-Effects Model",
                rows=2,
                columns=list(
                    list(
                        `name`="Intercept", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="Estimate", 
                        `type`="number"),
                    list(
                        `name`="se", 
                        `type`="number"),
                    list(
                        `name`="Z", 
                        `type`="number"),
                    list(
                        `name`="p", 
                        `type`="number", 
                        `format`="zto,pvalue"),
                    list(
                        `name`="CILow", 
                        `title`="CI Lower Bound", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="CIHigh", 
                        `title`="CI Upper Bound", 
                        `type`="number", 
                        `format`="zto")))
            private$..tableTauSqaured <- jmvcore::Table$new(
                options=options,
                name="tableTauSqaured",
                title="Heterogeneity Statistics",
                rows=1,
                columns=list(
                    list(
                        `name`="tauSQRT", 
                        `title`="Tau", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="tauSqComb", 
                        `title`="Tau\u00B2", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="ISqu", 
                        `title`="I\u00B2", 
                        `type`="text"),
                    list(
                        `name`="HSqu", 
                        `title`="H\u00B2", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="RSqu", 
                        `title`="R\u00B2", 
                        `type`="text"),
                    list(
                        `name`="QallDF", 
                        `title`="df", 
                        `type`="integer", 
                        `format`="zto"),
                    list(
                        `name`="Qall", 
                        `title`="Q", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="QallPval", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue")))
            private$..modelFitRICH <- jmvcore::Table$new(
                options=options,
                name="modelFitRICH",
                title="Model Fit Statistics and Information Criteria",
                rows=2,
                columns=list(
                    list(
                        `name`="label", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="loglikelihood", 
                        `title`="log-likelihood", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="deviance", 
                        `title`="Deviance", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="AIC", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="BIC", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="AICc", 
                        `type`="number", 
                        `format`="zto")))
            private$..plot <- jmvcore::Image$new(
                options=options,
                name="plot",
                title="Forest Plot",
                width=600,
                height=450,
                renderFun=".plot")
            private$..pubBias <- R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    fsnRICH = function() private$..fsnRICH,
                    rankRICH = function() private$..rankRICH,
                    regRICH = function() private$..regRICH),
                private = list(
                    ..fsnRICH = NA,
                    ..rankRICH = NA,
                    ..regRICH = NA),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="pubBias",
                            title="Publication Bias Assessment")
                        private$..fsnRICH <- jmvcore::Table$new(
                            options=options,
                            name="fsnRICH",
                            title="Fail-Safe N Analysis",
                            rows=1,
                            columns=list(
                                list(
                                    `name`="failSafeNumber", 
                                    `title`="Fail-safe N", 
                                    `type`="integer", 
                                    `format`="zto"),
                                list(
                                    `name`="p", 
                                    `type`="number", 
                                    `format`="zto,pvalue")))
                        private$..rankRICH <- jmvcore::Table$new(
                            options=options,
                            name="rankRICH",
                            title="Rank Correlation Test for Funnel Plot Asymmetry",
                            rows=1,
                            columns=list(
                                list(
                                    `name`="rankTau", 
                                    `title`="Kendall's Tau", 
                                    `type`="number", 
                                    `format`="zto"),
                                list(
                                    `name`="p", 
                                    `type`="number", 
                                    `format`="zto,pvalue")))
                        private$..regRICH <- jmvcore::Table$new(
                            options=options,
                            name="regRICH",
                            title="Regression Test for Funnel Plot Asymmetry",
                            rows=1,
                            columns=list(
                                list(
                                    `name`="Z", 
                                    `type`="number", 
                                    `format`="zto"),
                                list(
                                    `name`="p", 
                                    `type`="number", 
                                    `format`="zto,pvalue")))
                        self$add(private$..fsnRICH)
                        self$add(private$..rankRICH)
                        self$add(private$..regRICH)}))$new(options=options)
            private$..funplot <- jmvcore::Image$new(
                options=options,
                name="funplot",
                title="Funnel Plot",
                width=600,
                height=450,
                renderFun=".funplot")
            self$add(private$..textRICH)
            self$add(private$..tableTauSqaured)
            self$add(private$..modelFitRICH)
            self$add(private$..plot)
            self$add(private$..pubBias)
            self$add(private$..funplot)}))

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

#' Dichotomous Models
#'
#' 
#' @param data .
#' @param ai .
#' @param n1i .
#' @param ci .
#' @param n2i .
#' @param slab .
#' @param moderatorcor .
#' @param includemods .
#' @param methodmetamdms .
#' @param mdmsmeasure .
#' @param level .
#' @param showModelFit .
#' @param addcred .
#' @param addfit .
#' @param showweights .
#' @param xAxisTitle .
#' @param forestOrder .
#' @param fsntype .
#' @param yaxis .
#' @param yaxisInv .
#' @param enhanceFunnel .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$textRICH} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$tableTauSqaured} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$modelFitRICH} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$pubBias$fsnRICH} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$pubBias$rankRICH} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$pubBias$regRICH} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$funplot} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$textRICH$asDF}
#'
#' \code{as.data.frame(results$textRICH)}
#'
#' @export
metaDichotomousModel <- function(
    data,
    ai,
    n1i,
    ci,
    n2i,
    slab,
    moderatorcor,
    includemods = FALSE,
    methodmetamdms = "REML",
    mdmsmeasure = "OR",
    level = 95,
    showModelFit = FALSE,
    addcred = FALSE,
    addfit = TRUE,
    showweights = FALSE,
    xAxisTitle,
    forestOrder = "fit",
    fsntype = "Rosenthal",
    yaxis = "sei",
    yaxisInv = FALSE,
    enhanceFunnel = FALSE) {

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

    options <- metaDichotomousModelOptions$new(
        ai = ai,
        n1i = n1i,
        ci = ci,
        n2i = n2i,
        slab = slab,
        moderatorcor = moderatorcor,
        includemods = includemods,
        methodmetamdms = methodmetamdms,
        mdmsmeasure = mdmsmeasure,
        level = level,
        showModelFit = showModelFit,
        addcred = addcred,
        addfit = addfit,
        showweights = showweights,
        xAxisTitle = xAxisTitle,
        forestOrder = forestOrder,
        fsntype = fsntype,
        yaxis = yaxis,
        yaxisInv = yaxisInv,
        enhanceFunnel = enhanceFunnel)

    results <- metaDichotomousModelResults$new(
        options = options)

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

    analysis$run()

    analysis$results
}
kylehamilton/JamoviMeta documentation built on Nov. 21, 2017, 10:20 a.m.