R/plot.parameters_pca.R

In see: Model Visualisation Toolbox for 'easystats' and 'ggplot2'

#' @export
data_plot.parameters_pca <- function(x, data = NULL, ...) {
  dataplot <- as.data.frame(x)
  dataplot$Complexity <- NULL
  dataplot$Uniqueness <- NULL
  dataplot$MSA <- NULL

  if ("Label" %in% colnames(dataplot)) {
    dataplot$Variable <- dataplot$Label
    dataplot$Label <- NULL
  }

  dataplot <- .reshape_to_long(
    dataplot,
    names_to = "Component",
    values_to = "y",
    columns = 2:ncol(dataplot)
  )
  dataplot$Variable <- factor(
    dataplot$Variable,
    levels = rev(unique(dataplot$Variable))
  )

  # Title
  if (inherits(x, "parameters_efa")) {
    title <- "Factor Analysis"
  } else {
    title <- "Principal Component Analysis"
  }

  rotation_name <- attr(x, "rotation", exact = TRUE)

  if (rotation_name == "none") {
    title <- paste("Loadings from", title, "(no rotation)")
  } else {
    title <- paste0("Rotated loadings from ", title, " (", rotation_name, ")")
  }

  # remove missing values in y, to avoid warning
  dataplot <- dataplot[!is.na(dataplot$y), ]

  attr(dataplot, "info") <- list(
    "xlab" = "",
    "ylab" = "",
    "title" = title
  )

  class(dataplot) <- c("data_plot", "see_parameters_pca", "data.frame")
  dataplot
}

#' @export
data_plot.parameters_efa <- data_plot.parameters_pca


# Plot --------------------------------------------------------------------

#' Plot method for principal component analysis
#'
#' The `plot()` method for the `parameters::principal_components()` function.
#'
#' @param type Character vector, indicating the type of plot. Options are
#' different shapes to represent component loadings; `"bar"` (default) for a
#' horizontal bar chart, `"line"` for a horizontal point and line chart, or
#' `"graph"` for a graph.
#' @param color_text Character specifying color of text labels.
#' @param colors Character vector of length three, indicating the colors for low
#' (negative), mid (close to zero), and high (positive) values.
#' @param arrow_end_gap Numeric. Specifies the distance between the tip of the
#' edge arrow and the variable node. Adjusting this value prevents the arrow
#' from overlapping or clipping into the variable label. Default is `0.07`
#' (measured in 'snpc' units). This argument is only used if `type = "graph"`.
#' @param factor_node_size Numeric vector of length 2. Determines the minimum
#' and maximum size of the circular factor nodes. Factor nodes are scaled
#' internally based on the proportion of variance they explain. This argument is
#' only used if `type = "graph"`.
#' @param margins Numeric vector of length 2. Adds extra space to the left and
#' right edges of the plot canvas (using `ggplot2::expansion`). This is
#' particularly useful to prevent long variable labels on the edges from being
#' cut off. This argument is only used if `type = "graph"`.
#' @param names_factors Named character vector. Allows providing custom labels
#' for the factor nodes. The names of the vector must match the original factor
#' names generated by the model (e.g.,
#' `c("Component 1" = "Extraversion", "Component 2" = "Neuroticism")`).
#' This argument is only used if `type = "graph"`.
#' @param fill_variables Character vector. Specifies the fill color for the
#' variable nodes (rectangular labels). Can be a single color hex/name (applied
#' to all variables), a vector of colors matching the exact number of variables,
#' or a named vector to map specific colors to specific variables. This argument
#' is only used if `type = "graph"`.
#' @param fill_factors Character vector. Specifies the fill color for the factor
#' nodes (circular points). Similar to `fill_variables`, this accepts a single
#' color, a vector of matching length, or a named vector for precise mapping.
#' This argument is only used if `type = "graph"`.
#' @inheritParams data_plot
#' @inheritParams plot.see_bayesfactor_parameters
#' @inheritParams plot.see_check_outliers
#' @inheritParams plot.see_n_factors
#'
#' @return A ggplot2-object.
#'
#' @examples
#' library(parameters)
#' data(mtcars)
#' result <- principal_components(mtcars[, 1:7], n = "all", threshold = 0.2)
#' result
#' plot(result)
#'
#' @export
plot.see_parameters_pca <- function(
  x,
  type = "bar",
  size_text = 3.5,
  color_text = "black",
  colors = c("#cd201f", "#ffffff", "#0077B5"),
  size = 1,
  show_labels = TRUE,
  arrow_end_gap = 0.07,
  factor_node_size = c(25, 35),
  margins = c(0.3, 0.3),
  names_factors = NULL,
  fill_variables = "#738b8d",
  fill_factors = "#2C3E50",
  ...
) {
  type <- insight::validate_argument(type, c("bar", "line", "graph"))

  # validate colors argument
  if (is.null(colors)) {
    colors <- c("#cd201f", "#ffffff", "#0077B5")
  }
  if (length(colors) != 3) {
    insight::format_error(
      "The `colors` argument must be a character vector of length 3."
    )
  }

  # leave here for graph plot
  if (type == "graph") {
    return(suppressWarnings(.plot_pca_as_graph(
      object = x,
      size_text = size_text,
      colors = colors,
      arrow_end_gap = arrow_end_gap,
      factor_node_size = factor_node_size,
      margins = margins,
      names_factors = names_factors,
      fill_variables = fill_variables,
      fill_factors = fill_factors,
      ...
    )))
  }

  if (!inherits(x, "data_plot")) {
    x <- data_plot(x)
  }

  if (missing(size)) {
    size <- switch(type, "bar" = 0.6, "line" = 1, 1)
  }

  p <- ggplot(
    as.data.frame(x),
    aes(
      y = .data$Variable,
      x = abs(.data$y),
      fill = .data$y,
      color = .data$y
    )
  )

  if (type == "bar") {
    p <- p +
      geom_bar(stat = "identity", width = size, colour = NA) +
      scale_fill_gradientn(
        colours = unname(colors),
        limits = c(-1, 1)
      )
  } else {
    p <- p +
      geom_segment(
        aes(x = 0, yend = .data$Variable, xend = abs(.data$y)),
        linewidth = size
      ) +
      geom_point(size = 2 * size) +
      scale_color_gradientn(
        colours = unname(colors),
        limits = c(-1, 1)
      )
  }

  if (isTRUE(show_labels)) {
    p <- p +
      geom_text(
        aes(x = abs(.data$y), label = round(.data$y, 2)),
        color = color_text,
        size = size_text,
        nudge_y = 0.15
      )
  }

  p <- p +
    guides(fill = "none", color = "none") +
    scale_x_continuous(
      limits = c(0, 1.25),
      breaks = c(0, 0.25, 0.5, 0.75, 1, 1.25),
      labels = c("0", "0.25", "0.5", "0.75", "1", "")
    ) +
    facet_wrap(~Component) +
    add_plot_attributes(x)

  p
}


#' @export
plot.see_parameters_efa <- plot.see_parameters_pca