R/pca.h.R

Defines functions pca

Documented in pca

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

pcaOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "pcaOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            nFactorMethod = "parallel",
            nFactors = 1,
            minEigen = 1,
            rotation = "varimax",
            hideLoadings = 0.3,
            sortLoadings = FALSE,
            screePlot = FALSE,
            eigen = FALSE,
            factorCor = FALSE,
            factorSummary = FALSE,
            kmo = FALSE,
            bartlett = FALSE, ...) {

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

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars,
                takeFromDataIfMissing=TRUE,
                suggested=list(
                    "ordinal",
                    "continuous"),
                permitted=list(
                    "numeric"),
                rejectInf=FALSE)
            private$..nFactorMethod <- jmvcore::OptionList$new(
                "nFactorMethod",
                nFactorMethod,
                options=list(
                    "parallel",
                    "eigen",
                    "fixed"),
                default="parallel")
            private$..nFactors <- jmvcore::OptionInteger$new(
                "nFactors",
                nFactors,
                min=1,
                default=1)
            private$..minEigen <- jmvcore::OptionNumber$new(
                "minEigen",
                minEigen,
                default=1)
            private$..rotation <- jmvcore::OptionList$new(
                "rotation",
                rotation,
                options=list(
                    "none",
                    "varimax",
                    "quartimax",
                    "promax",
                    "oblimin",
                    "simplimax"),
                default="varimax")
            private$..hideLoadings <- jmvcore::OptionNumber$new(
                "hideLoadings",
                hideLoadings,
                default=0.3)
            private$..sortLoadings <- jmvcore::OptionBool$new(
                "sortLoadings",
                sortLoadings,
                default=FALSE)
            private$..screePlot <- jmvcore::OptionBool$new(
                "screePlot",
                screePlot,
                default=FALSE)
            private$..eigen <- jmvcore::OptionBool$new(
                "eigen",
                eigen,
                default=FALSE)
            private$..factorCor <- jmvcore::OptionBool$new(
                "factorCor",
                factorCor,
                default=FALSE)
            private$..factorSummary <- jmvcore::OptionBool$new(
                "factorSummary",
                factorSummary,
                default=FALSE)
            private$..kmo <- jmvcore::OptionBool$new(
                "kmo",
                kmo,
                default=FALSE)
            private$..bartlett <- jmvcore::OptionBool$new(
                "bartlett",
                bartlett,
                default=FALSE)
            private$..factorScoresOV <- jmvcore::OptionOutput$new(
                "factorScoresOV")

            self$.addOption(private$..vars)
            self$.addOption(private$..nFactorMethod)
            self$.addOption(private$..nFactors)
            self$.addOption(private$..minEigen)
            self$.addOption(private$..rotation)
            self$.addOption(private$..hideLoadings)
            self$.addOption(private$..sortLoadings)
            self$.addOption(private$..screePlot)
            self$.addOption(private$..eigen)
            self$.addOption(private$..factorCor)
            self$.addOption(private$..factorSummary)
            self$.addOption(private$..kmo)
            self$.addOption(private$..bartlett)
            self$.addOption(private$..factorScoresOV)
        }),
    active = list(
        vars = function() private$..vars$value,
        nFactorMethod = function() private$..nFactorMethod$value,
        nFactors = function() private$..nFactors$value,
        minEigen = function() private$..minEigen$value,
        rotation = function() private$..rotation$value,
        hideLoadings = function() private$..hideLoadings$value,
        sortLoadings = function() private$..sortLoadings$value,
        screePlot = function() private$..screePlot$value,
        eigen = function() private$..eigen$value,
        factorCor = function() private$..factorCor$value,
        factorSummary = function() private$..factorSummary$value,
        kmo = function() private$..kmo$value,
        bartlett = function() private$..bartlett$value,
        factorScoresOV = function() private$..factorScoresOV$value),
    private = list(
        ..vars = NA,
        ..nFactorMethod = NA,
        ..nFactors = NA,
        ..minEigen = NA,
        ..rotation = NA,
        ..hideLoadings = NA,
        ..sortLoadings = NA,
        ..screePlot = NA,
        ..eigen = NA,
        ..factorCor = NA,
        ..factorSummary = NA,
        ..kmo = NA,
        ..bartlett = NA,
        ..factorScoresOV = NA)
)

pcaResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "pcaResults",
    inherit = jmvcore::Group,
    active = list(
        loadings = function() private$.items[["loadings"]],
        factorStats = function() private$.items[["factorStats"]],
        modelFit = function() private$.items[["modelFit"]],
        assump = function() private$.items[["assump"]],
        eigen = function() private$.items[["eigen"]],
        factorScoresOV = function() private$.items[["factorScoresOV"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Principal Component Analysis")
            self$add(jmvcore::Table$new(
                options=options,
                name="loadings",
                title="Component Loadings",
                rows="(vars)",
                refs="psych",
                clearWith=list(
                    "vars",
                    "nFactorMethod",
                    "nFactors",
                    "hideLoadings",
                    "rotation"),
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)"),
                    list(
                        `name`="pc1", 
                        `title`="1", 
                        `type`="number", 
                        `superTitle`="Component"),
                    list(
                        `name`="uniq", 
                        `title`="Uniqueness", 
                        `type`="number"))))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    factorSummary = function() private$.items[["factorSummary"]],
                    factorCor = function() private$.items[["factorCor"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="factorStats",
                            title="Component Statistics")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="factorSummary",
                            title="Summary",
                            visible="(factorSummary)",
                            clearWith=list(
                                "vars",
                                "nFactorMethod",
                                "nFactors",
                                "rotation"),
                            columns=list(
                                list(
                                    `name`="comp", 
                                    `title`="Component", 
                                    `type`="text"),
                                list(
                                    `name`="loadings", 
                                    `title`="SS Loadings", 
                                    `type`="number"),
                                list(
                                    `name`="varProp", 
                                    `title`="% of Variance", 
                                    `type`="number"),
                                list(
                                    `name`="varCum", 
                                    `title`="Cumulative %", 
                                    `type`="number"))))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="factorCor",
                            title="Inter-Component Correlations",
                            visible="(factorCor)",
                            clearWith=list(
                                "vars",
                                "nFactorMethod",
                                "nFactors",
                                "hideLoadings",
                                "rotation"),
                            columns=list(
                                list(
                                    `name`="comp", 
                                    `title`="", 
                                    `type`="text", 
                                    `format`="narrow"),
                                list(
                                    `name`="pc1", 
                                    `title`="1", 
                                    `type`="number"))))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    fit = function() private$.items[["fit"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="modelFit",
                            title="Model Fit")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="fit",
                            title="Model Fit Measures",
                            rows=1,
                            visible=FALSE,
                            clearWith=list(
                                "vars",
                                "nFactorMethod",
                                "nFactors",
                                "rotation"),
                            columns=list(
                                list(
                                    `name`="rmsea", 
                                    `title`="RMSEA", 
                                    `type`="number"),
                                list(
                                    `name`="rmseaLower", 
                                    `title`="Lower", 
                                    `type`="number", 
                                    `superTitle`="RMSEA 90% CI"),
                                list(
                                    `name`="rmseaUpper", 
                                    `title`="Upper", 
                                    `type`="number", 
                                    `superTitle`="RMSEA 90% CI"),
                                list(
                                    `name`="tli", 
                                    `title`="TLI", 
                                    `type`="number"),
                                list(
                                    `name`="bic", 
                                    `title`="BIC", 
                                    `type`="number"),
                                list(
                                    `name`="chi", 
                                    `title`="\u03C7\u00B2", 
                                    `type`="number", 
                                    `superTitle`="Model Test"),
                                list(
                                    `name`="df", 
                                    `title`="df", 
                                    `type`="integer", 
                                    `superTitle`="Model Test"),
                                list(
                                    `name`="p", 
                                    `title`="p", 
                                    `type`="number", 
                                    `format`="zto,pvalue", 
                                    `superTitle`="Model Test"))))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    bartlett = function() private$.items[["bartlett"]],
                    kmo = function() private$.items[["kmo"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="assump",
                            title="Assumption Checks")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="bartlett",
                            title="Bartlett's Test of Sphericity",
                            visible="(bartlett)",
                            rows=1,
                            clearWith=list(
                                "vars"),
                            columns=list(
                                list(
                                    `name`="chi", 
                                    `title`="\u03C7\u00B2", 
                                    `type`="number"),
                                list(
                                    `name`="df", 
                                    `title`="df", 
                                    `type`="integer"),
                                list(
                                    `name`="p", 
                                    `title`="p", 
                                    `type`="number", 
                                    `format`="zto,pvalue"))))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="kmo",
                            title="KMO Measure of Sampling Adequacy",
                            visible="(kmo)",
                            clearWith=list(
                                "vars"),
                            columns=list(
                                list(
                                    `name`="name", 
                                    `title`="", 
                                    `type`="text"),
                                list(
                                    `name`="msa", 
                                    `title`="MSA", 
                                    `type`="number", 
                                    `format`="zto"))))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    initEigen = function() private$.items[["initEigen"]],
                    screePlot = function() private$.items[["screePlot"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="eigen",
                            title="Eigenvalues")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="initEigen",
                            title="Initial Eigenvalues",
                            visible="(eigen)",
                            clearWith=list(
                                "vars"),
                            columns=list(
                                list(
                                    `name`="comp", 
                                    `title`="Component", 
                                    `type`="text"),
                                list(
                                    `name`="eigen", 
                                    `title`="Eigenvalue", 
                                    `type`="number"),
                                list(
                                    `name`="varProp", 
                                    `title`="% of Variance", 
                                    `type`="number"),
                                list(
                                    `name`="varCum", 
                                    `title`="Cumulative %", 
                                    `type`="number"))))
                        self$add(jmvcore::Image$new(
                            options=options,
                            name="screePlot",
                            title="Scree Plot",
                            visible="(screePlot)",
                            width=500,
                            height=300,
                            renderFun=".screePlot",
                            clearWith=list(
                                "vars",
                                "screePlot",
                                "nFactorMethod",
                                "minEigen")))}))$new(options=options))
            self$add(jmvcore::Output$new(
                options=options,
                name="factorScoresOV",
                title="Factor scores",
                initInRun=TRUE,
                clearWith=list(
                    "vars",
                    "nFactorMethod",
                    "nFactors",
                    "rotation",
                    "factorScoreMethod")))}))

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

#' Principal Component Analysis
#'
#' Principal Component Analysis
#'
#' @examples
#' data('iris')
#'
#' pca(iris, vars = vars(Sepal.Length, Sepal.Width, Petal.Length, Petal.Width))
#'
#' #
#' #  PRINCIPAL COMPONENT ANALYSIS
#' #
#' #  Component Loadings
#' #  ----------------------------------------
#' #                    1         Uniqueness
#' #  ----------------------------------------
#' #    Sepal.Length     0.890        0.2076
#' #    Sepal.Width     -0.460        0.7883
#' #    Petal.Length     0.992        0.0168
#' #    Petal.Width      0.965        0.0688
#' #  ----------------------------------------
#' #    Note. 'varimax' rotation was used
#' #
#'
#' @param data the data as a data frame
#' @param vars a vector of strings naming the variables of interest in
#'   \code{data}
#' @param nFactorMethod \code{'parallel'} (default), \code{'eigen'} or
#'   \code{'fixed'}, the way to determine the number of factors
#' @param nFactors an integer (default: 1), the number of components in the
#'   model
#' @param minEigen a number (default: 1), the minimal eigenvalue for a
#'   component to be included in the model
#' @param rotation \code{'none'}, \code{'varimax'} (default),
#'   \code{'quartimax'}, \code{'promax'}, \code{'oblimin'}, or
#'   \code{'simplimax'}, the rotation to use in estimation
#' @param hideLoadings a number (default: 0.3), hide loadings below this value
#' @param sortLoadings \code{TRUE} or \code{FALSE} (default), sort the factor
#'   loadings by size
#' @param screePlot \code{TRUE} or \code{FALSE} (default), show scree plot
#' @param eigen \code{TRUE} or \code{FALSE} (default), show eigenvalue table
#' @param factorCor \code{TRUE} or \code{FALSE} (default), show inter-factor
#'   correlations
#' @param factorSummary \code{TRUE} or \code{FALSE} (default), show factor
#'   summary
#' @param kmo \code{TRUE} or \code{FALSE} (default), show Kaiser-Meyer-Olkin
#'   (KMO) measure of sampling adequacy (MSA) results
#' @param bartlett \code{TRUE} or \code{FALSE} (default), show Bartlett's test
#'   of sphericity results
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$loadings} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$factorStats$factorSummary} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$factorStats$factorCor} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$modelFit$fit} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$assump$bartlett} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$assump$kmo} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$eigen$initEigen} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$eigen$screePlot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$factorScoresOV} \tab \tab \tab \tab \tab an output \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$loadings$asDF}
#'
#' \code{as.data.frame(results$loadings)}
#'
#' @export
pca <- function(
    data,
    vars,
    nFactorMethod = "parallel",
    nFactors = 1,
    minEigen = 1,
    rotation = "varimax",
    hideLoadings = 0.3,
    sortLoadings = FALSE,
    screePlot = FALSE,
    eigen = FALSE,
    factorCor = FALSE,
    factorSummary = FALSE,
    kmo = FALSE,
    bartlett = FALSE) {

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

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

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

    options <- pcaOptions$new(
        vars = vars,
        nFactorMethod = nFactorMethod,
        nFactors = nFactors,
        minEigen = minEigen,
        rotation = rotation,
        hideLoadings = hideLoadings,
        sortLoadings = sortLoadings,
        screePlot = screePlot,
        eigen = eigen,
        factorCor = factorCor,
        factorSummary = factorSummary,
        kmo = kmo,
        bartlett = bartlett)

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

    analysis$run()

    analysis$results
}

Try the jmv package in your browser

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

jmv documentation built on Oct. 12, 2023, 5:13 p.m.