Principal Component Analysis
Reduces many numeric measures to a few underlying dimensions: how many are worth keeping against random data, which measures drive each one, and where the rows and their groups sit on them.
RUN DATE · 14 September 2026
DATA · 400 rows
Which few underlying dimensions describe our customers across these nine measures, and what drives each one?
- SummaryHow many components are worth keeping and how much of the variation they hold.
- Components worth keepingEach component's share of the variation against what random data gives.
- Map of the rowsEvery row on the first two components, coloured by its label when one was mapped.
- Measures on each componentHow strongly each measure moves with each kept component.
- What the first two components are made ofEach measure's share of the first two components.
- Every componentEach component's variation, the random benchmark and whether it is kept.
- Every measure's loadingsEach measure's loading on the first three components and how much of it the kept components explain.
- What the results rely onEach condition the components depend on, and whether it holds.
- How it was doneThe method, the data used, and what to keep in mind.
The few dimensions in these measures
Three components beat random threshold
Three underlying dimensions emerge clearly from customer measures, explaining most variation beyond chance.
The data line sits above the random line for the first three components, then falls below.
Three components beat random threshold
The first three components each exceed the random benchmark, clearly capturing real structure in the data. Components four through nine fall below the random threshold, indicating they reflect noise rather than meaningful customer dimensions. The drop after the third component is sharp, marking a clean elbow. The sampling adequacy check is strained, which limits confidence in the precision of these estimates but does not change the direction that three dimensions emerge.
The data line sits above the random line for the first three components, then falls below.
Casual customers cluster center, Loyal and At risk spread
Casual customers occupy the middle, while Loyal and At risk segments spread outward along both axes with some overlap.
The dense cluster of Casual points in the center of the plot, with Loyal points extending toward upper right and At risk points toward lower left.
Casual customers cluster center, Loyal and At risk spread
Casual customers form a tight concentration near the origin across both components, clearly dominating the middle ground. Loyal customers tend toward higher PC1 and PC2 values, while At risk customers skew toward lower PC1 and notably lower PC2, creating a longer lower tail on the second axis. The segments show some spread rather than tight separation, with overlap indicating customers share characteristics across segment boundaries. Sampling adequacy is strained, which means the component structure may not capture all underlying patterns with full confidence.
The dense cluster of Casual points in the center of the plot, with Loyal points extending toward upper right and At risk points toward lower left.
What drives each component
Three components: purchase power, engagement, service issues
RC1 captures purchase behavior, RC2 captures customer engagement, RC3 captures service friction.
RC1 shows Basket Size and Annual Spend loading strongly together; RC2 shows Store Visits, Sessions per Month, and Email Opens loading strongly; RC3 shows Support Tickets and Return Rate loading strongly.
Three components: purchase power, engagement, service issues
RC1 is driven by three closely related purchase measures: Basket Size, Annual Spend, and Items per Order all load strongly and positively, describing a customer's spending power and order composition. RC2 is driven by three engagement measures: Store Visits, Sessions per Month, and Email Opens all load strongly and positively, describing how actively a customer interacts across channels. RC3 is driven by two service-related measures: Support Tickets and Return Rate both load strongly and positively, describing friction in the customer experience. The sampling adequacy check is strained, which limits confidence in the component structure itself.
RC1 shows Basket Size and Annual Spend loading strongly together; RC2 shows Store Visits, Sessions per Month, and Email Opens loading strongly; RC3 shows Support Tickets and Return Rate loading strongly.
Basket Size and Store Visits anchor the dimensions
Basket Size leads with five peers close behind; Support, Return, and Noise barely register.
The top six measures cluster tightly around the top of the bar chart, showing roughly equal weight.
Basket Size and Store Visits anchor the dimensions
Basket Size, Store Visits, Annual Spend, Sessions per Month, Items per Order, and Email Opens form a tight group at the top, each contributing nearly equally to the first two components. Support Tickets, Return Rate, and Noise Metric fall away sharply to negligible shares. The tight clustering among the top six suggests these dimensions capture customer engagement and spending patterns evenly, while service and quality signals play almost no role in the underlying structure. Sampling adequacy is strained, so the relative weights here warrant caution in downstream decisions.
The top six measures cluster tightly around the top of the bar chart, showing roughly equal weight.
The numbers
Three dimensions capture most customer variation
Three kept components hold about two-thirds of variation; the drop after them is sharp and clear.
PC4 eigenvalue falls below its random benchmark, whereas the first three all exceed theirs by a large gap.
Three dimensions capture most customer variation
On this card's data, the kept components hold 68.8% of the variation.
PC4 eigenvalue falls below its random benchmark, whereas the first three all exceed theirs by a large gap.
Loadings
Three dimensions emerge clearly, Noise Metric apart
Three components capture customer variation: spending behavior, engagement activity, and service friction, with Noise Metric mostly independent.
Noise Metric's communality is negligible while all other measures share strong communality, making it distinctly separate from customer behavior patterns.
Three dimensions emerge clearly, Noise Metric apart
The first component groups Basket Size, Annual Spend, and Items per Order with strong positive loadings, describing spending and purchase scale. The second component aligns Store Visits, Sessions per Month, and Email Opens with strong positive loadings, capturing customer engagement intensity. The third component pairs Support Tickets and Return Rate with equally strong loadings, isolating service friction and product satisfaction issues. Noise Metric shows nearly zero communality, meaning it adds no shared dimension and stands apart from customer behavior. The sampling adequacy check is strained, which limits confidence in the component structure, though the three dimensions are clearly separated.
Noise Metric's communality is negligible while all other measures share strong communality, making it distinctly separate from customer behavior patterns.
Assumptions
Checks: one strained, four hold
Strained: sampling adequacy (KMO).
Holding: enough rows per measure, measures correlated enough to combine, no measure dominates by its units, rows complete.
Checks: one strained, four hold
Sampling adequacy (KMO) is strained: a low KMO means the measures share little beyond pairs, so the components summarise poorly. The other four hold.
Holding: enough rows per measure, measures correlated enough to combine, no measure dominates by its units, rows complete.
How it was done
Principal component analysis of 9 measures (Store Visits, Sessions per Month, Email Opens, Basket Size, Annual Spend, Items per Order, Support Tickets, Return Rate, Noise Metric) over 394 complete rows, each measure standardised; 3 components kept by parallel analysis (each beats the 95th percentile of 100 random data sets of the same size, seed 42; the Kaiser rule would keep 3); the 3 kept components are varimax-rotated (RC1 to RC3) so each is driven by its own measures; they hold the same 68.8% together; loadings are correlations between each measure and each component, signed so a component's strongest measure is positive; contributions are each measure's share of the first two components, weighted by their variance; excluded: 6 rows missing a measure; not used: Customer ID, Notes (not mapped).
394 of 400 rows · Store Visits, Sessions per Month, Email Opens, Basket Size, Annual Spend, Items per Order, Support Tickets, Return Rate, Noise Metric → 3 components kept
caveatSampling adequacy is strained; results depend on whether nine measures correlate well enough to combine.
Principal component analysis standardised nine customer measures across complete rows and kept three components by parallel analysis, each rotated to highlight its own drivers. The kept count matches the Kaiser rule, supporting the choice. However, the sampling adequacy check (KMO) is strained, which means the nine measures may not correlate tightly enough to justify combining them into components. This could spread the true structure across more dimensions or make some components unstable. Check the loadings to see whether each component is driven by a tight cluster of measures or whether influence is scattered.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint d2fb7df82f7e5472. The same code on the same data gives the same report.
`standard_pca_v2` <- function(pf) {
`%||%` <- function(a, b) if (!is.null(a)) a else b
#' Readable figures (LAT-3180, LAT-3181): whole numbers from a thousand up, one decimal from a hundred, two from
#' one, three significant figures below one. A cell carries what the value needs, not what R prints.
tidy <- function(x) {
x <- as.numeric(x)
ifelse(is.na(x), NA_real_,
ifelse(abs(x) >= 1000, round(x, 0),
ifelse(abs(x) >= 100, round(x, 1),
ifelse(abs(x) >= 1, round(x, 2), signif(x, 3)))))
}
p_text <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else format(signif(p, 3))
inputs <- pf$taskList$inputs
params <- inputs$module_parameters %||% list()
# THE QUESTION this tool answers: the customer's objective, verbatim, when given.
question <- (inputs$userContext %||% list())$objective %||%
"Which few underlying dimensions summarise these measures, and which measures drive each one?"
#' ## Column mapping
#' Two to twelve numeric `feature_N` columns describing the same rows, and optionally a `label` column (a segment or
#' group) that colours the map. Semantic names inside; the customer's headers live in `col_map`.
col_map <- inputs$column_mapping %||% list()
df <- renderObject.taskFunction.init(inputs, col_map) # df has SEMANTIC names
human <- function(sem) {
v <- col_map[[sem]]
if (is.null(v) || !nzchar(as.character(v))) sem else as.character(v)
}
n_in <- nrow(df)
feat_cols <- grep("^feature_[0-9]+$", names(df), value = TRUE)
feat_cols <- feat_cols[order(as.integer(sub("^feature_", "", feat_cols)))]
if (length(feat_cols) < 2) stop("column_mapping must map at least two numeric columns to feature_1, feature_2, ... (the measures to summarise).")
has_label <- "label" %in% names(df)
raw_names <- local({
ds <- inputs$dataset %||% inputs$df
if (is.data.frame(ds)) return(names(ds))
if (is.list(ds) && length(ds) > 0) {
rows <- ds[seq_len(min(length(ds), 50))]
nm <- unique(unlist(lapply(rows, function(r) if (is.list(r)) names(r) else NULL)))
if (length(nm)) return(nm)
if (!is.null(names(ds)) && all(nzchar(names(ds)))) return(names(ds))
}
character(0)
})
mapped_actual <- unique(as.character(unlist(col_map)))
ignored_cols <- setdiff(raw_names, unique(c(mapped_actual, make.names(mapped_actual))))
#' ## Parameters
#' `scale`: yes (the default: every measure standardised, so a measure in large units cannot dominate) or no (only
#' when every measure shares one unit and its spread should count).
scale_param <- tolower(as.character(params$scale %||% "yes"))
if (!(scale_param %in% c("yes", "no"))) stop("module_parameters$scale must be yes or no")
scaled <- scale_param == "yes"
#' `rotation`: varimax (the default) turns the kept components so each is driven by its own group of measures, which is
#' what makes them readable; none leaves the principal components as computed. Rotation needs standardised measures
#' and at least two kept components, and the method says when it did not apply.
rotation_param <- tolower(as.character(params$rotation %||% "varimax"))
if (!(rotation_param %in% c("varimax", "none"))) stop("module_parameters$rotation must be varimax or none")
#' ## Data preparation
#' Each mapped measure is read as a number (95% rule). A measure that is not numeric, is constant, or is a running
#' index is excluded and named. Rows missing any kept measure are excluded and counted (a component is a weighted sum
#' of every measure, so a filled value would move it). At least two measures and 10 complete rows are required.
excluded_cols <- character(0); why <- character(0); X <- list()
for (fc in feat_cols) {
v <- df[[fc]]; nm <- human(fc)
if (!is.numeric(v)) {
ch <- trimws(as.character(v)); nb <- !is.na(ch) & ch != ""
conv <- suppressWarnings(as.numeric(ch))
if (sum(nb) == 0 || sum(!is.na(conv[nb])) < 0.95 * sum(nb)) { excluded_cols <- c(excluded_cols, nm); why <- c(why, "not numeric"); next }
v <- conv
}
v <- as.numeric(v); v[!is.finite(v)] <- NA; ok <- v[!is.na(v)]
if (length(ok) < 3 || isTRUE(stats::sd(ok) == 0)) { excluded_cols <- c(excluded_cols, nm); why <- c(why, "constant"); next }
if (length(unique(ok)) == length(ok) && all(abs(diff(sort(ok)) - 1) < 1e-9)) { excluded_cols <- c(excluded_cols, nm); why <- c(why, "a running index"); next }
X[[nm]] <- v
}
if (length(X) < 2) stop(sprintf("Fewer than two usable numeric measures remained (excluded: %s); PCA needs at least two.",
if (length(excluded_cols)) paste(paste0(excluded_cols, " (", why, ")"), collapse = ", ") else "none"))
X <- as.data.frame(X, check.names = FALSE, stringsAsFactors = FALSE)
complete <- stats::complete.cases(X)
n_incomplete <- sum(!complete)
labels <- if (has_label) { l <- trimws(as.character(df$label)); l[is.na(l) | l == ""] <- "(no label)"; l } else rep("Rows", n_in)
X <- X[complete, , drop = FALSE]; labels <- labels[complete]
M <- as.matrix(X); n <- nrow(M); k <- ncol(M)
if (n < 10) stop(sprintf("Only %d rows have every measure; PCA needs at least 10.", n))
#' ## Principal components (prcomp), the kept count by parallel analysis
#' Parallel analysis (Horn): the eigenvalues of this data against the 95th percentile of eigenvalues from 100 random
#' data sets of the same size and spreads (seed 42); components are kept while each one beats its random counterpart.
pc <- stats::prcomp(M, center = TRUE, scale. = scaled)
eig <- pc$sdev^2; var_pct <- 100 * eig / sum(eig); cum_pct <- cumsum(var_pct)
set.seed(42)
sds <- apply(M, 2, stats::sd)
rand <- replicate(100, { R <- sweep(matrix(stats::rnorm(n * k), n, k), 2, if (scaled) 1 else sds, "*")
100 * { e <- stats::prcomp(R, center = TRUE, scale. = scaled)$sdev^2; e / sum(e) } })
rand95 <- apply(matrix(rand, nrow = k), 1, stats::quantile, probs = 0.95)
beats <- var_pct > rand95
n_keep <- if (beats[1]) { w <- which(!beats); if (length(w)) w[1] - 1 else k } else 1
n_kaiser <- if (scaled) sum(eig > 1) else sum(eig > mean(eig))
show <- min(k, max(n_keep, 2), 6)
#' Loadings as correlations between each measure and each component score. With two or more kept components on
#' standardised measures they are varimax-rotated (LAT-3189 run 1: two equally strong dimensions came out of plain PCA as
#' their sum and their difference, and the report could not name either). Each component's sign is set so its strongest
#' measure loads positively; a component's sign is arbitrary and this makes the report reproducible.
S <- scale(pc$x[, seq_len(show), drop = FALSE])
L <- stats::cor(M, S)
rotated <- rotation_param == "varimax" && scaled && n_keep >= 2
if (rotated) {
vm <- stats::varimax(L[, seq_len(n_keep), drop = FALSE], normalize = TRUE)
L <- unclass(vm$loadings); S <- S[, seq_len(n_keep), drop = FALSE] %*% vm$rotmat
show <- n_keep
}
for (j in seq_len(show)) { s <- sign(L[which.max(abs(L[, j])), j]); if (s < 0) { L[, j] <- -L[, j]; S[, j] <- -S[, j] } }
shown_names <- paste0(if (rotated) "RC" else "PC", seq_len(show))
colnames(L) <- shown_names
comp_names <- paste0("PC", seq_len(k))
#' ## Adequacy: Bartlett's test of sphericity and the Kaiser-Meyer-Olkin measure, on the correlation matrix
R <- stats::cor(M)
bart <- tryCatch({ chi <- -((n - 1) - (2 * k + 5) / 6) * log(det(R)); df_b <- k * (k - 1) / 2
list(chi = chi, p = stats::pchisq(chi, df_b, lower.tail = FALSE)) }, error = function(e) list(chi = NA_real_, p = NA_real_))
kmo <- tryCatch({ Ri <- solve(R); A <- -Ri / sqrt(outer(diag(Ri), diag(Ri))); off <- row(R) != col(R)
sum(R[off]^2) / (sum(R[off]^2) + sum(A[off]^2)) }, error = function(e) NA_real_)
#' ## The frames for the places
scree_df <- data.frame(component = rep(seq_len(k), 2), variance_pct = round(c(var_pct, rand95), 2),
series = rep(c("This data", "Random data (95th percentile)"), each = k), stringsAsFactors = FALSE)
load_df <- data.frame(feature = rep(rownames(L), times = show), component = rep(shown_names, each = k),
loading = round(as.vector(L), 2), stringsAsFactors = FALSE)
contrib <- rowSums(L[, 1:2, drop = FALSE]^2) / sum(L[, 1:2]^2) * 100
contrib_df <- data.frame(feature = names(contrib), contribution_pct = round(contrib, 1), stringsAsFactors = FALSE)
contrib_df <- contrib_df[order(-contrib_df$contribution_pct), , drop = FALSE]
set.seed(42)
map_idx <- if (n > 2000) sort(sample(seq_len(n), 2000)) else seq_len(n)
map_df <- data.frame(pc1 = round(S[map_idx, 1], 3), pc2 = round(S[map_idx, 2], 3), group = labels[map_idx], stringsAsFactors = FALSE)
comp_df <- data.frame(component = comp_names, eigenvalue = tidy(eig), variance_pct = round(var_pct, 1), cumulative_pct = round(cum_pct, 1),
random_95th_pct = round(rand95, 1), kept = ifelse(seq_len(k) <= n_keep, "yes", "no"), stringsAsFactors = FALSE)
lt <- matrix(NA_real_, k, 3); lt[, seq_len(min(3, show))] <- round(L[, seq_len(min(3, show))], 2)
loadings_df <- data.frame(feature = rownames(L), comp_1 = lt[, 1], comp_2 = lt[, 2], comp_3 = lt[, 3],
communality = round(rowSums(L[, seq_len(min(n_keep, show)), drop = FALSE]^2), 2), stringsAsFactors = FALSE)
#' ## Assumption checks (LAT-3138)
per_feat <- n / k
var_share <- if (!scaled) max(apply(M, 2, stats::var)) / sum(apply(M, 2, stats::var)) else NA_real_
miss_share <- n_incomplete / n_in
checks_df <- data.frame(
check = c("Enough rows per measure", "Measures correlated enough to combine", "Sampling adequacy (KMO)",
"No measure dominates by its units", "Rows complete"),
statistic = c(sprintf("%s rows per measure", format(round(per_feat, 1))), "Bartlett's test of sphericity",
if (is.na(kmo)) "not estimable (the correlation matrix is singular)" else sprintf("KMO %s", format(round(kmo, 2))),
if (scaled) "measures standardised" else sprintf("largest measure holds %s%% of the variance", format(round(100 * var_share, 1))),
sprintf("%d of %d rows missing a measure", n_incomplete, n_in)),
p_value = c("", p_text(bart$p), "", "", ""),
verdict = c(if (per_feat >= 10) "holds" else if (per_feat >= 5) "strained" else "violated",
if (is.na(bart$p)) "strained" else if (bart$p < 0.05) "holds" else "violated",
if (is.na(kmo)) "strained" else if (kmo >= 0.7) "holds" else if (kmo >= 0.5) "strained" else "violated",
if (scaled || var_share <= 0.5) "holds" else if (var_share <= 0.8) "strained" else "violated",
if (miss_share <= 0.05) "holds" else if (miss_share <= 0.15) "strained" else "violated"),
note = c("few rows per measure make the components unstable from sample to sample",
"measures that barely correlate have no shared dimension to find; each component is then close to one measure",
"a low KMO means the measures share little beyond pairs, so the components summarise poorly",
"without standardising, a measure in large units takes the first component by its units alone",
"rows missing a measure are left out; if they differ from the rest, the components describe only the complete rows"),
stringsAsFactors = FALSE)
#' ## Method, assumptions, answer
excluded <- c(if (length(excluded_cols)) paste0(excluded_cols, " (", why, ")"),
if (n_incomplete > 0) sprintf("%d row%s missing a measure", n_incomplete, if (n_incomplete > 1) "s" else ""))
method <- paste0(
"Principal component analysis of ", k, " measures (", paste(colnames(M), collapse = ", "), ") over ", n, " complete rows, ",
if (scaled) "each measure standardised" else "on the measures' own units", "; ", n_keep, " component", if (n_keep > 1) "s" else "",
" kept by parallel analysis (each beats the 95th percentile of 100 random data sets of the same size, seed 42; the Kaiser rule would keep ", n_kaiser, ")",
if (rotated) sprintf("; the %d kept components are varimax-rotated (RC1 to RC%d) so each is driven by its own measures; they hold the same %s%% together", n_keep, n_keep, format(round(cum_pct[n_keep], 1))) else
if (rotation_param == "varimax") sprintf("; no rotation (%s)", if (!scaled) "rotation needs standardised measures" else "one component kept") else "; no rotation, as requested",
"; loadings are correlations between each measure and each component, signed so a component's strongest measure is positive",
"; contributions are each measure's share of the first two components, weighted by their variance",
if (length(excluded)) paste0("; excluded: ", paste(excluded, collapse = "; ")) else "",
if (length(ignored_cols)) paste0("; not used: ", paste(utils::head(ignored_cols, 12), collapse = ", "), " (not mapped)") else "", ".")
assumptions <- list(
"Components are directions of shared variation, not causes; naming one is a reading of its loadings, not a finding.",
"A component's sign is arbitrary: a negative loading means the measure moves against the component's strongest measure.",
"Relationships are assumed linear; a curved relationship spreads across several components.",
"Extreme rows pull components toward themselves; check the map for rows far from the rest.",
"The kept count is a guide: parallel analysis is conservative, the Kaiser rule usually keeps more.")
answer <- list(components_kept = n_keep, kaiser_components = n_kaiser, variance_pct = round(var_pct, 1),
variance_kept_pct = round(cum_pct[n_keep], 1), kmo = if (is.na(kmo)) NULL else round(kmo, 2),
rotated = rotated, scaled = scaled, n = n)
results <- list()
#' The verdict and the headline are NOT places of a library tool (LAT-3130): the last mile writes them.
results$summary_metrics <- place_metric(list(components_kept = n_keep, variance_first_pct = round(var_pct[1], 1),
variance_kept_pct = round(cum_pct[n_keep], 1), kaiser_components = n_kaiser, measures = k, rows = n), lead = "components_kept", place = "summary_metrics")
results$scree <- place_trend(scree_df, x = "component", y = "variance_pct", series = "series", place = "scree")
results$score_map <- place_relationship(map_df, x = "pc1", y = "pc2", series = "group", place = "score_map")
results$loadings_matrix <- place_matrix(load_df, x = "component", y = "feature", z = "loading", place = "loadings_matrix")
results$feature_contributions <- place_comparison(contrib_df, category = "feature", value = "contribution_pct", place = "feature_contributions")
results$components_table <- place_table(comp_df, place = "components_table")
results$loadings_table <- place_table(loadings_df, place = "loadings_table")
results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
results$pca_method <- list(kind = "metric", values = list(
method = method, n_in = n_in, n_used = n, excluded = as.list(excluded), assumptions = assumptions,
x_column = paste(colnames(M), collapse = ", "), y_column = sprintf("%d components kept", n_keep)),
value_order = list("n_used", "n_in"))
objects <- list() # filled by the object layer, not here
list(answer = answer, method = method, n = n, results = results, objects = objects,
json_output = list(answer = answer, method = method, n = n))
}