added factorLoadingHeatmap

R/factorLoadingDiamondCIplot.R

@@ -46,7 +46,7 @@
 #' ###  may generate warnings because of the bootstrapping of
 #' ###  the confidence intervals)
 #'
-#' factorLoadingDiamondCIplot(psych::fa(Bechtoldt,
+#' factorLoadingDiamondCIplot(psych::fa(psych::Bechtoldt,
 #'                                      nfactors=2,
 #'                                      n.iter=50,
 #'                                      n.obs=200));
@@ -54,7 +54,7 @@
 #' ### And using a lower alpha value for the diamonds to
 #' ### make them more transparent
 #'
-#' factorLoadingDiamondCIplot(psych::fa(Bechtoldt,
+#' factorLoadingDiamondCIplot(psych::fa(psych::Bechtoldt,
 #'                                      nfactors=2,
 #'                                      n.iter=50,
 #'                                      n.obs=200),

R/factorLoadingHeatmap.R

+#' Two-dimensional visualisation of factor analyses
+#'
+#' This function uses the [diamondPlot()] to visualise the results of
+#' a factor analyses. Because the factor loadings computed in factor analysis
+#' are point estimates, they may vary from sample to sample. The factor
+#' loadings for any given sample are usually not relevant; samples are but
+#' means to study populations, and so, researchers are usually interested in
+#' population values for the factor loadings. However, tables with lots of
+#' loadings can quickly become confusing and intimidating. This function aims
+#' to facilitate working with and interpreting factor analysis based on
+#' confidence intervals by visualising the factor loadings and their confidence
+#' intervals.
+#'
+#'
+#' @param fa The object produced by the [psych::fa()] function from the
+#' [psych::psych] package. It is important that the `n.iter` argument
+#' of [psych::fa()] was set to a realistic number, because otherwise, no
+#' confidence intervals will be available.
+#' @param xlab The label for the x axis.
+#' @param colors The colors used for the factors. The default uses the discrete
+#' [viridis()] palette, which is optimized for perceptual uniformity,
+#' maintaining its properties when printed in grayscale, and designed for
+#' colourblind readers. A vector can also be supplied; the colors must be valid
+#' arguments to [colorRamp()] (and therefore, to
+#' [col2rgb()]).
+#' @param labels The labels to use for the items (on the Y axis).
+#' @param theme The ggplot2 theme to use.
+#' @param sortAlphabetically Whether to sort the items alphabetically.
+#' @param \dots Additional arguments will be passed to
+#' [ggDiamondLayer()]. This can be used to set, for example, the
+#' transparency (alpha value) of the diamonds to a lower value using e.g.
+#' `alpha=.5`.
+#' @return A [ggplot2::ggplot()] plot with several
+#' [ggDiamondLayer()]s is returned.
+#' @author Gjalt-Jorn Peters
+#'
+#' Maintainer: Gjalt-Jorn Peters <gjalt-jorn@@userfriendlyscience.com>
+#' @seealso [psych::fa()]ss, [meansDiamondPlot()],
+#' [meanSDtoDiamondPlot()], [diamondPlot()],
+#' [ggDiamondLayer()]
+#' @keywords hplot
+#' @examples
+#'
+#' \dontrun{
+#' ### (Not run during testing because it takes too long and
+#' ###  may generate warnings because of the bootstrapping of
+#' ###  the confidence intervals)
+#'
+#' factorLoadingHeatmap(psych::fa(psych::Bechtoldt,
+#'                                nfactors=2,
+#'                                n.iter=50,
+#'                                n.obs=200));
+#'
+#' ### And using a lower alpha value for the diamonds to
+#' ### make them more transparent
+#'
+#' factorLoadingHeatmap(psych::fa(psych::Bechtoldt,
+#'                                nfactors=2,
+#'                                n.iter=50,
+#'                                n.obs=200),
+#'                      alpha=.5,
+#'                      size=1);
+#' }
+#'
+#' @export factorLoadingDiamondCIplot
+factorLoadingHeatmap <- function(fa,
+                                 xlab='Factor Loading',
+                                 colors = viridis::viridis_pal()(max(2, fa$factors)),
+                                 labels=NULL,
+                                 showLoadings = FALSE,
+                                 heatmap = FALSE,
+                                 theme=ggplot2::theme_minimal(),
+                                 sortAlphabetically = FALSE,
+                                 digits=2,
+                                 labs = list(title = NULL,
+                                             x = NULL,
+                                             y = NULL),
+                                 themeArgs = list(panel.grid = ggplot2::element_blank(),
+                                                  legend.position = "none",
+                                                  axis.text.x = ggplot2::element_blank()),
+                                 ...) {
+
+  ### Create list for CIs per factor
+  loadings <- as.data.frame(unclass(fa$loadings));
+
+  dotsList <- as.list(substitute(list(...)));
+
+  if ('alpha' %in% names(dotsList)) {
+    alpha <- dotsList$alpha;
+  } else {
+    alpha <- 1;
+  }
+
+  if (is.null(labels)) {
+    labels <- rownames(unclass(fa$loadings));
+  }
+
+  if (sortAlphabetically) {
+    sortOrder <- order(labels);
+  } else {
+    sortOrder <- seq_along(labels);
+  }
+
+  tmpDf <-
+    stack(loadings);
+
+  tmpDf$Variable <-
+    factor(
+      rep(row.names(loadings),
+          ncol(loadings)),
+      levels = row.names(loadings)[rev(sortOrder)],
+      labels = row.names(loadings)[rev(sortOrder)],
+      ordered = TRUE
+    );
+
+  tmpDf$Factor <-
+    factor(
+      tmpDf$ind,
+      levels = names(loadings),
+      labels = names(loadings),
+      ordered = TRUE
+    );
+
+  tmpDf$loadingLabel <-
+    round(tmpDf$values, digits);
+
+  tmpDf$absLoading <-
+    abs(tmpDf$values);
+
+  ### Create empty plot
+  res <-
+    ggplot2::ggplot(
+      data = tmpDf,
+      mapping = ggplot2::aes_string(
+        x = "Factor",
+        y = "Variable",
+        color = 'absLoading',
+        fill = 'absLoading')
+    ) +
+      ggplot2::scale_color_viridis_c(direction=-1,
+                                     limits = c(0, 1)) +
+      ggplot2::scale_fill_viridis_c(direction=-1,
+                                    limits = c(0, 1)) +
+      theme +
+    do.call(
+      ggplot2::labs,
+      labs
+    ) +
+      do.call(
+        ggplot2::theme,
+        themeArgs
+      );
+
+  if (heatmap) {
+    res <-
+      res +
+      ggplot2::geom_tile();
+  } else {
+    res <-
+      res +
+      ggplot2::geom_point(
+        mapping = ggplot2::aes_string(size = 'absLoading')
+      );
+  }
+
+  if (showLoadings) {
+    res <-
+      res +
+      ggplot2::geom_text(
+        mapping = ggplot2::aes_string(label = 'loadingLabel')
+      );
+  }
+
+  return(res);
+}