diff --git a/NAMESPACE b/NAMESPACE index 78b18873..7be2fa93 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,10 +1,11 @@ import(jaspBase) export(latentClassAnalysis) export(latentClassAnalysisInternal) +export(numberOfFactors) +export(numberOfFactorsInternal) export(principalComponentAnalysisInternal) export(exploratoryFactorAnalysisInternal) export(confirmatoryFactorAnalysisInternal) export(principalComponentAnalysis) export(exploratoryFactorAnalysis) export(confirmatoryFactorAnalysis) - diff --git a/NEWS.md b/NEWS.md index 2c2d1b0d..ca1a492c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,13 @@ ## Added * Latent Class Analysis ([PR #346](https://github.com/jasp-stats/jaspFactor/pull/346)). +* New **Number of Factors/Components** analysis that consolidates all factor/component retention methods (parallel analysis, eigenvalue criterion, scree plot) into a dedicated analysis, usable for both EFA and PCA decisions. + +## Changed +* EFA, PCA: eigenvalue- and parallel-analysis-based factor count options removed from both analyses; the number of factors/components is now set manually, with guidance to use the new Number of Factors/Components analysis. + +## Fixed +* Number of Factors: eigenvalue criterion now uses principal component eigenvalues when PC-based parallel analysis is selected, and factor eigenvalues when FA-based parallel analysis is selected. Previously PC eigenvalues were always used, causing factors with factor eigenvalues below the threshold to be incorrectly retained in EFA ([jasp-issues#3970](https://github.com/jasp-stats/jasp-issues/issues/3970)). ## Fixed * EFA: polychoric/tetrachoric correlation matrix errors are now caught and shown as a user-friendly message, including which variables have missing response categories. diff --git a/R/exploratoryfactoranalysis.R b/R/exploratoryfactoranalysis.R index 98d08d00..17de29ea 100644 --- a/R/exploratoryfactoranalysis.R +++ b/R/exploratoryfactoranalysis.R @@ -28,8 +28,6 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ... if (ready) .pcaCheckErrors(dataset, options, method = "efa") - options(mc.cores = 1) # prevent the fa.parallel function using mutlitple cores by default - modelContainer <- .efaModelContainer(jaspResults) # output functions @@ -44,8 +42,6 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ... .efaCorrTable( modelContainer, dataset, options, ready) .efaAdditionalFitTable( modelContainer, dataset, options, ready) .efaResidualTable( modelContainer, options, ready) - .parallelAnalysisTable( modelContainer, dataset, options, ready, name = "Factor") - .efaScreePlot( modelContainer, dataset, options, ready) .efaPathDiagram( modelContainer, dataset, options, ready) # data saving @@ -59,8 +55,8 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ... } else { modelContainer <- createJaspContainer() modelContainer$dependOn(c("rotationMethod", "orthogonalSelector", "obliqueSelector", "variables", "variables.types", - "factorCountMethod", "eigenvaluesAbove", "manualNumberOfFactors", "naAction", - "baseDecompositionOn", "factoringMethod", "parallelAnalysisMethod", "dataType", "sampleSize")) + "manualNumberOfFactors", "naAction", + "baseDecompositionOn", "factoringMethod", "dataType", "sampleSize")) jaspResults[["modelContainer"]] <- modelContainer } @@ -142,7 +138,7 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ... efaResult <- try( psych::fa( r = dtUse, - nfactors = .efaGetNComp(dataset, options, modelContainer), + nfactors = options[["manualNumberOfFactors"]], rotate = ifelse(options$rotationMethod == "orthogonal", options$orthogonalSelector, options$obliqueSelector), scores = TRUE, covar = options$baseDecompositionOn == "covarianceMatrix", @@ -170,61 +166,6 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ... } -.efaGetNComp <- function(dataset, options, modelContainer) { - - # manual method - if (options$factorCountMethod == "manual") return(options$manualNumberOfFactors) - - # parallel analysis method (do always) - if (any(options$variables.types %in% c("ordinal", "nominal")) && options[["baseDecompositionOn"]] == "polyTetrachoricCorrelationMatrix") { - polyTetraCor <- .efaComputePolyCorMatrix(modelContainer, dataset, options) - if (is.null(polyTetraCor)) return(1) - - .setSeedJASP(options) - parallelResult <- try(psych::fa.parallel(polyTetraCor, - plot = FALSE, - fa = ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", - "pc", "fa"), - n.obs = nrow(dataset))) - } else { - .setSeedJASP(options) - - parallelResult <- try(psych::fa.parallel(dataset, plot = FALSE, - fa = ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", - "pc", "fa"))) - } - - if (options$factorCountMethod == "parallelAnalysis") { - if (isTryError(parallelResult)) { - errmsg <- gettextf("Parallel analysis failed. Internal error message: %s", .extractErrorMessage(parallelResult)) - modelContainer$setError(errmsg) - return(1) - } else { - return(ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", - max(1, parallelResult$ncomp), max(1, parallelResult$nfact))) - - } - } - - # eigenValue method - if (options$factorCountMethod == "eigenvalues") { - if (!isTryError(parallelResult)) { - ncomp <- sum(parallelResult$pc.values > options$eigenvaluesAbove) - } else { - ncomp <- 1 - } - # I can use stop() because it's caught by the try and the message is put on - # on the modelcontainer. - if (ncomp == 0) - .quitAnalysis( gettextf("No factors with an eigenvalue > %1$s. Maximum observed eigenvalue equals %2$s.", - options$eigenvaluesAbove, round(max(parallelResult$fa.values), 3))) - return(ncomp) - } - - -} - - # Output functions ---- .efaKMOtest <- function(modelContainer, dataset, options, ready) { @@ -645,169 +586,6 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ... } -.parallelAnalysisTable <- function(modelContainer, dataset, options, ready, name = "Factor") { - if (!options[["parallelAnalysisTable"]] || !is.null(modelContainer[["parallelTable"]])) return() - - if (!ready || modelContainer$getError()) return() - - if (any(options$variables.types %in% c("ordinal", "nominal")) && options[["baseDecompositionOn"]] == "polyTetrachoricCorrelationMatrix") { - polyTetraCor <- .efaComputePolyCorMatrix(modelContainer, dataset, options) - if (is.null(polyTetraCor)) return() - .setSeedJASP(options) - - parallelResult <- try(psych::fa.parallel(polyTetraCor, - plot = FALSE, - fa = ifelse(options[["parallelAnalysisTableMethod"]] == "principalComponentBased", - "pc", "fa"), - n.obs = nrow(dataset))) - } else { - .setSeedJASP(options) - - parallelResult <- try(psych::fa.parallel(dataset, plot = FALSE, - fa = ifelse(options[["parallelAnalysisTableMethod"]] == "principalComponentBased", - "pc", "fa"))) - } - - if (options$parallelAnalysisTableMethod == "principalComponentBased") { - eigTitle <- gettext("Real data component eigenvalues") - rowsName <- gettext(name) - RealDataEigen <- parallelResult$pc.values - ResampledEigen <- parallelResult$pc.sim - footnote <- gettextf("'*' = %s should be retained. Results from PC-based parallel analysis.", name) - } else { # parallelAnalysisMethod is FA - eigTitle <- gettext("Real data factor eigenvalues") - rowsName <- gettext(name) - RealDataEigen <- parallelResult$fa.values - ResampledEigen <- parallelResult$fa.sim - footnote <- gettextf("'*' = %s should be retained. Results from FA-based parallel analysis.", name) - } - - parallelTable <- createJaspTable(gettext("Parallel Analysis")) - parallelTable$dependOn(c("parallelAnalysisTable", "parallelAnalysisTableMethod")) - parallelTable$addColumnInfo(name = "col", title = "", type = "string") - - parallelTable$addColumnInfo(name = "val1", title = eigTitle, type = "number", format = "dp:3") - parallelTable$addColumnInfo(name = "val2", title = gettext("Simulated data mean eigenvalues"), type = "number", format = "dp:3") - parallelTable$position <- 6 - modelContainer[["parallelTable"]] <- parallelTable - - - efaResult <- modelContainer[["model"]][["object"]] - PAs <- zapsmall(as.matrix(data.frame(RealDataEigen, ResampledEigen), fix.empty.names = FALSE)) - forasterisk <- data.frame(applyforasterisk = RealDataEigen - ResampledEigen) - dims <- nrow(PAs) - - firstcol <- data.frame() - for (i in 1:dims) { - if (forasterisk$applyforasterisk[i] > 0) { - firstcol <- rbind(firstcol, paste(rowsName, " ", i,"*", sep = "")) - } else { - firstcol <- rbind(firstcol, paste(rowsName, i)) - } - } - - parallelTable[["col"]] <- firstcol[[1]] - parallelTable[["val1"]] <- c(RealDataEigen) - parallelTable[["val2"]] <- c(ResampledEigen) - - parallelTable$addFootnote(message = footnote) -} - - -.efaScreePlot <- function(modelContainer, dataset, options, ready) { - if (!options[["screePlot"]] || !is.null(modelContainer[["scree"]])) return() - - scree <- createJaspPlot(title = "Scree plot", width = 480, height = 320) - scree$dependOn(c("screePlot", "screePlotParallelAnalysisResults", "parallelAnalysisMethod")) - scree$position <- 8 - modelContainer[["scree"]] <- scree - - if (!ready || modelContainer$getError()) return() - - n_col <- ncol(dataset) - - if (options[["screePlotParallelAnalysisResults"]]) { - - if (any(options$variables.types %in% c("ordinal", "nominal")) && options[["baseDecompositionOn"]] == "polyTetrachoricCorrelationMatrix") { - polyTetraCor <- .efaComputePolyCorMatrix(modelContainer, dataset, options) - if (is.null(polyTetraCor)) return() - .setSeedJASP(options) - - parallelResult <- try(psych::fa.parallel(polyTetraCor, - plot = FALSE, - fa = ifelse(options[["parallelAnalysisTableMethod"]] == "principalComponentBased", - "pc", "fa"), - n.obs = nrow(dataset))) - } else { - .setSeedJASP(options) - - parallelResult <- try(psych::fa.parallel(dataset, plot = FALSE, - fa = ifelse(options[["parallelAnalysisTableMethod"]] == "principalComponentBased", - "pc", "fa"))) - } - if (isTryError(parallelResult)) { - errmsg <- gettextf("Screeplot not available. \nInternal error message: %s", .extractErrorMessage(parallelResult)) - scree$setError(errmsg) - # scree$setError(.decodeVarsInMessage(names(dataset), errmsg)) - return() - } - - if (options$parallelAnalysisTableMethod == "factorBased") { - evs <- c(parallelResult$fa.values, parallelResult$fa.sim) - } else { # in all other cases we use the initial eigenvalues for the plot, aka the pca ones - evs <- c(parallelResult$pc.values, parallelResult$pc.sim) - } - tp <- rep(c(gettext("Data"), gettext("Simulated data from parallel analysis")), each = n_col) - - } else { # do not display parallel analysis - evs <- eigen(cor(dataset, use = "pairwise.complete.obs"), only.values = TRUE)$values - tp <- rep(gettext("Data"), each = n_col) - } - - df <- data.frame( - id = rep(seq_len(n_col), 2), - ev = evs, - type = tp - ) - - # basic scree plot - plt <- - ggplot2::ggplot(df, ggplot2::aes(x = id, y = ev, linetype = type, shape = type)) + - ggplot2::geom_line(na.rm = TRUE) + - ggplot2::labs(x = gettext("Factor"), y = gettext("Eigenvalue")) + - ggplot2::geom_hline(yintercept = options$eigenvaluesAbove) - - - # dynamic function for point size: - # the plot looks good with size 3 when there are 10 points (3 + log(10) - log(10) = 3) - # with more points, the size will become logarithmically smaller until a minimum of - # 3 + log(10) - log(200) = 0.004267726 - # with fewer points, they become bigger to a maximum of 3 + log(10) - log(2) = 4.609438 - pointsize <- 3 + log(10) - log(n_col) - if (pointsize > 0) { - plt <- plt + ggplot2::geom_point(na.rm = TRUE, size = max(0, 3 + log(10) - log(n_col))) - } - - # add axis lines and better breaks - plt <- plt + - jaspGraphs::geom_rangeframe() + - jaspGraphs::themeJaspRaw() + - ggplot2::scale_x_continuous(breaks = seq(1:n_col)) - - # theming with special legend thingy - plt <- plt + - ggplot2::theme( - legend.position = c(0.99, 0.95), - legend.justification = c(1, 1), - legend.text = ggplot2::element_text(size = 12.5), - legend.title = ggplot2::element_blank(), - legend.key.size = ggplot2::unit(18, "pt") - ) - - scree$plotObject <- plt - modelContainer[["scree"]] <- scree -} - .efaPathDiagram <- function(modelContainer, dataset, options, ready){ if (!options[["pathDiagram"]] || !is.null(modelContainer[["path"]])) return() diff --git a/R/exploratoryfactoranalysisWrapper.R b/R/exploratoryfactoranalysisWrapper.R index b69075aa..90541f15 100644 --- a/R/exploratoryfactoranalysisWrapper.R +++ b/R/exploratoryfactoranalysisWrapper.R @@ -68,8 +68,6 @@ #' \item \code{"variables"} #' \item \code{"size"} #' } -#' @param parallelAnalysisTable, If this option is selected, a table will be generated exhibiting a detailed output of the parallel analysis. Can be based on principal component eigenvalues (PC) or factor eigenvalues (FA). The seed is taken from the parallel analysis for determining the number of components/factors above. -#' Defaults to \code{FALSE}. #' @param pathDiagram, By selecting this option, a visual representation of the direction and strength of the relation between the variable and factor will be displayed. #' Defaults to \code{FALSE}. #' @param residualMatrix, Displays a table containing the residual variances and correlations. @@ -79,10 +77,6 @@ #' \item \code{"oblique"}: This method produces components that allow for correlation between the components. This method is selected by default. Several possibilities are available. The default is promax. #' \item \code{"orthogonal"}: This method produces components that are uncorrelated. For this method, there are several possibilities that can be selected. #' } -#' @param screePlot, When selecting this option, a scree plot will be displayed. The scree plot provides information on how much variance in the data, indicated by the eigenvalue, is explained by each factor. A scree plot can be used to decide how many factors should be selected. -#' Defaults to \code{FALSE}. -#' @param screePlotParallelAnalysisResults, Display the results of the parallel analysis in the scree plot. The parallel analysis will be based on PC or FA as defined by the option for the parallel analysis table. -#' Defaults to \code{TRUE}. #' @param variables, In this box, the variables to perform the analysis on are selected exploratoryFactorAnalysis <- function( data = NULL, @@ -93,9 +87,7 @@ exploratoryFactorAnalysis <- function( bartlettTest = FALSE, baseDecompositionOn = "correlationMatrix", dataType = "raw", - eigenvaluesAbove = 1, factorCorrelations = FALSE, - factorCountMethod = "parallelAnalysis", factorStructure = FALSE, factoringMethod = "minimumResidual", fitIndices = FALSE, @@ -107,19 +99,12 @@ exploratoryFactorAnalysis <- function( obliqueSelector = "promax", orderLoadingsBy = "size", orthogonalSelector = "none", - parallelAnalysisMethod = "principalComponentBased", - parallelAnalysisTable = FALSE, - parallelAnalysisTableMethod = "principalComponentBased", pathDiagram = FALSE, plotHeight = 320, plotWidth = 480, residualMatrix = FALSE, rotationMethod = "oblique", sampleSize = 200, - screePlot = FALSE, - screePlotParallelAnalysisResults = TRUE, - seed = 1, - setSeed = FALSE, variables = list(types = list(), value = list())) { defaultArgCalls <- formals(jaspFactor::exploratoryFactorAnalysis) diff --git a/R/numberoffactors.R b/R/numberoffactors.R new file mode 100644 index 00000000..eff937d5 --- /dev/null +++ b/R/numberoffactors.R @@ -0,0 +1,246 @@ +# +# Copyright (C) 2013-2025 University of Amsterdam +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +# + +numberOfFactorsInternal <- function(jaspResults, dataset, options, ...) { + jaspResults$addCitation("Revelle, W. (2018) psych: Procedures for Personality and Psychological Research, Northwestern University, Evanston, Illinois, USA, https://CRAN.R-project.org/package=psych Version = 1.8.12.") + + ready <- length(options$variables) > 1 + # Handle dataset + dataset <- .pcaAndEfaHandleData(dataset, options, ready) + .pcaAndEfaDataCovarianceCheck(dataset, options, ready) + + if (ready) + .pcaCheckErrors(dataset, options, method = "numberOfFactors") + + options(mc.cores = 1) # prevent the fa.parallel function using multiple cores by default + + container <- .nofContainer(jaspResults) + + # output functions + .nofSummaryTable( container, dataset, options, ready) + .nofParallelAnalysisTable( container, dataset, options, ready) + .nofScreePlot( container, dataset, options, ready) +} + + +.nofContainer <- function(jaspResults) { + if (!is.null(jaspResults[["nofContainer"]])) { + container <- jaspResults[["nofContainer"]] + } else { + container <- createJaspContainer() + container$dependOn(c("variables", "variables.types", "dataType", "sampleSize", "naAction", + "baseDecompositionOn", "parallelAnalysisMethod", "setSeed", "seed")) + jaspResults[["nofContainer"]] <- container + } + + return(container) +} + + +# Results functions ---- +.nofComputeParallel <- function(container, dataset, options) { + + # Return cached result if available + if (!is.null(container[["parallelState"]])) + return(container[["parallelState"]]$object) + + faMethod <- ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", "pc", "fa") + + if (any(options$variables.types %in% c("ordinal", "nominal")) && options[["baseDecompositionOn"]] == "polyTetrachoricCorrelationMatrix") { + polyTetraCor <- .efaComputePolyCorMatrix(container, dataset, options) + if (is.null(polyTetraCor)) return(NULL) + .setSeedJASP(options) + parallelResult <- try(psych::fa.parallel(polyTetraCor, plot = FALSE, fa = faMethod, n.obs = nrow(dataset))) + } else if (options[["dataType"]] == "varianceCovariance") { + .setSeedJASP(options) + parallelResult <- try(psych::fa.parallel(cov2cor(as.matrix(dataset)), plot = FALSE, fa = faMethod, + n.obs = options[["sampleSize"]])) + } else { + .setSeedJASP(options) + parallelResult <- try(psych::fa.parallel(dataset, plot = FALSE, fa = faMethod)) + } + + if (isTryError(parallelResult)) { + errmsg <- gettextf("Parallel analysis failed. Internal error message: %s", .extractErrorMessage(parallelResult)) + container$setError(errmsg) + parallelResult <- NULL + } + + container[["parallelState"]] <- createJaspState(parallelResult) + return(parallelResult) +} + + +# Output functions ---- +.nofSummaryTable <- function(container, dataset, options, ready) { + if (!is.null(container[["summaryTable"]])) return() + + summaryTable <- createJaspTable(gettext("Suggested Number of Factors/Components")) + summaryTable$dependOn("eigenvaluesAbove") + summaryTable$position <- 1 + summaryTable$addColumnInfo(name = "method", title = gettext("Method"), type = "string") + summaryTable$addColumnInfo(name = "n", title = gettext("Suggested number"), type = "integer") + container[["summaryTable"]] <- summaryTable + + if (!ready || container$getError()) return() + + parallelResult <- .nofComputeParallel(container, dataset, options) + if (is.null(parallelResult)) return() + + pcBased <- options[["parallelAnalysisMethod"]] == "principalComponentBased" + eigenValues <- if (pcBased) parallelResult$pc.values else parallelResult$fa.values + eigType <- if (pcBased) gettext("principal component") else gettext("factor") + + if (pcBased) { + paLabel <- gettext("Parallel analysis (PC-based)") + paCount <- max(1, parallelResult$ncomp) + } else { + paLabel <- gettext("Parallel analysis (FA-based)") + paCount <- max(1, parallelResult$nfact) + } + + summaryTable[["method"]] <- c(paLabel, gettextf("Eigenvalues above %s", options[["eigenvaluesAbove"]])) + summaryTable[["n"]] <- c(paCount, sum(eigenValues > options[["eigenvaluesAbove"]])) + summaryTable$addFootnote(gettextf("Eigenvalue criterion based on %s eigenvalues.", eigType)) +} + + +.nofParallelAnalysisTable <- function(container, dataset, options, ready) { + if (!options[["parallelAnalysisTable"]] || !is.null(container[["parallelTable"]])) return() + + pcBased <- options[["parallelAnalysisMethod"]] == "principalComponentBased" + eigTitle <- if (pcBased) gettext("Real data component eigenvalues") else gettext("Real data factor eigenvalues") + + parallelTable <- createJaspTable(gettext("Parallel Analysis")) + parallelTable$dependOn("parallelAnalysisTable") + parallelTable$position <- 2 + parallelTable$addColumnInfo(name = "col", title = "", type = "string") + parallelTable$addColumnInfo(name = "val1", title = eigTitle, type = "number", format = "dp:3") + parallelTable$addColumnInfo(name = "val2", title = gettext("Simulated data mean eigenvalues"), type = "number", format = "dp:3") + container[["parallelTable"]] <- parallelTable + + if (!ready || container$getError()) return() + + parallelResult <- .nofComputeParallel(container, dataset, options) + if (is.null(parallelResult)) return() + + if (pcBased) { + rowsName <- gettext("Component") + realDataEigen <- parallelResult$pc.values + resampledEigen <- parallelResult$pc.sim + footnote <- gettextf("'*' = %s should be retained. Results from PC-based parallel analysis.", rowsName) + } else { + rowsName <- gettext("Factor") + realDataEigen <- parallelResult$fa.values + resampledEigen <- parallelResult$fa.sim + footnote <- gettextf("'*' = %s should be retained. Results from FA-based parallel analysis.", rowsName) + } + + retained <- realDataEigen - resampledEigen > 0 + firstCol <- ifelse(retained, + paste0(rowsName, " ", seq_along(realDataEigen), "*"), + paste(rowsName, seq_along(realDataEigen))) + + parallelTable[["col"]] <- firstCol + parallelTable[["val1"]] <- realDataEigen + parallelTable[["val2"]] <- resampledEigen + + parallelTable$addFootnote(message = footnote) +} + + +.nofScreePlot <- function(container, dataset, options, ready) { + if (!options[["screePlot"]] || !is.null(container[["screePlot"]])) return() + + scree <- createJaspPlot(title = gettext("Scree plot"), width = 480, height = 320) + scree$dependOn(c("screePlot", "screePlotParallelAnalysisResults", "eigenvaluesAbove")) + scree$position <- 3 + container[["screePlot"]] <- scree + + if (!ready || container$getError()) return() + + n_col <- ncol(dataset) + pcBased <- options[["parallelAnalysisMethod"]] == "principalComponentBased" + xLabel <- if (pcBased) gettext("Component") else gettext("Factor") + + if (options[["screePlotParallelAnalysisResults"]]) { + + parallelResult <- .nofComputeParallel(container, dataset, options) + if (is.null(parallelResult)) return() + + if (pcBased) { + evs <- c(parallelResult$pc.values, parallelResult$pc.sim) + } else { + evs <- c(parallelResult$fa.values, parallelResult$fa.sim) + } + tp <- rep(c(gettext("Data"), gettext("Simulated data from parallel analysis")), each = n_col) + + } else { # do not display parallel analysis + + if (any(options$variables.types %in% c("ordinal", "nominal")) && options[["baseDecompositionOn"]] == "polyTetrachoricCorrelationMatrix") { + polyTetraCor <- .efaComputePolyCorMatrix(container, dataset, options) + if (is.null(polyTetraCor)) return() + evs <- eigen(polyTetraCor, only.values = TRUE)$values + } else if (options[["dataType"]] == "varianceCovariance") { + evs <- eigen(cov2cor(as.matrix(dataset)), only.values = TRUE)$values + } else { + evs <- eigen(cor(dataset, use = "pairwise.complete.obs"), only.values = TRUE)$values + } + tp <- rep(gettext("Data"), each = n_col) + } + + df <- data.frame( + id = rep(seq_len(n_col), length(evs) / n_col), + ev = evs, + type = tp + ) + + # basic scree plot + plt <- + ggplot2::ggplot(df, ggplot2::aes(x = id, y = ev, linetype = type, shape = type)) + + ggplot2::geom_line(na.rm = TRUE) + + ggplot2::labs(x = xLabel, y = gettext("Eigenvalue")) + + ggplot2::geom_hline(yintercept = options$eigenvaluesAbove) + + # dynamic function for point size: + # the plot looks good with size 3 when there are 10 points (3 + log(10) - log(10) = 3) + # with more points, the size will become logarithmically smaller until a minimum of + # 3 + log(10) - log(200) = 0.004267726 + # with fewer points, they become bigger to a maximum of 3 + log(10) - log(2) = 4.609438 + pointsize <- 3 + log(10) - log(n_col) + if (pointsize > 0) { + plt <- plt + ggplot2::geom_point(na.rm = TRUE, size = max(0, 3 + log(10) - log(n_col))) + } + + # add axis lines and better breaks + plt <- plt + + jaspGraphs::geom_rangeframe() + + jaspGraphs::themeJaspRaw() + + ggplot2::scale_x_continuous(breaks = seq(1:n_col)) + + # theming with special legend thingy + plt <- plt + + ggplot2::theme( + legend.position = c(0.99, 0.95), + legend.justification = c(1, 1), + legend.text = ggplot2::element_text(size = 12.5), + legend.title = ggplot2::element_blank(), + legend.key.size = ggplot2::unit(18, "pt") + ) + + scree$plotObject <- plt +} diff --git a/R/numberoffactorsWrapper.R b/R/numberoffactorsWrapper.R new file mode 100644 index 00000000..6df09520 --- /dev/null +++ b/R/numberoffactorsWrapper.R @@ -0,0 +1,87 @@ +# +# Copyright (C) 2013-2025 University of Amsterdam +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +# + +# This is a generated file. Don't change it! + +#' numberOfFactors +#' +#' @param baseDecompositionOn, What type of correlation matrix to base the analysis on. +#' \itemize{ +#' \item \code{"correlationMatrix"}: The Pearson correlation matrix is used. +#' \item \code{"polyTetrachoricCorrelationMatrix"}: The polychoric/tetrachoric correlation matrix is used. This is sometimes unstable when sample size is small and when some variables do not contain all response categories +#' } +#' @param dataType, Specifies whether the data is raw, meaning observations in rows and variables in columns, or whether the data is a variance-covariance matrix. For the latter, the sample size is required. +#' \itemize{ +#' \item \code{"varianceCovariance"} +#' \item \code{"raw"} +#' } +#' @param eigenvaluesAbove, Threshold for the eigenvalue criterion: factors/components with an eigenvalue above this value are suggested for retention. The default of 1 corresponds to the Kaiser criterion. +#' @param naAction, Select how to handle missing values. +#' \itemize{ +#' \item \code{"pairwise"}: If one observation from a variable is missing, all the other variable observations from the same case will still be used for the analysis. In this scenario, it is not necessary to have an observation for all the variables to include the case in the analysis. This option is selected by default. +#' \item \code{"listwise"}: If one observation from a variable is missing, the whole case, so all the other connected variable observations, will be dismissed from the analysis. In this scenario, observations for every variable are needed to include the case in the analysis. +#' } +#' @param parallelAnalysisMethod, Whether the parallel analysis is based on principal component eigenvalues (PC) or factor eigenvalues (FA). PC-based parallel analysis is a common choice also when the goal is to determine the number of factors for a factor analysis. +#' \itemize{ +#' \item \code{"principalComponentBased"} +#' \item \code{"factorBased"} +#' } +#' @param parallelAnalysisTable, Displays a table with the real data eigenvalues and the mean eigenvalues of the simulated data. Factors/components suggested for retention are marked with an asterisk. +#' Defaults to \code{TRUE}. +#' @param screePlot, Displays a scree plot. The scree plot provides information on how much variance in the data, indicated by the eigenvalue, is explained by each factor/component. The horizontal line marks the eigenvalue threshold. +#' Defaults to \code{TRUE}. +#' @param screePlotParallelAnalysisResults, Display the mean eigenvalues of the simulated data from the parallel analysis in the scree plot. +#' Defaults to \code{TRUE}. +#' @param variables, In this box, the variables to perform the analysis on are selected +numberOfFactors <- function( + data = NULL, + version = "0.95", + baseDecompositionOn = "correlationMatrix", + dataType = "raw", + eigenvaluesAbove = 1, + naAction = "pairwise", + parallelAnalysisMethod = "principalComponentBased", + parallelAnalysisTable = TRUE, + plotHeight = 320, + plotWidth = 480, + sampleSize = 200, + screePlot = TRUE, + screePlotParallelAnalysisResults = TRUE, + seed = 1, + setSeed = FALSE, + variables = list(types = list(), value = list())) { + + defaultArgCalls <- formals(jaspFactor::numberOfFactors) + defaultArgs <- lapply(defaultArgCalls, eval) + options <- as.list(match.call())[-1L] + options <- lapply(options, eval) + defaults <- setdiff(names(defaultArgs), names(options)) + options[defaults] <- defaultArgs[defaults] + options[["data"]] <- NULL + options[["version"]] <- NULL + + + if (!jaspBase::jaspResultsCalledFromJasp() && !is.null(data)) { + jaspBase::storeDataSet(data) + } + + optionsWithFormula <- c("variables") + for (name in optionsWithFormula) { + if ((name %in% optionsWithFormula) && inherits(options[[name]], "formula")) options[[name]] = jaspBase::jaspFormula(options[[name]], data) } + + return(jaspBase::runWrappedAnalysis("jaspFactor", "numberOfFactors", "NumberOfFactors.qml", options, version, TRUE)) +} diff --git a/R/principalcomponentanalysis.R b/R/principalcomponentanalysis.R index 2e94deeb..4b8aff89 100644 --- a/R/principalcomponentanalysis.R +++ b/R/principalcomponentanalysis.R @@ -40,12 +40,10 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, .. .pcaEigenTable( modelContainer, dataset, options, ready) .pcaCorrTable( modelContainer, dataset, options, ready) .pcaResidualTable( modelContainer, dataset, options, ready) - .parallelAnalysisTable( modelContainer, dataset, options, ready, name = "Component") .efaKMOtest( modelContainer, dataset, options, ready) .efaBartlett( modelContainer, dataset, options, ready) .efaMardia( modelContainer, dataset, options, ready) .efaAntiImageCorrelation( modelContainer, dataset, options, ready) - .pcaScreePlot( modelContainer, dataset, options, ready) .pcaPathDiagram( modelContainer, dataset, options, ready) # data saving @@ -137,10 +135,11 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, .. customChecks <- list( function() { - countMethod <- ifelse(method == "efa", options$factorCountMethod, options$componentCountMethod) + if (method == "numberOfFactors") return() + manualCount <- ifelse(method == "efa", options$manualNumberOfFactors, options$manualNumberOfComponents) - if (length(options$variables) > 0 && countMethod == "manual" && manualCount > length(options$variables)) { + if (length(options$variables) > 0 && manualCount > length(options$variables)) { return(gettextf("Too many %1$s requested (%2$i) for the amount of included variables", ifelse(method == "efa", "factors", "components"), manualCount)) } @@ -194,9 +193,9 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, .. modelContainer <- jaspResults[["modelContainer"]] } else { modelContainer <- createJaspContainer() - modelContainer$dependOn(c("rotationMethod", "orthogonalSelector", "obliqueSelector", "variables", "componentCountMethod", - "eigenvaluesAbove", "manualNumberOfComponents", "naAction", "baseDecompositionOn", - "parallelAnalysisMethod", "dataType", "sampleSize")) + modelContainer$dependOn(c("rotationMethod", "orthogonalSelector", "obliqueSelector", "variables", + "manualNumberOfComponents", "naAction", "baseDecompositionOn", + "dataType", "sampleSize")) jaspResults[["modelContainer"]] <- modelContainer } @@ -273,7 +272,7 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, .. pcaResult <- try( psych::principal( r = dataset, - nfactors = .pcaGetNComp(dataset, options, modelContainer), + nfactors = options[["manualNumberOfComponents"]], rotate = rotate, scores = TRUE, covar = options$baseDecompositionOn == "covarianceMatrix", @@ -297,65 +296,6 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, .. return(pcaResult) } -.pcaGetNComp <- function(dataset, options, modelContainer) { - - if (options$componentCountMethod == "manual") return(options$manualNumberOfComponents) - - - - if (any(options$variables.types %in% c("ordinal", "nominal")) && options[["baseDecompositionOn"]] == "polyTetrachoricCorrelationMatrix") { - varTypes <- options$variables.types - vars <- options$variables - scales <- vars[varTypes == "scale"] - ordinals <- vars[varTypes == "ordinal"] - nominals <- vars[varTypes == "nominal"] - polyTetraCor <- psych::mixedCor(dataset, c = scales, p = ordinals, d = nominals) - - .setSeedJASP(options) - - parallelResult <- try(psych::fa.parallel(polyTetraCor$rho, - plot = FALSE, - fa = ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", - "pc", "fa"), - n.obs = nrow(dataset))) - } else { - parallelResult <- try(psych::fa.parallel(dataset, plot = FALSE, - fa = ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", - "pc", "fa"))) - } - - if (options$componentCountMethod == "parallelAnalysis") { - - if (isTryError(parallelResult)) { - errmsg <- gettextf("Parallel analysis failed. Internal error message: %s", .extractErrorMessage(parallelResult)) - modelContainer$setError(errmsg) - } - - if (options$parallelAnalysisMethod == "principalComponentBased") { - return(max(1, parallelResult$ncomp)) - } else { # parallel method is fa - return(max(1, parallelResult$nfact)) - } - } - - if (options$componentCountMethod == "eigenvalues") { - if (!isTryError(parallelResult)) { - ncomp <- sum(parallelResult$pc.values > options$eigenvaluesAbove) - } else { - ncomp <- 1 - } - # I can use stop() because it's caught by the try and the message is put on - # on the modelcontainer. - if (ncomp == 0) - .quitAnalysis( gettextf("No components with an eigenvalue > %1$s. Maximum observed eigenvalue equals %2$s.", - options$eigenvaluesAbove, round(max(parallelResult$fa.values), 3))) - return(ncomp) - } - - -} - - # Output functions ---- .pcaGoodnessOfFitTable <- function(modelContainer, dataset, options, ready) { if (!is.null(modelContainer[["goodnessOfFitTable"]])) return() @@ -544,102 +484,6 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, .. } -.pcaScreePlot <- function(modelContainer, dataset, options, ready) { - if (!options[["screePlot"]] || !is.null(modelContainer[["scree"]])) return() - - scree <- createJaspPlot(title = gettext("Scree plot"), width = 480, height = 320) - scree$dependOn(c("screePlot", "screePlotParallelAnalysisResults", "parallelAnalysisMethod")) - modelContainer[["scree"]] <- scree - - if (!ready || modelContainer$getError()) return() - - n_col <- ncol(dataset) - - if (options[["screePlotParallelAnalysisResults"]]) { - - - if (any(options$variables.types %in% c("ordinal", "nominal")) && options[["baseDecompositionOn"]] == "polyTetrachoricCorrelationMatrix") { - varTypes <- options$variables.types - vars <- options$variables - scales <- vars[varTypes == "scale"] - ordinals <- vars[varTypes == "ordinal"] - nominals <- vars[varTypes == "nominal"] - polyTetraCor <- psych::mixedCor(dataset, c = scales, p = ordinals, d = nominals) - - parallelResult <- try(psych::fa.parallel(polyTetraCor$rho, - plot = FALSE, - fa = ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", - "pc", "fa"), - n.obs = nrow(dataset))) - } else { - parallelResult <- try(psych::fa.parallel(dataset, plot = FALSE, - fa = ifelse(options[["parallelAnalysisMethod"]] == "principalComponentBased", - "pc", "fa"))) - } - - if (isTryError(parallelResult)) { - errmsg <- gettextf("Screeplot not available. \nInternal error message: %s", .extractErrorMessage(parallelResult)) - scree$setError(errmsg) - # scree$setError(.decodeVarsInMessage(names(dataset), errmsg)) - return() - } - - if (options$componentCountMethod == "parallelAnalysis" && options$parallelAnalysisMethod == "factorBased") { - evs <- c(parallelResult$fa.values, parallelResult$fa.sim) - } else { # in all other cases we use the initial eigenvalues for the plot, aka the pca ones - evs <- c(parallelResult$pc.values, parallelResult$pc.sim) - } - tp <- rep(c(gettext("Data"), gettext("Simulated data from parallel analysis")), each = n_col) - - } else { # do not display parallel analysis - evs <- eigen(cor(dataset, use = "pairwise.complete.obs"), only.values = TRUE)$values - tp <- rep(gettext("Data"), each = n_col) - } - - df <- data.frame( - id = rep(seq_len(n_col), 2), - ev = evs, - type = tp - ) - # basic scree plot - plt <- - ggplot2::ggplot(df, ggplot2::aes(x = id, y = ev, linetype = type, shape = type)) + - ggplot2::geom_line(na.rm = TRUE) + - ggplot2::labs(x = gettext("Component"), y = gettext("Eigenvalue")) + - ggplot2::geom_hline(yintercept = options$eigenvaluesAbove) - - - # dynamic function for point size: - # the plot looks good with size 3 when there are 10 points (3 + log(10) - log(10) = 3) - # with more points, the size will become logarithmically smaller until a minimum of - # 3 + log(10) - log(200) = 0.004267726 - # with fewer points, they become bigger to a maximum of 3 + log(10) - log(2) = 4.609438 - pointsize <- 3 + log(10) - log(n_col) - if (pointsize > 0) { - plt <- plt + ggplot2::geom_point(na.rm = TRUE, size = max(0, 3 + log(10) - log(n_col))) - } - - # add axis lines and better breaks - plt <- plt + - jaspGraphs::geom_rangeframe() + - jaspGraphs::themeJaspRaw() + - ggplot2::scale_x_continuous(breaks = seq(1:n_col)) - - # theming with special legend thingy - plt <- plt + - jaspGraphs::themeJaspRaw() + - ggplot2::theme( - legend.position = c(0.99, 0.95), - legend.justification = c(1, 1), - legend.text = ggplot2::element_text(size = 12.5), - legend.title = ggplot2::element_blank(), - legend.key.size = ggplot2::unit(18, "pt") - ) - - scree$plotObject <- plt - modelContainer[["scree"]] <- scree -} - .pcaPathDiagram <- function(modelContainer, dataset, options, ready){ if (!options[["pathDiagram"]] || !is.null(modelContainer[["path"]])) return() diff --git a/R/principalcomponentanalysisWrapper.R b/R/principalcomponentanalysisWrapper.R index 4b2d9f48..1d6ac4f9 100644 --- a/R/principalcomponentanalysisWrapper.R +++ b/R/principalcomponentanalysisWrapper.R @@ -68,8 +68,6 @@ #' \item \code{"size"} #' \item \code{"variables"} #' } -#' @param parallelAnalysisTable, If this option is selected, a table will be generated exhibiting a detailed output of the parallel analysis. Can be based on principal component eigenvalues (PC) or factor eigenvalues (FA). The seed is taken from the parallel analysis for determining the number of components/factors above. -#' Defaults to \code{FALSE}. #' @param pathDiagram, By selecting this option, a visual representation of the direction and strength of the relation between the variable and factor will be displayed. #' Defaults to \code{FALSE}. #' @param residualMatrix, Displays a table containing the residual variances and correlations. @@ -79,10 +77,6 @@ #' \item \code{"oblique"}: This method produces components that allow for correlation between the components. This method is selected by default. Several possibilities are available. The default is promax. #' \item \code{"orthogonal"}: This method produces components that are uncorrelated. For this method, there are several possibilities that can be selected. #' } -#' @param screePlot, When selecting this option, a scree plot will be displayed. The scree plot provides information on how much variance in the data, indicated by the eigenvalue, is explained by each factor. A scree plot can be used to decide how many factors should be selected. -#' Defaults to \code{FALSE}. -#' @param screePlotParallelAnalysisResults, Display the results of the parallel analysis in the scree plot. The parallel analysis will be based on PC or FA as defined by the option for the parallel analysis table. -#' Defaults to \code{TRUE}. #' @param variables, In this box, the variables to perform the analysis on are selected principalComponentAnalysis <- function( data = NULL, @@ -93,9 +87,7 @@ principalComponentAnalysis <- function( bartlettTest = FALSE, baseDecompositionOn = "correlationMatrix", componentCorrelations = FALSE, - componentCountMethod = "parallelAnalysis", dataType = "raw", - eigenvaluesAbove = 1, factorStructure = FALSE, factoringMethod = "minimumResidual", fitIndices = FALSE, @@ -107,19 +99,12 @@ principalComponentAnalysis <- function( obliqueSelector = "promax", orderLoadingsBy = "size", orthogonalSelector = "none", - parallelAnalysisMethod = "principalComponentBased", - parallelAnalysisTable = FALSE, - parallelAnalysisTableMethod = "principalComponentBased", pathDiagram = FALSE, plotHeight = 320, plotWidth = 480, residualMatrix = FALSE, rotationMethod = "oblique", sampleSize = 200, - screePlot = FALSE, - screePlotParallelAnalysisResults = TRUE, - seed = 1, - setSeed = FALSE, variables = list(types = list(), value = list())) { defaultArgCalls <- formals(jaspFactor::principalComponentAnalysis) diff --git a/inst/Description.qml b/inst/Description.qml index 8fe3bb50..9b3e1c4d 100644 --- a/inst/Description.qml +++ b/inst/Description.qml @@ -8,6 +8,13 @@ Description description : qsTr("Explore hidden structure in the data") hasWrappers : true + Analysis + { + title: qsTr("Number of Factors/Components") + func: "numberOfFactors" + qml: "NumberOfFactors.qml" + } + Analysis { title: qsTr("Principal Component Analysis") diff --git a/inst/Upgrades.qml b/inst/Upgrades.qml index 153cc016..3e5db7ae 100644 --- a/inst/Upgrades.qml +++ b/inst/Upgrades.qml @@ -576,6 +576,77 @@ Upgrades } } } + + // Number-of-factors determination split into separate "Number of Factors/Components" analysis + Upgrade + { + functionName: "principalComponentAnalysis" + fromVersion: "0.97.1" + toVersion: "0.98.0" + + ChangeJS { + name: "manualNumberOfComponents" + condition: function(options) { return options["componentCountMethod"] !== undefined && options["componentCountMethod"] !== "manual" } + msg: qsTr("The number of components is now always specified manually. Parallel analysis and eigenvalue-based selection have moved to the separate 'Number of Factors/Components' analysis. Please set the number of components.") + jsFunction: function(options) { return options["manualNumberOfComponents"]; } + } + + ChangeRemove { name: "componentCountMethod"; condition: function(options) { return options["componentCountMethod"] !== undefined } } + ChangeRemove { name: "parallelAnalysisMethod"; condition: function(options) { return options["parallelAnalysisMethod"] !== undefined } } + ChangeRemove { name: "eigenvaluesAbove"; condition: function(options) { return options["eigenvaluesAbove"] !== undefined } } + ChangeRemove { + name: "parallelAnalysisTable" + condition: function(options) { return options["parallelAnalysisTable"] === true } + msg: qsTr("The parallel analysis table has moved to the 'Number of Factors/Components' analysis.") + } + ChangeRemove { name: "parallelAnalysisTable"; condition: function(options) { return options["parallelAnalysisTable"] !== undefined } } + ChangeRemove { name: "parallelAnalysisTableMethod"; condition: function(options) { return options["parallelAnalysisTableMethod"] !== undefined } } + ChangeRemove { + name: "screePlot" + condition: function(options) { return options["screePlot"] === true } + msg: qsTr("The scree plot has moved to the 'Number of Factors/Components' analysis.") + } + ChangeRemove { name: "screePlot"; condition: function(options) { return options["screePlot"] !== undefined } } + ChangeRemove { name: "screePlotParallelAnalysisResults"; condition: function(options) { return options["screePlotParallelAnalysisResults"] !== undefined } } + ChangeRemove { name: "setSeed"; condition: function(options) { return options["setSeed"] !== undefined } } + ChangeRemove { name: "seed"; condition: function(options) { return options["seed"] !== undefined } } + } + + // Number-of-factors determination split into separate "Number of Factors/Components" analysis + Upgrade + { + functionName: "exploratoryFactorAnalysis" + fromVersion: "0.97.1" + toVersion: "0.98.0" + + ChangeJS { + name: "manualNumberOfFactors" + condition: function(options) { return options["factorCountMethod"] !== undefined && options["factorCountMethod"] !== "manual" } + msg: qsTr("The number of factors is now always specified manually. Parallel analysis and eigenvalue-based selection have moved to the separate 'Number of Factors/Components' analysis. Please set the number of factors.") + jsFunction: function(options) { return options["manualNumberOfFactors"]; } + } + + ChangeRemove { name: "factorCountMethod"; condition: function(options) { return options["factorCountMethod"] !== undefined } } + ChangeRemove { name: "parallelAnalysisMethod"; condition: function(options) { return options["parallelAnalysisMethod"] !== undefined } } + ChangeRemove { name: "parallelAnalysisSeed"; condition: function(options) { return options["parallelAnalysisSeed"] !== undefined } } + ChangeRemove { name: "eigenvaluesAbove"; condition: function(options) { return options["eigenvaluesAbove"] !== undefined } } + ChangeRemove { + name: "parallelAnalysisTable" + condition: function(options) { return options["parallelAnalysisTable"] === true } + msg: qsTr("The parallel analysis table has moved to the 'Number of Factors/Components' analysis.") + } + ChangeRemove { name: "parallelAnalysisTable"; condition: function(options) { return options["parallelAnalysisTable"] !== undefined } } + ChangeRemove { name: "parallelAnalysisTableMethod"; condition: function(options) { return options["parallelAnalysisTableMethod"] !== undefined } } + ChangeRemove { + name: "screePlot" + condition: function(options) { return options["screePlot"] === true } + msg: qsTr("The scree plot has moved to the 'Number of Factors/Components' analysis.") + } + ChangeRemove { name: "screePlot"; condition: function(options) { return options["screePlot"] !== undefined } } + ChangeRemove { name: "screePlotParallelAnalysisResults"; condition: function(options) { return options["screePlotParallelAnalysisResults"] !== undefined } } + ChangeRemove { name: "setSeed"; condition: function(options) { return options["setSeed"] !== undefined } } + ChangeRemove { name: "seed"; condition: function(options) { return options["seed"] !== undefined } } + } } diff --git a/inst/qml/ExploratoryFactorAnalysis.qml b/inst/qml/ExploratoryFactorAnalysis.qml index b6483cb8..35223fc4 100644 --- a/inst/qml/ExploratoryFactorAnalysis.qml +++ b/inst/qml/ExploratoryFactorAnalysis.qml @@ -25,7 +25,6 @@ import "./common" as Common Form { - // Common.PcaEfaVariables{} VariablesForm { // property alias variables: variables @@ -57,9 +56,14 @@ Form } } - Common.PcaEfaNumberFactors{ - pca: false - variablesCount: variables.count + IntegerField + { + name: "manualNumberOfFactors" + label: qsTr("Number of factors") + defaultValue: 1 + min: 1 + max: variables.count > 1 ? variables.count : 1 + info: qsTr("The number of factors to extract. To determine this number, use the Number of Factors/Components analysis.") } Common.PcaEfaAnalysisOptions{ diff --git a/inst/qml/NumberOfFactors.qml b/inst/qml/NumberOfFactors.qml new file mode 100644 index 00000000..da2e19e9 --- /dev/null +++ b/inst/qml/NumberOfFactors.qml @@ -0,0 +1,166 @@ +// +// Copyright (C) 2013-2025 University of Amsterdam +// +// This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public +// License along with this program. If not, see +// . +// + +import QtQuick +import QtQuick.Layouts +import JASP +import JASP.Controls + +Form +{ + property bool nonScale: variables.count > 0 && (variables.columnsTypes.includes("ordinal") || variables.columnsTypes.includes("nominal")) + + VariablesForm + { + AvailableVariablesList { name: "allVariablesList" } + AssignedVariablesList + { + id: variables + name: "variables" + title: qsTr("Variables") + allowedColumns: ["scale", "ordinal", "nominal"] + allowTypeChange: true + info: qsTr("In this box, the variables to perform the analysis on are selected") + } + + RadioButtonGroup + { + name: "dataType" + title: qsTr("Data") + id: dataType + columns: 2 + info: qsTr("Specifies whether the data is raw, meaning observations in rows and variables in columns, or whether the data is a variance-covariance matrix. For the latter, the sample size is required.") + RadioButton { value: "raw"; label: qsTr("Raw"); checked: true } + RadioButton + { + value: "varianceCovariance"; label: qsTr("Variance-covariance matrix") + IntegerField { name: "sampleSize"; label: qsTr("Sample size"); defaultValue: 200 } + } + } + } + + Group + { + title: qsTr("Parallel Analysis") + info: qsTr("Parallel analysis compares the eigenvalues of the data to eigenvalues of simulated random data. Factors/components are suggested for retention when their eigenvalue is greater than the mean eigenvalue of the simulated data.") + + RadioButtonGroup + { + name: "parallelAnalysisMethod" + title: qsTr("Eigenvalues based on") + info: qsTr("Whether the parallel analysis is based on principal component eigenvalues (PC) or factor eigenvalues (FA). PC-based parallel analysis is a common choice also when the goal is to determine the number of factors for a factor analysis.") + + RadioButton + { + value: "principalComponentBased" + label: qsTr("Principal components") + checked: true + } + RadioButton + { + value: "factorBased" + label: qsTr("Factors") + } + } + + SetSeed{} + } + + Group + { + title: qsTr("Eigenvalue Criterion") + DoubleField + { + name: "eigenvaluesAbove" + label: qsTr("Eigenvalues above") + defaultValue: 1 + decimals: 1 + info: qsTr("Threshold for the eigenvalue criterion: factors/components with an eigenvalue above this value are suggested for retention. The default of 1 corresponds to the Kaiser criterion. The eigenvalue type (principal component or factor eigenvalues) follows the parallel analysis method selected above.") + } + } + + RadioButtonGroup + { + name: "baseDecompositionOn" + title: qsTr("Base Analysis on") + info: qsTr("What type of correlation matrix to base the analysis on.") + RadioButton + { + value: "correlationMatrix" + label: qsTr("Correlation matrix") + info: qsTr("The Pearson correlation matrix is used.") + checked: !nonScale + } + RadioButton + { + enabled: dataType.value == "raw" && nonScale + value: "polyTetrachoricCorrelationMatrix" + label: qsTr("Polychoric/tetrachoric correlation matrix") + info: qsTr("The polychoric/tetrachoric correlation matrix is used. This is sometimes unstable when sample size is small and when some variables do not contain all response categories") + checked: nonScale + } + } + + Group + { + title: qsTr("Output") + CheckBox + { + name: "parallelAnalysisTable" + label: qsTr("Parallel analysis table") + checked: true + info: qsTr("Displays a table with the real data eigenvalues and the mean eigenvalues of the simulated data. Factors/components suggested for retention are marked with an asterisk.") + } + CheckBox + { + name: "screePlot" + label: qsTr("Scree plot") + checked: true + info: qsTr("Displays a scree plot. The scree plot provides information on how much variance in the data, indicated by the eigenvalue, is explained by each factor/component. The horizontal line marks the eigenvalue threshold.") + + CheckBox + { + name: "screePlotParallelAnalysisResults" + label: qsTr("Parallel analysis results") + checked: true + info: qsTr("Display the mean eigenvalues of the simulated data from the parallel analysis in the scree plot.") + } + } + } + + RadioButtonGroup + { + name: "naAction" + title: qsTr("Missing Values") + info: qsTr("Select how to handle missing values.") + RadioButton + { + value: "pairwise"; + label: qsTr("Exclude cases pairwise"); + checked: true; + info: qsTr("If one observation from a variable is missing, all the other variable observations from the same case will still be used for the analysis. In this scenario, it is not necessary to have an observation for all the variables to include the case in the analysis. This option is selected by default.") + } + RadioButton + { + value: "listwise"; + label: qsTr("Exclude cases listwise") + info: qsTr("If one observation from a variable is missing, the whole case, so all the other connected variable observations, will be dismissed from the analysis. In this scenario, observations for every variable are needed to include the case in the analysis. ") + } + } + +} diff --git a/inst/qml/PrincipalComponentAnalysis.qml b/inst/qml/PrincipalComponentAnalysis.qml index 7b648895..28dd9240 100644 --- a/inst/qml/PrincipalComponentAnalysis.qml +++ b/inst/qml/PrincipalComponentAnalysis.qml @@ -25,7 +25,6 @@ import "./common" as Common Form { - // Common.PcaEfaVariables{} VariablesForm { // property alias variables: variables @@ -57,9 +56,14 @@ Form } } - Common.PcaEfaNumberFactors{ - pca: true - variablesCount: variables.count + IntegerField + { + name: "manualNumberOfComponents" + label: qsTr("Number of components") + defaultValue: 1 + min: 1 + max: variables.count > 1 ? variables.count : 1 + info: qsTr("The number of components to extract. To determine this number, use the Number of Factors/Components analysis.") } Common.PcaEfaAnalysisOptions{ diff --git a/inst/qml/common/PcaEfaNumberFactors.qml b/inst/qml/common/PcaEfaNumberFactors.qml deleted file mode 100755 index 259ad7ba..00000000 --- a/inst/qml/common/PcaEfaNumberFactors.qml +++ /dev/null @@ -1,94 +0,0 @@ -// -// Copyright (C) 2013-2018 University of Amsterdam -// -// This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU Affero General Public License as -// published by the Free Software Foundation, either version 3 of the -// License, or (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU Affero General Public License for more details. -// -// You should have received a copy of the GNU Affero General Public -// License along with this program. If not, see -// . -// - -import QtQuick -import QtQuick.Layouts -import JASP -import JASP.Controls - -Section -{ - property bool pca: true - property int variablesCount: 1 - - id: numberof - title: pca ? qsTr("Number of Components") : qsTr("Number of Factors") - expanded: true - info: qsTr("Here, the number of components/factors that are used in the analysis is determined. Several methods to determine this number can be chosen from:") - - RadioButtonGroup - { - name: pca ? "componentCountMethod" : "factorCountMethod" - title: pca ? qsTr("Based on") : qsTr("Based on") - RadioButton - { - value: "parallelAnalysis"; - label: qsTr("Parallel analysis"); - checked: true - info: qsTr("Components/factors are selected on the basis of parallel analysis. With this method, factors are selected when their eigenvalue is greater than the parallel average random eigenvalue. This method is selected by default. Can be based on principal component eigenvalues (PC) or factor eigenvalues (FA). A seed (1234) is chosen by default so that the results from the parallel analysis are equal across the PCA") - - RadioButtonGroup - { - name: "parallelAnalysisMethod" - title: "" - - RadioButton - { - value: "principalComponentBased" - label: qsTr("Based on PC") - checked: true - } - RadioButton - { - value: "factorBased" - label: qsTr("Based on FA") - } - } - - SetSeed{} - - } - RadioButton - { - value: "eigenvalues" - label: qsTr("Eigenvalues") - info: qsTr("Components are selected when they have a certain eigenvalue. By default components are selected that have an eigenvalue above 1.") - DoubleField { - name: "eigenvaluesAbove" - label: qsTr("Eigenvalues above") - defaultValue: 1 - decimals: 1 - } - } - RadioButton - { - value: "manual" - label: qsTr("Manual") - info: qsTr("The number of components can be specified manually. By default this is set to 1.") - IntegerField { - name: pca ? "manualNumberOfComponents" : "manualNumberOfFactors" - label: pca? qsTr("Number of components") : qsTr("Number of factors") - defaultValue: 1 - min: 1 - max: variablesCount > 1 ? variablesCount : 1 - - } - } - } - -} \ No newline at end of file diff --git a/inst/qml/common/PcaEfaOutputOptions.qml b/inst/qml/common/PcaEfaOutputOptions.qml index c7055ab0..e29a5ab0 100755 --- a/inst/qml/common/PcaEfaOutputOptions.qml +++ b/inst/qml/common/PcaEfaOutputOptions.qml @@ -64,28 +64,6 @@ Section info: qsTr("This option displays the Root Mean Squared Error of Approximation (RMSEA) with 90% confidence interval, the Tucker Lewis Index (TLI), and the Bayesian Information Criterion (BIC) to test the fit of the model.") } CheckBox { name: "residualMatrix"; label: qsTr("Residual matrix"); info: qsTr("Displays a table containing the residual variances and correlations.")} - CheckBox { - name: "parallelAnalysisTable"; - label: qsTr("Parallel analysis") - info: qsTr("If this option is selected, a table will be generated exhibiting a detailed output of the parallel analysis. Can be based on principal component eigenvalues (PC) or factor eigenvalues (FA). The seed is taken from the parallel analysis for determining the number of components/factors above.") - RadioButtonGroup - { - name: "parallelAnalysisTableMethod" - title: "" - - RadioButton - { - value: "principalComponentBased" - label: qsTr("Based on PC") - checked: true - } - RadioButton - { - value: "factorBased" - label: qsTr("Based on FA") - } - } - } } Group { @@ -96,18 +74,6 @@ Section label: qsTr("Path diagram") info: qsTr("By selecting this option, a visual representation of the direction and strength of the relation between the variable and factor will be displayed.") } - CheckBox { - name: "screePlot"; - label: qsTr("Scree plot") - info: qsTr("When selecting this option, a scree plot will be displayed. The scree plot provides information on how much variance in the data, indicated by the eigenvalue, is explained by each factor. A scree plot can be used to decide how many factors should be selected.") - - CheckBox { - name: "screePlotParallelAnalysisResults" - label: qsTr("Parallel analysis results") - checked: true - info: qsTr("Display the results of the parallel analysis in the scree plot. The parallel analysis will be based on PC or FA as defined by the option for the parallel analysis table.") - } - } } Group diff --git a/inst/qml/common/PcaEfaVariables.qml b/inst/qml/common/PcaEfaVariables.qml deleted file mode 100755 index 50bde334..00000000 --- a/inst/qml/common/PcaEfaVariables.qml +++ /dev/null @@ -1,53 +0,0 @@ -// -// Copyright (C) 2013-2018 University of Amsterdam -// -// This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU Affero General Public License as -// published by the Free Software Foundation, either version 3 of the -// License, or (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU Affero General Public License for more details. -// -// You should have received a copy of the GNU Affero General Public -// License along with this program. If not, see -// . -// - -import QtQuick -import QtQuick.Layouts -import JASP -import JASP.Controls - -VariablesForm -{ - property alias variables: variables - - AvailableVariablesList { name: "allVariablesList" } - AssignedVariablesList - { - id: variables - name: "variables" - title: qsTr("Variables") - allowedColumns: ["scale", "ordinal", "nominal"] - allowTypeChange: true - info: qsTr("In this box, the variables to perform the analysis on are selected") - } - - RadioButtonGroup - { - name: "dataType" - title: qsTr("Data Type") - id: dataType - columns: 2 - info: qsTr("Specifies whether the data is raw, meaning observations in rows and variables in columns, or whether the data is a variance-covariance matrix. For the latter, the sample size is required.") - RadioButton { value: "raw"; label: qsTr("Raw"); checked: true } - RadioButton - { - value: "varianceCovariance"; label: qsTr("Variance-covariance matrix") - IntegerField { name: "sampleSize"; label: qsTr("Sample size"); defaultValue: 200 } - } - } -} \ No newline at end of file diff --git a/tests/testthat/_snaps/library-G Factor/analysis-2-figure-2-scree-plot.svg b/tests/testthat/_snaps/library-G Factor/analysis-2-figure-2-scree-plot.svg deleted file mode 100644 index 2894d4fe..00000000 --- a/tests/testthat/_snaps/library-G Factor/analysis-2-figure-2-scree-plot.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -Factor -Eigenvalue - - - - - - - - -Data -Simulated data from parallel analysis -analysis-2_figure-2_scree-plot - - diff --git a/tests/testthat/_snaps/library-G Factor/analysis-3-figure-1-scree-plot.svg b/tests/testthat/_snaps/library-G Factor/analysis-3-figure-1-scree-plot.svg deleted file mode 100644 index 4c11921b..00000000 --- a/tests/testthat/_snaps/library-G Factor/analysis-3-figure-1-scree-plot.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -Component -Eigenvalue - - - - - - - - -Data -Simulated data from parallel analysis -analysis-3_figure-1_scree-plot - - diff --git a/tests/testthat/_snaps/library-G Factor/reference_plotobject/analysis-2-figure-2-scree-plot.rds b/tests/testthat/_snaps/library-G Factor/reference_plotobject/analysis-2-figure-2-scree-plot.rds deleted file mode 100644 index 7a1a402d..00000000 Binary files a/tests/testthat/_snaps/library-G Factor/reference_plotobject/analysis-2-figure-2-scree-plot.rds and /dev/null differ diff --git a/tests/testthat/_snaps/library-G Factor/reference_plotobject/analysis-3-figure-1-scree-plot.rds b/tests/testthat/_snaps/library-G Factor/reference_plotobject/analysis-3-figure-1-scree-plot.rds deleted file mode 100644 index 0e271332..00000000 Binary files a/tests/testthat/_snaps/library-G Factor/reference_plotobject/analysis-3-figure-1-scree-plot.rds and /dev/null differ diff --git a/tests/testthat/_snaps/numberoffactors/reference_plotobject/scree-plot-pc.rds b/tests/testthat/_snaps/numberoffactors/reference_plotobject/scree-plot-pc.rds new file mode 100644 index 00000000..2f4bdfd4 Binary files /dev/null and b/tests/testthat/_snaps/numberoffactors/reference_plotobject/scree-plot-pc.rds differ diff --git a/tests/testthat/_snaps/numberoffactors/scree-plot-pc.svg b/tests/testthat/_snaps/numberoffactors/scree-plot-pc.svg new file mode 100644 index 00000000..e0f2e3ad --- /dev/null +++ b/tests/testthat/_snaps/numberoffactors/scree-plot-pc.svg @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.5 +1.0 +1.5 + + + + + + + + + + +1 +2 +3 +4 +5 +6 +Component +Eigenvalue + + + + + + + + +Data +Simulated data from parallel analysis +scree-plot-pc + + diff --git a/tests/testthat/test-exploratoryfactoranalysis.R b/tests/testthat/test-exploratoryfactoranalysis.R index 0b794d74..968e1f56 100644 --- a/tests/testthat/test-exploratoryfactoranalysis.R +++ b/tests/testthat/test-exploratoryfactoranalysis.R @@ -3,13 +3,10 @@ context("Exploratory Factor Analysis") # does not test # - error handling # - orthogonal rotation -# - Eigen values above / manual -# - contents of screeplot (set.seed does not work) defaultOptions <- list( variables = list(), sampleSize = 200, - eigenvaluesAbove = 1, manualNumberOfFactors = 1, factoringMethod = "minimumResidual", orthogonalSelector = "none", @@ -19,38 +16,28 @@ defaultOptions <- list( factorCorrelations = FALSE, fitIndices = FALSE, residualMatrix = FALSE, - parallelAnalysisTable = FALSE, pathDiagram = FALSE, - screePlot = FALSE, antiImageCorrelationMatrix = FALSE, - screePlotParallelAnalysisResults = TRUE, kaiserMeyerOlkinTest = FALSE, bartlettTest = FALSE, mardiaTest = FALSE, addScoresToData = FALSE, addScoresToDataPrefix = "", dataType = "raw", - factorCountMethod = "parallelAnalysis", - parallelAnalysisMethod = "principalComponentBased", rotationMethod = "orthogonal", baseDecompositionOn = "correlationMatrix", orderLoadingsBy = "variables", - parallelAnalysisTableMethod = "principalComponentBased", naAction = "pairwise", plotWidth = 480, - plotHeight = 320, - setSeed = FALSE, - seed = 1 + plotHeight = 320 ) options <- defaultOptions -options$factorCountMethod <- "manual" options$factoringMethod <- "minimumResidual" options$loadingsDisplayLimit <- 0.4 options$factorCorrelations <- TRUE options$fitIndices <- TRUE options$pathDiagram <- TRUE -options$screePlot <- TRUE options$factorStructure <- TRUE options$residualMatrix <- TRUE options$manualNumberOfFactors <- 2 @@ -128,13 +115,6 @@ test_that("Path Diagram plot matches", { jaspTools::expect_equal_plots(testPlot, "path-diagram") }) -test_that("Scree plot matches", { - skip("Scree plot check does not work because some data is simulated (non-deterministic).") - plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_scree"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "scree-plot") -}) - test_that("Factor Loadings (Structure Matrix) table results match", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_structureTable"]][["data"]] jaspTools::expect_equal_tables(table, @@ -166,6 +146,7 @@ options$orderLoadingsBy <- "variables" test_that("orderLoadingsBy sort the factor loadings table", { options <- defaultOptions + options$manualNumberOfFactors <- 3 # as previously suggested by parallel analysis options$orthogonalSelector <- "varimax" options$loadingsDisplayLimit <- 0.2 options$variables <- paste0("x", 1:9) @@ -225,13 +206,12 @@ test_that("Estimation options do not crash", { }) +# 3 factors as previously suggested by PC-based parallel analysis options <- defaultOptions -options$factorCountMethod <- "parallelAnalysis" -options$parallelAnalysisMethod <- "principalComponentBased" +options$manualNumberOfFactors <- 3 options$factoringMethod <- "minimumResidual" options$loadingsDisplayLimit <- 0.1 options$factorCorrelations <- TRUE -options$screePlot <- TRUE options$orthogonalSelector <- "none" options$rotationMethod <- "orthogonal" options$variables <- paste0("x", 1:9) @@ -247,14 +227,14 @@ test_that("Factor Characteristics table results match", { )) }) -test_that("Chi-squared Test table results match with parallel analysis based on PCs", { +test_that("Chi-squared Test table results match with 3 factors", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_goodnessOfFitTable"]][["data"]] jaspTools::expect_equal_tables(table, list(22.5550491736693, 12, "Model", 0.0317499059313278)) }) -test_that("Factor Loadings table results match with parallel analysis based on PCs", { +test_that("Factor Loadings table results match with 3 factors", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_loadingsTable"]][["data"]] jaspTools::expect_equal_tables(table, @@ -271,23 +251,14 @@ test_that("Factor Loadings table results match with parallel analysis based on P 0.453220919172841, "", 0.539538616482753, "x9")) }) -test_that("Scree plot matches", { - skip("Scree plot check does not work because some data is simulated (non-deterministic).") - plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_scree"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "scree-plot") -}) - - +# 2 factors as previously suggested by PC-based parallel analysis options <- defaultOptions -options$factorCountMethod <- "parallelAnalysis" -options$parallelAnalysisMethod <- "principalComponentBased" +options$manualNumberOfFactors <- 2 options$loadingsDisplayLimit <- 0.1 options$baseDecompositionOn <- "polyTetrachoricCorrelationMatrix" options$mardiaTest <- TRUE options$kaiserMeyerOlkinTest <- TRUE options$antiImageCorrelationMatrix <- TRUE -options$parallelAnalysisTable <- TRUE options$rotationMethod <- "oblique" options$factoringMethod <- "minimumResidual" options$variables <- c("contcor1", "contcor2", "facFifty", "facFive","contNormal", "debMiss1") @@ -315,16 +286,6 @@ test_that("Mardia's Test of Multivariate Normality table results match with poly )) }) -test_that("Parallel Analysis table results match with poly cor", { - table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parallelTable"]][["data"]] - jaspTools::expect_equal_tables(table, - list("Factor 1*", 1.78311572348898, 1.34293486623467, "Factor 2*", - 1.28924116893078, 1.18287911279811, "Factor 3*", 1.08833059622023, - 1.05066617046688, "Factor 4", 0.845932695389084, 0.925279735884113, - "Factor 5", 0.688011322780564, 0.809825771393728, "Factor 6", - 0.305368493190363, 0.688414343222493)) -}) - # might have to change this once psych is updated on CRAN so the diagonals are replced with MSA values test_that("Anti-Image Correlation Matrix table results match", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_antiMatrix"]][["data"]] @@ -348,28 +309,6 @@ test_that("Kaiser-Meyer-Olkin Test table results match", { }) -options <- defaultOptions -options$factorCountMethod <- "parallelAnalysis" -options$parallelAnalysisMethod <- "principalComponentBased" -options$parallelAnalysisTable <- TRUE -options$rotationMethod <- "oblique" -options$variables <- c("contcor1", "contcor2", "facFifty", "facFive","contNormal", "debMiss1") - -options("mc.cores" = 1L) -set.seed(1) -results <- runAnalysis("exploratoryFactorAnalysis", "test.csv", options, makeTests = F) - -test_that("Parallel Analysis table results match", { - table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parallelTable"]][["data"]] - jaspTools::expect_equal_tables(table, - list("Factor 1*", 1.7795916550878, 1.33053625507377, "Factor 2*", 1.28644706023115, - 1.17402737320915, "Factor 3*", 1.08333785331839, 1.0367445878489, - "Factor 4", 0.848949206589453, 0.923477592629848, "Factor 5", - 0.696170865182367, 0.837720518530386, "Factor 6", 0.305503359590833, - 0.697493672707948)) -}) - - # variance covariance matrix input # this test fails because the columnIndexInData function does not play well with jaspTools dt <- read.csv(testthat::test_path("holzingerswineford.csv")) @@ -380,9 +319,7 @@ options <- list( baseDecompositionOn = "correlationMatrix", bartlettTest = FALSE, dataType = "varianceCovariance", - eigenvaluesAbove = 1, factorCorrelations = FALSE, - factorCountMethod = "manual", orderLoadingsBy = "variables", factorStructure = FALSE, factoringMethod = "minimumResidual", @@ -394,19 +331,13 @@ options <- list( naAction = "pairwise", obliqueSelector = "promax", orthogonalSelector = "none", - parallelAnalysisMethod = "principalComponentBased", - parallelAnalysisSeed = 1234, - parallelAnalysisTable = FALSE, - parallelAnalysisTableMethod = "principalComponentBased", pathDiagram = FALSE, plotHeight = 320, plotWidth = 480, residualMatrix = FALSE, rotationMethod = "orthogonal", sampleSize = 200, - screePlot = FALSE, antiImageCorrelationMatrix = FALSE, - screePlotParallelAnalysisResults = TRUE, variables = c("x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9") ) diff --git a/tests/testthat/test-library-G Factor.R b/tests/testthat/test-library-G Factor.R index 097b5a28..4b6ab5a0 100644 --- a/tests/testthat/test-library-G Factor.R +++ b/tests/testthat/test-library-G Factor.R @@ -42,10 +42,6 @@ test_that("exploratoryFactorAnalysis (analysis 2) results match", { testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] jaspTools::expect_equal_plots(testPlot, "analysis-2_figure-1_path-diagram") - plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_scree"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "analysis-2_figure-2_scree-plot") - }) test_that("principalComponentAnalysis (analysis 3) results match", { @@ -78,9 +74,5 @@ test_that("principalComponentAnalysis (analysis 3) results match", { 0.914733939122977, "jaspColumn2", 0.223865710905652, 0.949884143480707, "jaspColumn3")) - plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_scree"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "analysis-3_figure-1_scree-plot") - }) diff --git a/tests/testthat/test-numberoffactors.R b/tests/testthat/test-numberoffactors.R new file mode 100644 index 00000000..f70ce096 --- /dev/null +++ b/tests/testthat/test-numberoffactors.R @@ -0,0 +1,114 @@ +context("Number of Factors/Components") + +# NOTE on expected values: +# The parallel analysis tests were moved here from the pre-split EFA/PCA tests. +# There, fa.parallel ran multiple times per analysis (different RNG path) with +# the session seed; here it runs once with setSeed = TRUE. Real-data eigenvalues +# (val1) are unchanged; simulated-data values (val2) and the parallel analysis +# suggestion were regenerated. + +defaultOptions <- list( + variables = list(), + dataType = "raw", + sampleSize = 200, + parallelAnalysisMethod = "principalComponentBased", + eigenvaluesAbove = 1, + baseDecompositionOn = "correlationMatrix", + parallelAnalysisTable = TRUE, + screePlot = TRUE, + screePlotParallelAnalysisResults = TRUE, + naAction = "pairwise", + plotWidth = 480, + plotHeight = 320, + setSeed = TRUE, + seed = 1 +) + + +# PC-based parallel analysis on Pearson correlations +options <- defaultOptions +options$variables <- c("contcor1", "contcor2", "facFifty", "facFive", "contNormal", "debMiss1") + +results <- jaspTools::runAnalysis("numberOfFactors", "test.csv", options, makeTests = F) + +test_that("Summary table results match (PC-based)", { + table <- results[["results"]][["nofContainer"]][["collection"]][["nofContainer_summaryTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Parallel analysis (PC-based)", 2, + "Eigenvalues above 1", 3)) +}) + +test_that("Parallel Analysis table results match (PC-based)", { + table <- results[["results"]][["nofContainer"]][["collection"]][["nofContainer_parallelTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Component 1*", 1.7795916550878, 1.36583483001393, "Component 2*", + 1.28644706023115, 1.1795441336838, "Component 3*", 1.08333785331839, + 1.04563430924183, "Component 4", 0.848949206589453, 0.92484523771976, + "Component 5", 0.696170865182367, 0.805435846758642, "Component 6", + 0.305503359590833, 0.678705642582045)) +}) + +test_that("Scree plot matches (PC-based)", { + plotName <- results[["results"]][["nofContainer"]][["collection"]][["nofContainer_screePlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "scree-plot-pc") +}) + + +# FA-based parallel analysis +options <- defaultOptions +options$parallelAnalysisMethod <- "factorBased" +options$variables <- c("contcor1", "contcor2", "facFifty", "facFive", "contNormal", "debMiss1") + +results <- jaspTools::runAnalysis("numberOfFactors", "test.csv", options, makeTests = F) + +test_that("Summary and Parallel Analysis tables use FA basis", { + summaryData <- results[["results"]][["nofContainer"]][["collection"]][["nofContainer_summaryTable"]][["data"]] + testthat::expect_length(summaryData, 2L) + testthat::expect_true(grepl("FA-based", summaryData[[1]][["method"]])) + + parallelData <- results[["results"]][["nofContainer"]][["collection"]][["nofContainer_parallelTable"]][["data"]] + testthat::expect_length(parallelData, 6L) + testthat::expect_true(all(grepl("^Factor", sapply(parallelData, `[[`, "col")))) +}) + + +# PC-based parallel analysis on polychoric/tetrachoric correlations +options <- defaultOptions +options$variables <- c("contcor1", "contcor2", "facFifty", "facFive", "contNormal", "debMiss1") +options$variables.types <- list("scale", "scale", "scale", "ordinal", "scale", "scale") +options$baseDecompositionOn <- "polyTetrachoricCorrelationMatrix" + +results <- jaspTools::runAnalysis("numberOfFactors", "test.csv", options, makeTests = F) + +test_that("Parallel Analysis table results match with poly cor", { + table <- results[["results"]][["nofContainer"]][["collection"]][["nofContainer_parallelTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Component 1*", 1.78311572348898, 1.33849952828362, "Component 2*", + 1.28924116893078, 1.19495601423762, "Component 3*", 1.08833059622023, + 1.03657350841346, "Component 4", 0.845932695389084, 0.919703170460585, + "Component 5", 0.688011322780564, 0.817254742438021, "Component 6", + 0.305368493190363, 0.693013036166699)) +}) + + +# eigenvalue threshold affects only the summary table +options <- defaultOptions +options$variables <- c("contcor1", "contcor2", "facFifty", "facFive", "contNormal", "debMiss1") +options$eigenvaluesAbove <- 0.8 + +results <- jaspTools::runAnalysis("numberOfFactors", "test.csv", options, makeTests = F) + +test_that("Eigenvalue criterion respects the threshold", { + table <- results[["results"]][["nofContainer"]][["collection"]][["nofContainer_summaryTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Parallel analysis (PC-based)", 2, + "Eigenvalues above 0.8", 4)) +}) + + +test_that("Analysis does not crash without variables", { + options <- defaultOptions + results <- jaspTools::runAnalysis("numberOfFactors", "test.csv", options) + testthat::expect_identical(results[["status"]], "complete") +}) diff --git a/tests/testthat/test-principalcomponentanalysis.R b/tests/testthat/test-principalcomponentanalysis.R index abdff5ed..f6dc482e 100644 --- a/tests/testthat/test-principalcomponentanalysis.R +++ b/tests/testthat/test-principalcomponentanalysis.R @@ -7,17 +7,13 @@ context("Principal Component Analysis") defaultOptions <- list( variables = list(), sampleSize = 200, - eigenvaluesAbove = 1, manualNumberOfComponents = 1, orthogonalSelector = "none", obliqueSelector = "promax", loadingsDisplayLimit = 0, componentCorrelations = FALSE, residualMatrix = FALSE, - parallelAnalysisTable = FALSE, pathDiagram = FALSE, - screePlot = FALSE, - screePlotParallelAnalysisResults = TRUE, kaiserMeyerOlkinTest = FALSE, bartlettTest = FALSE, mardiaTest = FALSE, @@ -25,27 +21,21 @@ defaultOptions <- list( antiImageCorrelationMatrix = FALSE, addScoresToDataPrefix = "", dataType = "raw", - componentCountMethod = "parallelAnalysis", - parallelAnalysisMethod = "principalComponentBased", rotationMethod = "orthogonal", baseDecompositionOn = "correlationMatrix", orderLoadingsBy = "variables", - parallelAnalysisTableMethod = "principalComponentBased", naAction = "pairwise", plotWidth = 480, - plotHeight = 320, - setSeed = FALSE, - seed = 1 + plotHeight = 320 ) +# 2 components as previously suggested by eigenvalues above 0.95 options <- defaultOptions options$variables <- c("contNormal", "contGamma", "debCollin1", "contcor1", "facFifty") -options$eigenvaluesAbove <- 0.95 +options$manualNumberOfComponents <- 2 options$orthogonalSelector <- "varimax" options$pathDiagram <- TRUE -options$screePlot <- TRUE options$residualMatrix <- TRUE -options$componentCountMethod <- "eigenvalues" set.seed(1) results <- jaspTools::runAnalysis("principalComponentAnalysis", "test.csv", options) @@ -99,21 +89,14 @@ test_that("Path Diagram plot matches", { jaspTools::expect_equal_plots(testPlot, "path-diagram") }) -test_that("Scree plot matches", { - skip("Scree plot check does not work because some data is simulated (non-deterministic).") - plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_scree"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "scree-plot") -}) - - rotationOptions <- list( "orthogonal" = c("none", "varimax", "quartimax", "bentlerT", "equamax", "geominT"), "oblique" = c("promax", "oblimin", "simplimax", "bentlerQ", "biquartimin", "cluster", "geominQ") ) +# 5 components as previously suggested by eigenvalues above 1 options <- defaultOptions -options$componentCountMethod <- "eigenvalues" +options$manualNumberOfComponents <- 5 options$variables <- c("contNormal", "contGamma", "contExpon", "contWide", "contNarrow", "contOutlier", "contcor1", "contcor2", "debMiss1", "debCollin1") jaspTableToRTable <- function(x) do.call(rbind, lapply(x, do.call, what = cbind.data.frame)) @@ -290,7 +273,6 @@ test_that("rotation methods match", { options <- defaultOptions options$variables <- c("contNormal", "contGamma", "contcor1", "contcor2") options$orthogonalSelector <- "varimax" -options$componentCountMethod <- "manual" options$baseDecompositionOn <- "covarianceMatrix" set.seed(1) results <- runAnalysis("principalComponentAnalysis", "test.csv", options) @@ -320,14 +302,12 @@ test_that("Component Loadings table results match", { # results for PCA based on mixed matrix (poly or tetrachoric) +# 1 component as previously suggested by parallel analysis options <- defaultOptions options$variables <- c("contNormal", "contGamma", "debCollin1", "contcor1", "facFive") options$variables.types <- list("scale", "scale", "scale", "scale", "ordinal") -options$eigenvaluesAbove <- 0.95 +options$manualNumberOfComponents <- 1 options$orthogonalSelector <- "varimax" -options$componentCountMethod <- "parallelAnalysis" -options$parallelAnalysisTable <- TRUE -options$parallelAnalysisSeed <- 1234 options$baseDecompositionOn <- "polyTetrachoricCorrelationMatrix" set.seed(1) results <- jaspTools::runAnalysis("principalComponentAnalysis", "test.csv", options) @@ -355,28 +335,6 @@ test_that("Component Loadings table results match for mixed based", { }) -options <- defaultOptions -options$componentCountMethod <- "parallelAnalysis" -options$parallelAnalysisMethod <- "principalComponentBased" -options$parallelAnalysisTable <- TRUE -options$rotationMethod <- "oblique" -options$variables <- c("contcor1", "contcor2", "facFifty", "facFive","contNormal", "debMiss1") - -options("mc.cores" = 1L) -set.seed(1) -results <- runAnalysis("principalComponentAnalysis", "test.csv", options, makeTests = F) - -test_that("Parallel Analysis table results match", { - table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parallelTable"]][["data"]] - jaspTools::expect_equal_tables(table, - list("Component 1*", 1.7795916550878, 1.33053625507377, "Component 2*", - 1.28644706023115, 1.17402737320915, "Component 3*", 1.08333785331839, - 1.0367445878489, "Component 4", 0.848949206589453, 0.923477592629848, - "Component 5", 0.696170865182367, 0.837720518530386, "Component 6", - 0.305503359590833, 0.697493672707948)) -}) - - # variance covariance matrix input # this test fails because columnIndexInData does not play nice with jaspTools dt <- read.csv(testthat::test_path("holzingerswineford.csv")) @@ -387,10 +345,8 @@ options <- list( baseDecompositionOn = "correlationMatrix", bartlettTest = FALSE, componentCorrelations = FALSE, - componentCountMethod = "manual", orderLoadingsBy = "variables", dataType = "varianceCovariance", - eigenvaluesAbove = 1, kaiserMeyerOlkinTest = FALSE, loadingsDisplayLimit = 0.1, manualNumberOfComponents = 1, @@ -398,19 +354,13 @@ options <- list( naAction = "pairwise", obliqueSelector = "promax", orthogonalSelector = "none", - parallelAnalysisMethod = "principalComponentBased", - parallelAnalysisSeed = 1234, - parallelAnalysisTable = FALSE, antiImageCorrelationMatrix = FALSE, - parallelAnalysisTableMethod = "principalComponentBased", pathDiagram = FALSE, plotHeight = 320, plotWidth = 480, residualMatrix = FALSE, rotationMethod = "orthogonal", sampleSize = 200, - screePlot = FALSE, - screePlotParallelAnalysisResults = TRUE, variables = c("x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9") ) diff --git a/tests/testthat/test-verified-exploratoryfactoranalysis.R b/tests/testthat/test-verified-exploratoryfactoranalysis.R index 4dbf20da..ef851394 100644 --- a/tests/testthat/test-verified-exploratoryfactoranalysis.R +++ b/tests/testthat/test-verified-exploratoryfactoranalysis.R @@ -3,14 +3,11 @@ context("Exploratory Factor Analysis -- Verification project") # does not test # - error handling # - orthogonal rotation -# - Eigen values above / manual -# - contents of screeplot (set.seed does not work) ## Testing Questionnaire data defaultOptions <- list( variables = list(), sampleSize = 200, - eigenvaluesAbove = 1, manualNumberOfFactors = 1, factoringMethod = "minimumResidual", orthogonalSelector = "none", @@ -20,10 +17,7 @@ defaultOptions <- list( factorCorrelations = FALSE, fitIndices = FALSE, residualMatrix = FALSE, - parallelAnalysisTable = FALSE, pathDiagram = FALSE, - screePlot = FALSE, - screePlotParallelAnalysisResults = TRUE, antiImageCorrelationMatrix = FALSE, kaiserMeyerOlkinTest = FALSE, bartlettTest = FALSE, @@ -31,25 +25,18 @@ defaultOptions <- list( addScoresToData = FALSE, addScoresToDataPrefix = "", dataType = "raw", - factorCountMethod = "parallelAnalysis", - parallelAnalysisMethod = "principalComponentBased", rotationMethod = "orthogonal", baseDecompositionOn = "correlationMatrix", orderLoadingsBy = "variables", - parallelAnalysisTableMethod = "principalComponentBased", naAction = "pairwise", plotWidth = 480, - plotHeight = 320, - setSeed = FALSE, - seed = 1 + plotHeight = 320 ) options <- defaultOptions -options$factorCountMethod <- "manual" options$rotationMethod <- "orthogonal" options$orthogonalSelector <- "varimax" options$kaiserMeyerOlkinTest <- TRUE options$bartlettTest <- TRUE -options$screePlot <- TRUE options$variables <- c(paste("Question", 1:9, sep="_0"), paste("Question", 10:23, sep="_")) options$manualNumberOfFactors <- 4 options$factoringMethod <- "principalAxis" @@ -150,21 +137,12 @@ test_that("Factor Characteristics table results match", { }) -# test_that("Scree plot matches", { -# skip("Scree plot check does not work because some data is simulated (non-deterministic).") -# # plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_scree"]][["data"]] -# # testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] -# # jaspTools::expect_equal_plots(testPlot, "scree-plot") -# }) - options <- defaultOptions -options$factorCountMethod <- "manual" options$factoringMethod <- "minimumResidual" options$loadingsDisplayLimit <- 0.4 options$factorCorrelations <- TRUE options$fitIndices <- TRUE options$pathDiagram <- TRUE -options$screePlot <- TRUE options$factorStructure <- TRUE options$manualNumberOfFactors <- 2 options$obliqueSelector <- "geominQ" @@ -223,13 +201,6 @@ test_that("Path Diagram plot matches", { jaspTools::expect_equal_plots(testPlot, "path-diagram") }) -test_that("Scree plot matches", { - skip("Scree plot check does not work because some data is simulated (non-deterministic).") - plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_scree"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "scree-plot") -}) - test_that("Factor Loadings (Structure Matrix) table results match", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_structureTable"]][["data"]] jaspTools::expect_equal_tables(table, diff --git a/tests/testthat/test-verified-principalcomponentanalysis.R b/tests/testthat/test-verified-principalcomponentanalysis.R index 7ea123a6..f8599857 100644 --- a/tests/testthat/test-verified-principalcomponentanalysis.R +++ b/tests/testthat/test-verified-principalcomponentanalysis.R @@ -3,55 +3,45 @@ context("Principal Component Analysis -- Verification project") # does not test # - error handling # - oblique rotation -# - Parallel analysis / manual # - slider defaultOptions <- list( variables = list(), sampleSize = 200, - eigenvaluesAbove = 1, manualNumberOfComponents = 1, orthogonalSelector = "none", obliqueSelector = "promax", loadingsDisplayLimit = 0, componentCorrelations = FALSE, residualMatrix = FALSE, - parallelAnalysisTable = FALSE, pathDiagram = FALSE, - screePlot = FALSE, - screePlotParallelAnalysisResults = TRUE, kaiserMeyerOlkinTest = FALSE, bartlettTest = FALSE, mardiaTest = FALSE, addScoresToData = FALSE, addScoresToDataPrefix = "", dataType = "raw", - componentCountMethod = "parallelAnalysis", - parallelAnalysisMethod = "principalComponentBased", rotationMethod = "orthogonal", baseDecompositionOn = "correlationMatrix", orderLoadingsBy = "variables", - parallelAnalysisTableMethod = "principalComponentBased", naAction = "pairwise", plotWidth = 480, - plotHeight = 320, - setSeed = FALSE, - seed = 1 + plotHeight = 320 ) options <- defaultOptions ## Testing Questionnaire data # https://jasp-stats.github.io/jasp-verification-project/factor.html +# 4 components as previously suggested by PC-based parallel analysis options <- defaultOptions options$PCPrefix <- "" options$loadingsDisplayLimit <- 0.4 options$orthogonalSelector <- "varimax" options$variables <- c(paste("Question", 1:9, sep="_0"), paste("Question", 10:23, sep="_")) -options$componentCountMethod <- "parallelAnalysis" +options$manualNumberOfComponents <- 4 options$rotationMethod <- "orthogonal" options$baseDecompositionOn <- "correlationMatrix" options$naAction <- "pairwise" -options$screePlot <- TRUE set.seed(1) results <- jaspTools::runAnalysis("principalComponentAnalysis", "PCA.csv", options)