R/corrpart.h.R

Defines functions corrPart

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

corrPartOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "corrPartOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            controls = NULL,
            pearson = TRUE,
            spearman = FALSE,
            kendall = FALSE,
            type = "part",
            sig = TRUE,
            flag = FALSE,
            n = FALSE,
            hypothesis = "corr", ...) {

            super$initialize(
                package="jmv",
                name="corrPart",
                requiresData=TRUE,
                ...)

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars,
                takeFromDataIfMissing=TRUE,
                suggested=list(
                    "continuous",
                    "ordinal"),
                permitted=list(
                    "numeric"))
            private$..controls <- jmvcore::OptionVariables$new(
                "controls",
                controls,
                takeFromDataIfMissing=FALSE,
                suggested=list(
                    "continuous",
                    "ordinal"),
                permitted=list(
                    "numeric"))
            private$..pearson <- jmvcore::OptionBool$new(
                "pearson",
                pearson,
                default=TRUE)
            private$..spearman <- jmvcore::OptionBool$new(
                "spearman",
                spearman,
                default=FALSE)
            private$..kendall <- jmvcore::OptionBool$new(
                "kendall",
                kendall,
                default=FALSE)
            private$..type <- jmvcore::OptionList$new(
                "type",
                type,
                options=list(
                    "part",
                    "semi"),
                default="part")
            private$..sig <- jmvcore::OptionBool$new(
                "sig",
                sig,
                default=TRUE)
            private$..flag <- jmvcore::OptionBool$new(
                "flag",
                flag,
                default=FALSE)
            private$..n <- jmvcore::OptionBool$new(
                "n",
                n,
                default=FALSE)
            private$..hypothesis <- jmvcore::OptionList$new(
                "hypothesis",
                hypothesis,
                options=list(
                    "corr",
                    "pos",
                    "neg"),
                default="corr")

            self$.addOption(private$..vars)
            self$.addOption(private$..controls)
            self$.addOption(private$..pearson)
            self$.addOption(private$..spearman)
            self$.addOption(private$..kendall)
            self$.addOption(private$..type)
            self$.addOption(private$..sig)
            self$.addOption(private$..flag)
            self$.addOption(private$..n)
            self$.addOption(private$..hypothesis)
        }),
    active = list(
        vars = function() private$..vars$value,
        controls = function() private$..controls$value,
        pearson = function() private$..pearson$value,
        spearman = function() private$..spearman$value,
        kendall = function() private$..kendall$value,
        type = function() private$..type$value,
        sig = function() private$..sig$value,
        flag = function() private$..flag$value,
        n = function() private$..n$value,
        hypothesis = function() private$..hypothesis$value),
    private = list(
        ..vars = NA,
        ..controls = NA,
        ..pearson = NA,
        ..spearman = NA,
        ..kendall = NA,
        ..type = NA,
        ..sig = NA,
        ..flag = NA,
        ..n = NA,
        ..hypothesis = NA)
)

corrPartResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "corrPartResults",
    inherit = jmvcore::Group,
    active = list(
        matrix = function() private$.items[["matrix"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Partial Correlation")
            self$add(jmvcore::Table$new(
                options=options,
                name="matrix",
                title="Correlation",
                rows="(vars)",
                refs="ppcor",
                clearWith=list(
                    "controls",
                    "hypothesis",
                    "flag",
                    "type",
                    "kendall"),
                columns=list(
                    list(
                        `name`=".name[r]", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `combineBelow`=TRUE, 
                        `visible`="(pearson)"),
                    list(
                        `name`=".stat[r]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Pearson's r", 
                        `visible`="(pearson && (sig || spearman || kendall || n))"),
                    list(
                        `name`=".name[rp]", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `combineBelow`=TRUE, 
                        `visible`="(pearson && sig)"),
                    list(
                        `name`=".stat[rp]", 
                        `title`="", 
                        `type`="text", 
                        `content`="p-value", 
                        `visible`="(pearson && sig)"),
                    list(
                        `name`=".name[rho]", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `combineBelow`=TRUE, 
                        `visible`="(spearman)"),
                    list(
                        `name`=".stat[rho]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Spearman's rho", 
                        `visible`="(spearman && (sig || pearson || kendall || n))"),
                    list(
                        `name`=".name[rhop]", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `combineBelow`=TRUE, 
                        `visible`="(spearman && sig)"),
                    list(
                        `name`=".stat[rhop]", 
                        `title`="", 
                        `type`="text", 
                        `content`="p-value", 
                        `visible`="(spearman && sig)"),
                    list(
                        `name`=".name[tau]", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `combineBelow`=TRUE, 
                        `visible`="(kendall)"),
                    list(
                        `name`=".stat[tau]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Kendall's Tau B", 
                        `visible`="(kendall && (sig || pearson || spearman || n))"),
                    list(
                        `name`=".name[taup]", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `combineBelow`=TRUE, 
                        `visible`="(kendall && sig)"),
                    list(
                        `name`=".stat[taup]", 
                        `title`="", 
                        `type`="text", 
                        `content`="p-value", 
                        `visible`="(kendall && sig)"),
                    list(
                        `name`=".name[n]", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `combineBelow`=TRUE, 
                        `visible`="(n)"),
                    list(
                        `name`=".stat[n]", 
                        `title`="", 
                        `type`="text", 
                        `content`="N", 
                        `visible`="(n)"))))}))

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

#' Partial Correlation
#'
#' Partial correlation matrices are a way to examine linear relationships
#' between two or more continuous variables while controlling for other
#' variables
#' 
#' For each pair of variables, a Pearson's r value indicates the strength
#' and direction of the relationship between those two variables. A
#' positive value indicates a positive relationship (higher values of one
#' variable predict higher values of the other variable). A negative
#' Pearson's r indicates a negative relationship (higher values of one
#' variable predict lower values of the other variable, and vice-versa).
#' A value of zero indicates no relationship (whether a variable is high
#' or low, does not tell us anything about the value of the other
#' variable).
#' 
#' More formally, it is possible to test the null hypothesis that the
#' correlation is zero and calculate a p-value. If the p-value is low, it
#' suggests the correlation co-efficient is not zero, and there is a linear
#' (or more complex) relationship between the two variables.
#' 
#'
#' @examples
#' \donttest{
#' data('mtcars')
#'
#' corrPart(mtcars, vars = vars(mpg, cyl, disp), controls = vars(hp))
#'
#' #
#' #  PARTIAL CORRELATION
#' #
#' #  Partial Correlation
#' #  ----------------------------------------------------
#' #                           mpg       cyl       disp
#' #  ----------------------------------------------------
#' #    mpg     Pearson's r         —
#' #            p-value             —
#' #
#' #    cyl     Pearson's r    -0.590         —
#' #            p-value        < .001         —
#' #
#' #    disp    Pearson's r    -0.606     0.719        —
#' #            p-value        < .001    < .001        —
#' #  ----------------------------------------------------
#' #    Note. controlling for 'hp'
#' #
#'}
#' @param data the data as a data frame
#' @param vars a vector of strings naming the variables to correlate in
#'   \code{data}
#' @param controls a vector of strings naming the control variables in
#'   \code{data}
#' @param pearson \code{TRUE} (default) or \code{FALSE}, provide Pearson's R
#' @param spearman \code{TRUE} or \code{FALSE} (default), provide Spearman's
#'   rho
#' @param kendall \code{TRUE} or \code{FALSE} (default), provide Kendall's
#'   tau-b
#' @param type one of \code{'part'} (default) or \code{'semi'} specifying the
#'   type of partial correlation to calculate; partial or semipartial
#'   correlation.
#' @param sig \code{TRUE} (default) or \code{FALSE}, provide significance
#'   levels
#' @param flag \code{TRUE} or \code{FALSE} (default), flag significant
#'   correlations
#' @param n \code{TRUE} or \code{FALSE} (default), provide the number of cases
#' @param hypothesis one of \code{'corr'} (default), \code{'pos'},
#'   \code{'neg'} specifying the alernative hypothesis; correlated, correlated
#'   positively, correlated negatively respectively.
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$matrix} \tab \tab \tab \tab \tab a (semi)partial correlation matrix table \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$matrix$asDF}
#'
#' \code{as.data.frame(results$matrix)}
#'
#' @export
corrPart <- function(
    data,
    vars,
    controls,
    pearson = TRUE,
    spearman = FALSE,
    kendall = FALSE,
    type = "part",
    sig = TRUE,
    flag = FALSE,
    n = FALSE,
    hypothesis = "corr") {

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

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

    vars <- `if`( ! missing(vars), vars, colnames(data))

    options <- corrPartOptions$new(
        vars = vars,
        controls = controls,
        pearson = pearson,
        spearman = spearman,
        kendall = kendall,
        type = type,
        sig = sig,
        flag = flag,
        n = n,
        hypothesis = hypothesis)

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

    analysis$run()

    analysis$results
}
silkyproject/silkyR documentation built on April 15, 2024, 3:08 p.m.