Cluster Analysis
Finds the natural groups in your data: how many there are, what sets each one apart, and how clearly they separate.
RUN DATE · 14 September 2026
DATA · 45 rows
How many natural segments are in this data, and what distinguishes them?
- SummaryHow many groups were found, how clearly they separate, and how large they are.
- Choosing the number of groupsHow well each possible number of groups fits the data.
- Group sizesHow the rows are split across the groups.
- Map of the groupsEvery row placed on one picture, coloured by its group.
- What sets each group apartHow far each group sits above or below average on each measure.
- Full group profilesEach group's averages beside the overall averages, measure by measure.
- What the results rely onEach condition the analysis depends on, and whether it holds.
- How it was doneThe method, the data used, and what to keep in mind.
The segments
Three groups fit clearly better than two or four
Three segments stand clearly ahead of rivals, offering the strongest fit to this data.
The chosen count rises above both the runner-up and the alternative, showing a decisive peak.
Three groups fit clearly better than two or four
The average silhouette width for three groups exceeds both two and four groups, creating a clear separation from the nearest alternative. This peak is strong and unambiguous, not a flat profile where several counts would work equally well. The chosen count's advantage is decisive enough to guide segment selection. Note that segment row counts run lean, which slightly limits confidence in the stability of small groups, so verify segment membership and size when interpreting the three segments next.
The chosen count rises above both the runner-up and the alternative, showing a decisive peak.
Three equally sized natural segments emerge
Segments split evenly across three groups, each holding equal share, supporting the segmentation.
All three segments hold identical size and share, showing perfectly balanced division.
Three equally sized natural segments emerge
All three segments contain equal numbers and split the data into matching portions. The balance is clear and strong, with no segment dominating or appearing marginal. However, the small size per segment limits confidence in their individual profiles; readers should treat segment characteristics as directional rather than precise. The even split confirms that the natural grouping method found three genuinely distinct clusters rather than one dominant group.
All three segments hold identical size and share, showing perfectly balanced division.
What sets them apart
Three distinct segments separate clearly
Segments form separate islands on the map, with no overlap between them, answering the count definitively.
The left side shows one tight cluster, the right side another, and the upper-middle a third, each well apart.
Three distinct segments separate clearly
Segment 1 (high tenure, high visits) clusters tightly on the left. Segment 3 (high basket, high spend) clusters tightly on the right. Segment 2 (low basket, low spend) sits in the upper-middle, clearly separated from both. The boundaries between segments are sharp and unambiguous in this two-dimensional view. One assumption check is strained (enough rows per segment), so interpret segment sizes with caution; however, separation itself is clear.
The left side shows one tight cluster, the right side another, and the upper-middle a third, each well apart.
Tenure and visits set segment one apart
Three segments separate on spending and tenure. Segment one leads on tenure and visits; segment three leads on spend and basket.
Segment one's tenure and visits cells show the strongest positive values; segment three's spend and basket cells show the strongest positive values.
Tenure and visits set segment one apart
Segment one sits clearly above average on tenure and visits but well below on spend and basket. Segment three reverses this, sitting clearly above average on spend and basket but well below on tenure and visits. Segment two remains close to average across all measures. The separation is clear on tenure, visits, spend and basket, though segment two's modest deviations suggest it lacks strong distinguishing traits. The strained check on rows per segment warrants care in drawing conclusions about segment two's stability.
Segment one's tenure and visits cells show the strongest positive values; segment three's spend and basket cells show the strongest positive values.
The numbers
Three segments split on tenure and spending behavior
Three clear segments emerge: high tenure with low spend, moderate spend with average tenure, and high spend with low tenure.
Segment 1 and Segment 3 show inverse profiles: one prioritizes loyalty over transaction value, the other transaction value over loyalty.
Three segments split on tenure and spending behavior
Segment 1 shows strong tenure and visits but weak spend and basket size, clearly distinct from the overall average. Segment 3 reverses this pattern with high spend and basket but minimal tenure and visits. Segment 2 occupies the middle ground with modest differences across all measures. The z-scores confirm these separations are substantial, though segment sizes are small and warrant caution in inference.
Segment 1 and Segment 3 show inverse profiles: one prioritizes loyalty over transaction value, the other transaction value over loyalty.
Assumptions and method
Checks: one strained, four hold
Strained: enough rows per segment.
Holding: segments separate, chosen k stands out, segments balanced, few filled cells.
Checks: one strained, four hold
Enough rows per segment is strained: a tiny segment's profile averages deserve caution. The other four hold.
Holding: segments separate, chosen k stands out, segments balanced, few filled cells.
K-means clustering (10 random starts, seed 42) on 4 standardised measures (spend, basket, tenure, visits) across 45 of 45 rows. The number of segments was chosen by the highest average silhouette width over k = 2 to 4 (silhouette scored on 45 rows; average silhouette at k = 3 is 0.841, strong separation). Segments are numbered by size and named by the measures whose standardised centre lies furthest from the overall average; profiles are reported in original units. The map is the first two principal components of the standardised measures (96.7% and 3.1% of variance).
45 of 45 rows · spend, basket, tenure, visits → 3 segments
caveatK-means on four measures found three segments with strong separation; few rows per segment limits their stability.
The method used standardised spend, basket, tenure and visits across all rows to identify segments by silhouette, which held strong. No data was excluded or filled. The check on segment size is strained: clusters are balanced and well separated, but each contains relatively few rows, so new data may sit between segments rather than clearly in one. The silhouette favours three segments; if the business needs a different number, that choice would override the data's preference.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint d35492a54d35918a. The same code on the same data gives the same report.
`standard_clustering_v2` <- function(pf) {
#' Readable figures (LAT-3181, as LAT-3180): 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)))))
}
`%||%` <- function(a, b) if (!is.null(a)) a else b
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 %||%
"What natural segments does the data fall into, how many are there, and what distinguishes each one?"
#' ## Column mapping
#' The customer maps two to eight numeric `feature_N` columns. Semantic names are
#' used inside; the customer's own headers are carried in `col_map` so every
#' segment name, profile row and axis names the columns the reader knows.
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)
}
#' ## Data preparation
#' Every mapped feature is coerced to numeric (text that is 95% numeric is
#' converted, anything else is excluded); constant, near-empty and
#' identifier-like columns (a running index) are excluded, because a row number
#' is not a trait and would slice the data by position. Blanks in a kept feature
#' are filled with that feature's median so every row can be placed; the count
#' of filled cells is reported. At least two usable features and 30 rows are required.
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 feature columns (feature_1, feature_2)")
dropped <- character(0); why <- character(0)
for (fc in feat_cols) {
v <- df[[fc]]
if (!is.numeric(v)) {
conv <- suppressWarnings(as.numeric(as.character(v)))
n_orig <- sum(!is.na(v) & as.character(v) != "")
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) df[[fc]] <- conv
else { dropped <- c(dropped, fc); why <- c(why, "not numeric"); next }
}
v <- df[[fc]]
# A non-finite CELL is a bad cell, not a bad column. Before this, one Inf in 300 rows
# (a divide-by-zero in the customer's spreadsheet is how Inf arrives) made var() NaN,
# which the `constant` test below caught: the tool discarded 299 good values AND told
# the reader the column was constant, which was false. Non-finite cells now become
# blanks and go down the median path with every other blank, counted in n_imputed.
if (any(!is.finite(v))) { v[!is.finite(v)] <- NA; df[[fc]] <- v }
if (sum(!is.na(v)) < 10) { dropped <- c(dropped, fc); why <- c(why, "fewer than 10 values"); next }
if (is.na(var(v, na.rm = TRUE)) || isTRUE(var(v, na.rm = TRUE) == 0)) { dropped <- c(dropped, fc); why <- c(why, "constant"); next }
vv <- v[!is.na(v)]
if (length(unique(vv)) == length(vv) && all(vv == round(vv)) && length(vv) > 50 &&
isTRUE(all(diff(sort(vv)) == 1))) { dropped <- c(dropped, fc); why <- c(why, "identifier-like (a running index)"); next }
}
use_cols <- setdiff(feat_cols, dropped)
if (length(use_cols) < 2) stop(sprintf("Only %d usable numeric feature column(s) remained after cleaning; clustering needs at least two.", length(use_cols)))
X <- as.data.frame(lapply(df[, use_cols, drop = FALSE], as.numeric))
names(X) <- use_cols
n_imputed <- 0L
for (uc in use_cols) {
miss <- is.na(X[[uc]])
if (any(miss)) { X[[uc]][miss] <- median(X[[uc]], na.rm = TRUE); n_imputed <- n_imputed + sum(miss) }
}
n <- nrow(X)
n_used <- n
if (n < 30) stop(sprintf("Only %d usable rows; clustering needs at least 30 to find stable segments.", n))
hn <- vapply(use_cols, human, character(1))
k <- length(use_cols)
#' ## Choosing the number of segments
#' Features are standardised (mean 0, sd 1) so no one measure dominates the
#' distance. Every k from 2 to min(8, n/10) is fitted by k-means (10 random
#' starts, seed 42) and scored by average silhouette width: how much closer each
#' row sits to its own segment than to the nearest other one, from -1 to 1. The
#' k with the highest silhouette wins unless `module_parameters$k` names one
#' (2 to 8). The silhouette search runs on at most 5 000 rows (the distance
#' matrix is quadratic); the final fit always uses every row.
Xs <- scale(as.matrix(X))
k_max <- max(2L, min(8L, floor(n / 10)))
k_searched <- 2:k_max
set.seed(42)
search_idx <- if (n > 5000) sort(sample(n, 5000)) else seq_len(n)
sil_search_n <- length(search_idx)
Xs_search <- Xs[search_idx, , drop = FALSE]
D <- dist(Xs_search)
sil_by_k <- vapply(k_searched, function(kk) {
km_k <- tryCatch({ set.seed(42); kmeans(Xs_search, centers = kk, nstart = 10, iter.max = 50) }, error = function(e) NULL)
if (is.null(km_k) || length(unique(km_k$cluster)) < 2) return(NA_real_)
s <- tryCatch(cluster::silhouette(km_k$cluster, D), error = function(e) NULL)
if (is.null(s)) return(NA_real_)
mean(s[, 3])
}, numeric(1))
valid <- which(!is.na(sil_by_k))
if (length(valid) == 0) stop(sprintf("No k-means solution could be scored on %s; the data may have too few distinct rows to cluster.", paste(hn, collapse = ", ")))
k_auto <- k_searched[valid][which.max(sil_by_k[valid])]
k_param <- suppressWarnings(as.integer(params$k %||% NA))
k_forced <- !is.na(k_param) && k_param >= 2 && k_param <= k_max && k_param %in% k_searched[valid]
k_star <- if (k_forced) k_param else k_auto
sil_star <- sil_by_k[match(k_star, k_searched)]
quality <- if (sil_star > 0.7) "strong" else if (sil_star > 0.5) "good" else if (sil_star >= 0.25) "reasonable" else "weak"
#' LAT-3181: the chosen count is named in its own label and the bars are one series. Split by `chosen`, the chart drew
#' the candidates first and the chosen bar after them, so the axis read k=2, k=4, k=3.
sil_df <- data.frame(k = ifelse(k_searched[valid] == k_star, paste0("k=", k_searched[valid], " (chosen)"), paste0("k=", k_searched[valid])),
avg_silhouette = round(sil_by_k[valid], 3),
chosen = ifelse(k_searched[valid] == k_star, "chosen", "candidate"), stringsAsFactors = FALSE)
#' ## The final fit, segments relabelled by size, named by their traits
set.seed(42)
km <- kmeans(Xs, centers = k_star, nstart = 10, iter.max = 50)
tab <- tabulate(km$cluster, nbins = k_star)
ord_sz <- order(-tab)
remap <- integer(k_star); remap[ord_sz] <- seq_len(k_star)
assign <- remap[km$cluster]
centers <- km$centers[ord_sz, , drop = FALSE] # standardised centroids, largest segment first
sizes <- tabulate(assign, nbins = k_star)
share_pct <- round(100 * sizes / n, 1)
seg_desc <- apply(centers, 1, function(cv) {
cv <- as.numeric(cv); o <- order(-abs(cv))
if (abs(cv[o[1]]) < 0.1) return("near the overall average")
part <- function(i) paste0(if (cv[i] > 0) "high " else "low ", hn[i])
parts <- part(o[1])
if (length(o) >= 2 && abs(cv[o[2]]) >= 0.3) parts <- c(parts, part(o[2]))
paste(parts, collapse = ", ")
})
seg_label <- sprintf("Segment %d: %s", seq_len(k_star), seg_desc)
sizes_df <- data.frame(segment = seg_label, size = sizes, share_pct = share_pct, stringsAsFactors = FALSE)
#' ## Profiles in original units, and the standardised grid
overall_mean <- colMeans(X)
overall_sd <- apply(X, 2, sd)
prof_rows <- list()
for (ci in seq_len(k_star)) {
in_c <- assign == ci
for (fi in seq_along(use_cols)) {
sm <- mean(X[[fi]][in_c]); om <- overall_mean[[fi]]
dp <- if (abs(om) > 1e-12) round(100 * (sm - om) / abs(om), 1) else NA_real_
zs <- if (overall_sd[[fi]] > 0) round((sm - om) / overall_sd[[fi]], 2) else 0
prof_rows[[length(prof_rows) + 1]] <- data.frame(
segment = seg_label[ci], feature = hn[fi], segment_mean = tidy(sm), overall_mean = tidy(om),
difference_pct = dp, z_score = zs, size = sizes[ci], stringsAsFactors = FALSE)
}
}
profiles <- do.call(rbind, prof_rows); rownames(profiles) <- NULL
grid_df <- profiles[, c("segment", "feature", "z_score")]
top_trait <- profiles[which.max(abs(profiles$z_score)), ]
#' ## The two-dimensional map (principal components of the standardised features, at most 1 000 points)
pr <- prcomp(Xs, center = FALSE, scale. = FALSE)
var_all <- pr$sdev^2 / sum(pr$sdev^2)
pc_var_pct <- round(100 * var_all[1:2], 1)
set.seed(42)
map_idx <- if (n > 1000) sort(sample(n, 1000)) else seq_len(n)
map_df <- data.frame(pc1 = round(pr$x[map_idx, 1], 3), pc2 = round(pr$x[map_idx, 2], 3),
segment = seg_label[assign[map_idx]], stringsAsFactors = FALSE)
#' ## Method text and the answer
method <- paste0(
"K-means clustering (10 random starts, seed 42) on ", k, " standardised measures (",
paste(hn, collapse = ", "), ") across ", n_used, " of ", n_in, " rows",
if (n_imputed > 0) paste0(" (", n_imputed, " blank or non-finite cell", if (n_imputed > 1) "s" else "", " filled with the column median)") else "",
if (length(dropped)) paste0("; excluded: ", paste(paste0(vapply(dropped, human, character(1)), " (", why, ")"), collapse = ", ")) else "",
". The number of segments was ", if (k_forced) paste0("fixed at ", k_star, " by parameter") else
paste0("chosen by the highest average silhouette width over k = 2 to ", k_max),
" (silhouette scored on ", sil_search_n, " rows; average silhouette at k = ", k_star, " is ", round(sil_star, 3), ", ", quality, " separation)",
". Segments are numbered by size and named by the measures whose standardised centre lies furthest from the overall average; ",
"profiles are reported in original units. The map is the first two principal components of the standardised measures (",
pc_var_pct[1], "% and ", pc_var_pct[2], "% of variance).")
statement <- sprintf("The data separates into %d segments (average silhouette %s, %s separation); the largest, %s, holds %s%% of %d rows",
k_star, format(round(sil_star, 3), nsmall = 3), quality, seg_label[1], share_pct[1], n_used)
answer <- list(k = k_star, avg_silhouette = round(sil_star, 4), separation = quality,
segments = as.list(seg_label), sizes = as.list(sizes), share_pct = as.list(share_pct),
most_distinctive = sprintf("%s on %s (%s vs %s overall)", top_trait$segment, top_trait$feature,
top_trait$segment_mean, top_trait$overall_mean),
n_measures = k, n = n_used)
# ── Results: one entry per place. Row-bearing places are constructor calls (the
# columns are derived from the frame, the roles are named); the three
# value-bearing places carry an explicit value_order. ──
#' ## Summary metrics and assumption checks (LAT-3138): the figures that summarise the
#' whole analysis as one metrics row, and one verdict per assumption of the method,
#' each with the statistic behind it. holds / strained / violated are rules of thumb a
#' reader can re-derive from the statistic shown beside them. Base R throughout.
verdict_p <- function(p, soft = 0.05, hard = 0.001) if (is.na(p)) "unknown" else if (p >= soft) "holds" else if (p >= hard) "strained" else "violated"
fmt_p <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else as.character(signif(p, 3))
summary_vals <- list(k = k_star, avg_silhouette = round(sil_star, 3), largest_share_pct = max(share_pct), smallest_share_pct = min(share_pct), n_measures = k, n = n_used)
sil_sorted <- sort(sil_by_k[is.finite(sil_by_k)], decreasing = TRUE)
sil_gap <- if (length(sil_sorted) >= 2) sil_sorted[1] - sil_sorted[2] else NA_real_
min_seg <- min(sizes); imp_share <- n_imputed / max(1, n_used * k)
checks_df <- data.frame(
check = c("Segments separate", "Chosen k stands out", "Segments balanced", "Enough rows per segment", "Few filled cells"),
statistic = c(paste0("average silhouette = ", round(sil_star, 3)),
if (k_forced) "k set by parameter" else paste0("gap to the runner-up = ", round(sil_gap, 3)),
paste0("largest segment holds ", max(share_pct), "% of rows"),
paste0("smallest segment n = ", min_seg),
paste0(round(100 * imp_share, 2), "% of cells filled with medians")),
p_value = c("", "", "", "", ""),
verdict = c(if (sil_star >= 0.5) "holds" else if (sil_star >= 0.25) "strained" else "violated",
if (k_forced) "holds" else if (is.na(sil_gap)) "unknown" else if (sil_gap >= 0.05) "holds" else if (sil_gap >= 0.02) "strained" else "violated",
if (max(share_pct) <= 60) "holds" else if (max(share_pct) <= 80) "strained" else "violated",
if (min_seg >= 30) "holds" else if (min_seg >= 10) "strained" else "violated",
if (imp_share < 0.01) "holds" else if (imp_share < 0.05) "strained" else "violated"),
note = c("below 0.25 the segments are a partition of one cloud, not groups",
"a flat silhouette profile means several counts describe the data about as well",
"one dominant segment is usually the bulk plus a few outliers",
"a tiny segment's profile averages deserve caution",
"filled cells pull those rows toward the centre"),
stringsAsFactors = FALSE)
results <- list()
#' The verdict and the headline are NOT places of a library tool (LAT-3130): a
#' library tool supplies data objects; the answer is written by the last mile,
#' which is the first stage that reads the objects together.
#' ## summary_metrics: the whole analysis at a glance (LAT-3138)
results$summary_metrics <- place_metric(summary_vals, lead = "k", place = "summary_metrics")
#' ## assumption_checks: a verdict per assumption (a `checks` place, table-shaped)
results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
#' ## silhouette_by_k: every candidate count scored
results$silhouette_by_k <- place_comparison(sil_df, category = "k", value = "avg_silhouette",
place = "silhouette_by_k")
#' ## segment_sizes: how the rows split
results$segment_sizes <- place_comparison(sizes_df, category = "segment", value = "size",
place = "segment_sizes")
#' ## segment_map: every row on the two principal components, coloured by segment
results$segment_map <- place_relationship(map_df, x = "pc1", y = "pc2", series = "segment",
place = "segment_map")
#' ## segment_profile_grid: each segment's standardised distance from the overall average, per measure
results$segment_profile_grid <- place_matrix(grid_df, x = "feature", y = "segment", z = "z_score",
place = "segment_profile_grid")
#' ## profile_table: every segment and measure in original units
results$profile_table <- place_table(profiles, place = "profile_table")
#' ## clustering_method: how it was done
results$clustering_method <- list(kind = "metric", values = list(
method = method, n_in = n_in, n_used = n_used,
excluded = if (length(dropped)) as.list(unname(vapply(dropped, human, character(1)))) else list(),
# LAT-3181: the method card's column line reads these; a clustering has measures and no outcome
# the arrow reads "measures -> what they produce": the method card prints x_column -> y_column unconditionally
x_column = paste(hn, collapse = ", "), y_column = sprintf("%d segments", k_star),
assumptions = list(
"K-means finds compact, roughly round segments of similar spread; elongated or nested groups can be split or merged.",
"Standardising gives every measure equal weight; a measure that matters more to the business is not weighted more here.",
"The silhouette picks the k the data supports best, which is not always the k the business finds useful; set module_parameters$k to override.",
"Segments describe the rows given; a new row is placed by nearest centre and may sit between segments.",
if (n_imputed > 0) paste0(n_imputed, " blank or non-finite cells were filled with column medians, which pulls those rows toward the centre.") else
"No blank cells were filled.")))
objects <- list() # filled by the object layer, not here
list(answer = answer, method = method, n = n_used, results = results, objects = objects,
json_output = list(answer = answer, method = method, n = n_used))
}