Standard Correspondence
Executive Summary

Executive Summary

How 'Contract' and 'PaymentMethod' map together

Observations
7043
Table Size
3 × 4
Total Inertia
0.1422
Chi-Square
1001.58
P Value
< 0.001
Cramér's V
0.267
Dim 1+2 Inertia
100.0%
Association
associated (weak)
Across 7,043 observations in a 3 × 4 table, 'Contract' and 'PaymentMethod' are associated (chi-square 1001.58, p < 0.001; Cramér's V 0.267, weak). Total inertia is 0.1422, of which dimension 1 carries 100.0% and the drawn plane 100.0%. Dimension 1 runs from Month-to-month to Two year on the 'Contract' side and from Electronic check to Credit card (automatic) on the 'PaymentMethod' side. The strongest single over-representation is Month-to-month × Electronic check, seen 1,850 times against 1,301.2 expected under independence. On the map, Month-to-month and Electronic check lie in the same direction from the origin, which is how that over-representation shows up visually. Every plotted category has at least 100.0% of its variation captured by these two dimensions. Read row-to-row and column-to-column distances, and direction from the origin — the gap between a point of 'Contract' and a point of 'PaymentMethod' is not a measure of association.
What this means

Payment methods and contract types are weakly but significantly associated: Month-to-month contracts pair with Electronic check payments 1,850 times (548 more than independence predicts), while Two year contracts cluster with Credit card (automatic). Dimension 1 captures 100.0% of the association, running from short-term to long-term contracts on one axis and from manual to automatic payments on the other. All categories are well-represented on the map (100.0% quality), but the distance between a contract point and a payment point is not a measure of how strongly they go together—read direction from the origin instead.

Overview

Analysis Overview

Correspondence analysis of 'Contract' by 'PaymentMethod' across 7,043 observations.

N Observations7043
N Row Categories3
N Col Categories4
N Dimensions2
What this means

Correspondence analysis maps the relationship between contract types and payment methods across 7,043 observations by decomposing a chi-square test into independent dimensions. Rather than answering only whether the two variables are related, this method shows how they are related by giving every category a coordinate on a shared map. The chi-square test rejects independence (p < 0.001), confirming there is a real pattern to visualize. Importantly, this analysis describes association—categories occurring together more or less often than chance would predict—not causation, since an unmeasured third factor could produce the same pattern.

Data Preparation

Data Quality

Blank recoding, rare-category pooling, and the resulting table size.

Initial Rows7043
Final Rows7043
Rows Removed0
Rare Threshold71
Categories Pooled0
What this means

All 7,043 rows entered the analysis without loss. The rare-category threshold of 71 observations (the larger of 5% of the data and 1) was applied to prevent isolated categories from distorting the map through sampling noise alone, but no categories fell below that threshold. Both 'Contract' and 'PaymentMethod' columns were complete with no blanks requiring recoding. The resulting 3 × 4 contingency table contains all observed data in its original form, ensuring the map reflects the full distribution without artificial pooling or removal.

Visualization

Correspondence Biplot

'Contract' and 'PaymentMethod' categories on one map.

What this means

The map shows 3 contract types and 4 payment methods on a single pair of axes, with the origin representing the average profile. Dimension 1 (horizontal) carries 100.0% of the total inertia, creating a tight horizontal pattern: Month-to-month and Electronic check cluster at the negative end, while Two year and Credit card (automatic) cluster at the positive end. One year and Mailed check sit near the centre. Two year is the most distinctive category, furthest from the origin. The plane captures 100.0% of the association in the table. Critically, the gap between a contract point and a payment point is not interpretable as association strength because the two variable sets are scaled independently; instead, read categories that share direction from the origin—they occur together more often than expected.

Visualization

Dimensions and Inertia Explained

How the total inertia of 0.1422 splits across 2 dimension(s).

What this means

The table's total inertia of 0.1422 splits into two dimensions. Dimension 1 explains 100.0% and Dimension 2 explains 0.0%, making the two-dimensional plane a faithful summary of all association in the table. The absence of meaningful variation on Dimension 2 reflects the fact that the primary pattern is one-dimensional: contract length and payment method automation run along a single axis. Inertia is chi-square divided by sample size, so these percentages partition the same quantity the independence test measures. Nothing is hidden off the plane.

Data Table

Is There Anything to Map?

The test of independence and the total inertia the map divides up.

MeasureValueInterpretation
Total inertia0.1422Chi-square divided by the 7,043 observations — the total amount of association the map splits up.
Chi-square statistic1001.58How far the observed table sits from the counts independence would predict.
Degrees of freedom6(3 - 1) × (4 - 1).
P-value< 0.001Independence is rejected at the 0.05 level, so there is a real pattern to map.
Cramér's V0.267Association strength is weak (0 = none, 1 = perfect; below 0.1 negligible, 0.1 to 0.3 weak, 0.3 to 0.5 moderate, above 0.5 strong).
Dimensions available2min(rows, columns) - 1 = 2 independent dimensions carry all of the inertia.
Inertia on dimensions 1 and 2100.0%The share of the association visible on the drawn map; the rest lives on 0 dimension(s) that are not drawn.
What this means

The chi-square test yields 1001.58 on 6 degrees of freedom (p < 0.001), rejecting independence and confirming a real pattern exists. Total inertia is 0.1422 and Cramér's V is 0.267, indicating weak association strength. This distinction matters: with 7,043 observations, even a weak association clears the significance threshold, so the map shows a real but small effect. The weak strength (V = 0.267 falls in the 0.1–0.3 range) means contract type explains only a small portion of payment method variation and vice versa, though the pattern is statistically reliable.

Data Table

Which Points Can Be Trusted

Per-category contribution to each dimension and quality of representation.

VariableCategoryMass PCTDim 1Dim 2Contribution Dim1 PCTContribution Dim2 PCTQuality PCTReliability
ContractMonth-to-month55.02-0.3272-0.000541.43.6100well represented
ContractTwo year24.070.5476-0.002250.825.2100well represented
ContractOne year20.910.23060.00397.871.3100well represented
PaymentMethodElectronic check33.58-0.4859-0.000755.73.9100well represented
PaymentMethodMailed check22.89-0.00870.0027035.8100well represented
PaymentMethodBank transfer (automatic)21.920.3543-0.003219.449100well represented
PaymentMethodCredit card (automatic)21.610.40470.001524.911.2100well represented
What this means

All seven categories are well-represented on the map. Two year contributes 50.8% of Dimension 1 on the Contract side and Electronic check contributes 55.7% on the PaymentMethod side, making them the dominant points. Month-to-month achieves 100.0% quality (best representation of its profile), and even Credit card (automatic), the lowest, reaches 100.0%. No category falls below 40% quality, so every plotted position reliably reflects that category's actual distribution across the other variable. A point far from the origin is not automatically trustworthy in other analyses, but here all distances are backed by good representation.

Data Table

Reading the Biplot — and the One Rule Everyone Breaks

What each distance and direction on the 'Contract' by 'PaymentMethod' map does and does not mean.

RuleDetail
Distance between two 'Contract' pointsInterpretable. Two 'Contract' categories that sit close together have similar profiles across 'PaymentMethod'.
Distance between two 'PaymentMethod' pointsInterpretable. Two 'PaymentMethod' categories that sit close together have similar profiles across 'Contract'.
Distance from a point of 'Contract' to a point of 'PaymentMethod'NOT interpretable as association strength. This is a symmetric map: each set of categories is scaled to its own inertia, so a short gap between a point of 'Contract' and a point of 'PaymentMethod' does not mean they go together. This is the mistake almost every reader makes.
Direction from the originInterpretable. A category of 'Contract' and a category of 'PaymentMethod' that lie in the same direction from the origin — a small angle at the origin — occur together more than independence predicts; opposite directions mean they occur together less.
Distance from the originInterpretable. The further a category sits from the origin, the more its profile departs from the average profile. A category at the origin is simply average.
How much of the map is realDimensions 1 and 2 carry 100.0% of the total inertia of 0.1422. What is not on this plane cannot be seen on it.
Points you should not interpretEvery plotted category has at least 100.0% of its variation captured by these two dimensions, so all drawn positions carry meaning.
Pooled categoriesNo categories were pooled: every level of 'Contract' and 'PaymentMethod' carried at least 71 observations and is plotted on its own.
MethodClassical correspondence analysis: the standardized residual matrix of the 3 × 4 table is decomposed by singular value decomposition, and both sets of categories are drawn in principal coordinates.
What this means

Within each variable, distances are interpretable: Two year and One year sit relatively close together (similar PaymentMethod profiles), as do Bank transfer (automatic) and Credit card (automatic) (similar Contract profiles). Direction from the origin is the key rule: Month-to-month and Electronic check point the same way (negative Dimension 1), and their standardized residual of 27.83 confirms they occur together far more than independence predicts. Two year and Credit card (automatic) point the same way (positive Dimension 1) with a standardized residual of 14.54. The distance between a Contract point and a PaymentMethod point is NOT a measure of association—this symmetric map scales each variable independently, so that gap mixes two different yardsticks. No categories were pooled, and all 100.0% of inertia is on the drawn plane.

Rate this report Was this the answer you needed?
The exact source that produced this report — yours to keep, read, and re-run.
Download PDF
How this was computed method · R source · citation
The code that did it

Correspondence Analysis — How Two Categorical Variables Map Together

Builds the two-way contingency table from two mapped categorical columns (or from a pre-aggregated count column), decomposes its chi-square residuals by singular value decomposition, and places both sets of categories on one map: the biplot.

Why This Method?

A chi-square test answers WHETHER two categorical variables are related. Correspondence analysis answers HOW: it splits the table's total inertia (chi-square divided by the sample size) into independent dimensions and gives every category a coordinate, so the pattern behind a significant test becomes readable instead of merely certain.

What This Analysis Covers

  • Total inertia and the chi-square test of independence
  • The dimension (scree) table with the share of inertia each explains
  • Row and column coordinates on the first two dimensions
  • The symmetric biplot with both sets of categories on one map
  • Per-category contribution and quality of representation (cos-squared)
  • The reading rules, including the row-to-column distance trap

Standard Library

Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {row_var, col_var, count}. All narrative is derived from the user's own column names and computed values. The decomposition uses base svd only — no correspondence-analysis package is required.

suppressPackageStartupMessages(library(DT))
suppressPackageStartupMessages(library(htmlwidgets))
suppressPackageStartupMessages(library(arrow))
suppressPackageStartupMessages(library(knitr))
suppressPackageStartupMessages(library(rmarkdown))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(tidyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(stringr))
suppressPackageStartupMessages(library(lubridate))
suppressPackageStartupMessages(library(broom))
suppressPackageStartupMessages(library(Matrix))
suppressPackageStartupMessages(library(cluster))
suppressPackageStartupMessages(library(data.table))

Formatting helpers — prose must never carry e-notation or bare asterisks

Core Analysis Pipeline

compute_shared <- function(df, params, col_map = list()) {
  # === SHARED EXPORTS ===
  #   initial_rows/final_rows/rows_removed $ row accounting
  #   name_row / name_col / name_count  $ humanized user column names
  #   has_count                         $ logical — pre-aggregated input used
  #   tab                               $ contingency table (rows x cols)
  #   n_obs                             $ total observations (sum of counts)
  #   levels_row / levels_col           $ level labels in the table
  #   n_missing_row/_col                $ blanks recoded to "Missing"
  #   n_lumped_row/_col                 $ levels folded into "Other"
  #   w_lumped_row/_col                 $ observations behind those levels
  #   rare_min                          $ the stated lumping threshold
  #   eig_df                            $ dimension/scree table
  #   n_dims / lam / total_inertia      $ decomposition
  #   pct_plane                         $ % inertia on dimensions 1 and 2
  #   coords_row / coords_col           $ principal coordinates (matrices)
  #   biplot_df                         $ dim_1, dim_2, point_type, category, ...
  #   point_quality_df                  $ per-category contribution + cos2
  #   assoc_df                          $ inertia / chi-square / Cramer's V table
  #   reading_df                        $ the reading rules, computed
  #   chi_stat/chi_df/chi_p             $ chi-square test of independence
  #   cramers_v / strength_band         $ effect size + band (sibling vocabulary)
  #   significant / map_interpretable   $ logical
  #   pct_low_expected                  $ % of cells with expected count < 5
  #   top_over                          $ 1-row df — strongest over-representation
  #   same_direction / top_cos_angle    $ biplot direction check for that cell
  #   low_quality_labels                $ categories whose position is unreliable
  #   d1_neg/_pos, c1_neg/_pos          $ the poles of dimension 1
  #   metrics / json_output
  # === /SHARED EXPORTS ===

Step 1: Discover the mapped columns

initial_rows <- nrow(df)
  for (k in c("row_var", "col_var")) {
    if (!k %in% names(df)) {
      stop(sprintf("column_mapping must map &#x27;%s' to a categorical column.", k))
    }
  }
  name_row <- humanize_semantic("row_var", col_map)
  name_col <- humanize_semantic("col_var", col_map)
  has_count <- "count" %in% names(df)
  name_count <- if (has_count) humanize_semantic("count", col_map) else NA_character_

Step 2: Weights — one per row, or the mapped count column

The count column is coerced with the 95% rule; a column that fails it is refused by name rather than silently treated as 1-per-row.

if (has_count) {
    cv <- df[["count"]]
    if (!is.numeric(cv)) {
      conv <- suppressWarnings(as.numeric(as.character(cv)))
      n_orig <- sum(!is.na(cv) & as.character(cv) != "")
      if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) {
        cv <- conv
      } else {
        stop(sprintf(paste0("&#x27;%s' was mapped as the count column but it is not numeric ",
                            "(only %d of %d non-blank values convert to a number). ",
                            "Map a numeric count column, or leave it unmapped so that ",
                            "each row counts as one observation."),
                     name_count, sum(!is.na(conv)), n_orig))
      }
    }
    cv <- as.numeric(cv)
    cv[is.na(cv)] <- 0
    if (any(cv < 0)) {
      stop(sprintf("&#x27;%s' contains negative counts — a contingency table needs counts of zero or more.",
                   name_count))
    }
    w <- cv
  } else {
    w <- rep(1, initial_rows)
  }

  keep_rows <- w > 0
  a_raw <- df[["row_var"]][keep_rows]
  b_raw <- df[["col_var"]][keep_rows]
  w <- w[keep_rows]
  n_obs <- sum(w)

Step 3: Minimum size — named for the user's own columns

if (n_obs < 30) {
    stop(sprintf(paste0("Only %s observation(s) available across &#x27;%s' and '%s' — ",
                        "correspondence analysis needs at least 30. A table built from ",
                        "fewer observations gives coordinates that move substantially ",
                        "with a handful of rows."),
                 format(round(n_obs), big.mark = ","), name_row, name_col))
  }

Step 4: Identifier guard — a near-unique column is not a category

guard_identifier <- function(x, nm) {
    nl <- length(unique(trimws(as.character(x))))
    if (nl > 20 && nl > 0.5 * length(x)) {
      stop(sprintf(paste0("&#x27;%s' has %s distinct values across %s rows — that is an ",
                          "identifier, not a category. Correspondence analysis needs two ",
                          "columns with a modest number of repeated categories."),
                   nm, format(nl, big.mark = ","), format(length(x), big.mark = ",")))
    }
  }
  guard_identifier(a_raw, name_row)
  guard_identifier(b_raw, name_col)

Step 5: Clean and lump — blanks become "Missing"; rare levels become

"Other" against a stated threshold, because a category carried by a handful of observations lands far from the origin on noise alone and distorts the whole decomposition.

rare_min <- max(5, ceiling(0.01 * n_obs))
  max_levels <- 8

  prep_categorical <- function(x, wts, nm) {
    x <- trimws(as.character(x))
    blank <- is.na(x) | x == ""
    n_missing <- sum(wts[blank])
    x[blank] <- "Missing"
    tw <- tapply(wts, x, sum)
    tw <- tw[order(-tw)]
    n_raw_levels <- length(tw)
    rare <- names(tw)[tw < rare_min]
    keep <- setdiff(names(tw), rare)
    if (length(keep) > max_levels) {
      rare <- c(rare, keep[(max_levels + 1):length(keep)])
      keep <- keep[seq_len(max_levels)]
    }
    n_lumped <- length(rare)
    w_lumped <- if (n_lumped > 0) sum(tw[rare]) else 0
    if (n_lumped >= n_raw_levels) {
      stop(sprintf(paste0("Every one of the %d categories in &#x27;%s' carries fewer than %d ",
                          "observations, so there is nothing left to compare once rare ",
                          "levels are pooled. Use a coarser grouping of &#x27;%s'."),
                   n_raw_levels, nm, rare_min, nm))
    }
    if (n_lumped > 0) x[x %in% rare] <- "Other"
    tw2 <- tapply(wts, x, sum)
    tw2 <- tw2[order(-tw2)]
    lv <- names(tw2)
    special <- intersect(c("Other", "Missing"), lv)
    lv <- c(setdiff(lv, special), special)
    list(x = factor(x, levels = lv), n_missing = n_missing,
         n_lumped = n_lumped, w_lumped = w_lumped, n_raw_levels = n_raw_levels)
  }

  pa <- prep_categorical(a_raw, w, name_row)
  pb <- prep_categorical(b_raw, w, name_col)

Step 6: Degeneracy — a map needs at least a 3 x 3 table

A two-category column produces exactly one dimension, and a one-category column produces none; neither can be drawn as a two-dimensional map.

check_width <- function(p, nm) {
    k <- nlevels(p$x)
    if (k < 2) {
      stop(sprintf(paste0("&#x27;%s' has only one distinct value (%s) after cleaning — ",
                          "correspondence analysis compares how categories differ from ",
                          "each other, so it needs at least three in each column."),
                   nm, levels(p$x)[1]))
    }
    if (k < 3) {
      stop(sprintf(paste0("&#x27;%s' has only two categories (%s) after cleaning. A two-category ",
                          "column yields a single dimension, so there is no two-dimensional ",
                          "map to draw; test the association directly instead of mapping it."),
                   nm, oxford(levels(p$x))))
    }
  }
  check_width(pa, name_row)
  check_width(pb, name_col)

  final_rows <- length(pa$x)
  rows_removed <- initial_rows - final_rows

Step 7: Contingency table

tab <- tapply(w, list(pa$x, pb$x), sum)
  tab[is.na(tab)] <- 0
  tab <- as.matrix(tab)
  dimnames(tab) <- list(levels(pa$x), levels(pb$x))

Structural empties cannot enter the decomposition (their inverse mass is undefined); drop them and re-check the size.

keep_r <- rowSums(tab) > 0
  keep_c <- colSums(tab) > 0
  tab <- tab[keep_r, keep_c, drop = FALSE]
  if (nrow(tab) < 3 || ncol(tab) < 3) {
    stop(sprintf(paste0("The table of &#x27;%s' by '%s' collapsed to %d x %d once empty ",
                        "categories were removed — a map needs at least 3 x 3."),
                 name_row, name_col, nrow(tab), ncol(tab)))
  }
  levels_row <- rownames(tab)
  levels_col <- colnames(tab)
  n <- sum(tab)

Step 8: Chi-square test of independence — the same test the

categorical-association tool runs, reported here so the map is never read without knowing whether there is anything to read.

chi <- suppressWarnings(chisq.test(tab, correct = FALSE))
  chi_stat <- as.numeric(chi$statistic)
  chi_df   <- as.numeric(chi$parameter)
  chi_p    <- as.numeric(chi$p.value)
  expected <- chi$expected
  pct_low_expected <- 100 * mean(expected < 5)
  significant <- !is.na(chi_p) && chi_p < 0.05

Step 9: The decomposition — standardized residuals by base svd

P is the correspondence matrix, r and c the row and column masses, and S the matrix of standardized residuals whose squared singular values are the principal inertias. No correspondence-analysis package is used.

P  <- tab / n
  rm_ <- rowSums(P)
  cm_ <- colSums(P)
  S  <- sweep(sweep(P - outer(rm_, cm_), 1, 1 / sqrt(rm_), "*"),
              2, 1 / sqrt(cm_), "*")
  sv <- svd(S)
  n_dims <- min(nrow(tab), ncol(tab)) - 1
  d   <- sv$d[seq_len(n_dims)]
  lam <- d^2
  total_inertia <- sum(lam)

Total inertia is chi-square divided by the sample size — this identity is what ties the map back to the test.

coords_row <- sweep(sv$u[, seq_len(n_dims), drop = FALSE] %*%
                        diag(d, n_dims, n_dims), 1, 1 / sqrt(rm_), "*")
  coords_col <- sweep(sv$v[, seq_len(n_dims), drop = FALSE] %*%
                        diag(d, n_dims, n_dims), 1, 1 / sqrt(cm_), "*")
  rownames(coords_row) <- levels_row
  rownames(coords_col) <- levels_col

Singular-vector signs are arbitrary; orient each dimension so its most extreme row category is positive, which makes the output reproducible.

for (k in seq_len(n_dims)) {
    ix <- which_extreme(abs(coords_row[, k]), largest = TRUE)
    if (!is.na(ix) && coords_row[ix, k] < 0) {
      coords_row[, k] <- -coords_row[, k]
      coords_col[, k] <- -coords_col[, k]
    }
  }

Step 10: Contributions and quality of representation

Contribution: how much of a dimension's inertia one category creates. cos-squared: how much of a category's own distance from the average profile that dimension captures — the honest measure of whether the point's drawn position means anything.

contrib <- function(coords, mass) {
    out <- matrix(NA_real_, nrow(coords), ncol(coords),
                  dimnames = dimnames(coords))
    for (k in seq_len(ncol(coords))) {
      if (is.finite(lam[k]) && lam[k] > 1e-12) {
        out[, k] <- 100 * mass * coords[, k]^2 / lam[k]
      }
    }
    out
  }
  cos2 <- function(coords) {
    d2 <- rowSums(coords^2)
    out <- matrix(NA_real_, nrow(coords), ncol(coords),
                  dimnames = dimnames(coords))
    ok <- is.finite(d2) & d2 > 1e-12
    if (any(ok)) out[ok, ] <- 100 * coords[ok, , drop = FALSE]^2 / d2[ok]
    out
  }
  ctr_row  <- contrib(coords_row, rm_)
  ctr_col  <- contrib(coords_col, cm_)
  cos2_row <- cos2(coords_row)
  cos2_col <- cos2(coords_col)

  pct_dim <- 100 * lam / total_inertia
  pct_plane <- if (n_dims >= 2) sum(pct_dim[1:2]) else pct_dim[1]
  dim2_idx <- if (n_dims >= 2) 2 else 1

  eig_df <- data.frame(
    dimension    = paste("Dimension", seq_len(n_dims)),
    pct_inertia  = round(pct_dim, 2),
    eigenvalue   = round(lam, 5),
    cumulative_pct = round(cumsum(pct_dim), 2),
    stringsAsFactors = FALSE
  )

Step 11: Biplot points — both sets of categories, one map

quality_plane_row <- if (n_dims >= 2) rowSums(cos2_row[, 1:2, drop = FALSE])
                       else cos2_row[, 1]
  quality_plane_col <- if (n_dims >= 2) rowSums(cos2_col[, 1:2, drop = FALSE])
                       else cos2_col[, 1]

  biplot_df <- rbind(
    data.frame(
      dim_1 = round(coords_row[, 1], 4),
      dim_2 = round(coords_row[, dim2_idx], 4),
      point_type = name_row,
      category = levels_row,
      mass_pct = round(100 * rm_, 2),
      quality_pct = round(quality_plane_row, 1),
      stringsAsFactors = FALSE
    ),
    data.frame(
      dim_1 = round(coords_col[, 1], 4),
      dim_2 = round(coords_col[, dim2_idx], 4),
      point_type = name_col,
      category = levels_col,
      mass_pct = round(100 * cm_, 2),
      quality_pct = round(quality_plane_col, 1),
      stringsAsFactors = FALSE
    )
  )
  rownames(biplot_df) <- NULL

  point_quality_df <- data.frame(
    variable    = biplot_df$point_type,
    category    = biplot_df$category,
    mass_pct    = biplot_df$mass_pct,
    dim_1       = biplot_df$dim_1,
    dim_2       = biplot_df$dim_2,
    contribution_dim1_pct = round(c(ctr_row[, 1], ctr_col[, 1]), 1),
    contribution_dim2_pct = round(c(ctr_row[, dim2_idx], ctr_col[, dim2_idx]), 1),
    quality_pct = biplot_df$quality_pct,
    stringsAsFactors = FALSE
  )
  point_quality_df$reliability <- ifelse(
    is.na(point_quality_df$quality_pct), "not computable",
    ifelse(point_quality_df$quality_pct >= 70, "well represented",
    ifelse(point_quality_df$quality_pct >= 40, "partly represented",
           "poorly represented — do not interpret its position")))
  point_quality_df <- point_quality_df[order(-point_quality_df$quality_pct), ,
                                       drop = FALSE]
  rownames(point_quality_df) <- NULL

  low_quality_labels <- point_quality_df$category[
    !is.na(point_quality_df$quality_pct) & point_quality_df$quality_pct < 40]
  min_quality <- if (all(is.na(point_quality_df$quality_pct))) NA_real_
                 else min(point_quality_df$quality_pct, na.rm = TRUE)

Step 12: Poles of dimension 1 — what the main axis separates

pole <- function(coords) {
    hi <- which_extreme(coords[, 1], largest = TRUE)
    lo <- which_extreme(coords[, 1], largest = FALSE)
    list(pos = if (is.na(hi)) NA_character_ else rownames(coords)[hi],
         neg = if (is.na(lo)) NA_character_ else rownames(coords)[lo])
  }
  pr <- pole(coords_row)
  pc <- pole(coords_col)

Step 13: The strongest single over-representation — the sibling

tool's vocabulary (standardized residuals) reused deliberately.

obs_long <- as.data.frame(as.table(tab), stringsAsFactors = FALSE)
  names(obs_long) <- c("level_row", "level_col", "observed")
  exp_long <- as.data.frame(as.table(expected), stringsAsFactors = FALSE)
  std_long <- as.data.frame(as.table(chi$stdres), stringsAsFactors = FALSE)
  dev_all <- data.frame(
    level_row = obs_long$level_row, level_col = obs_long$level_col,
    cell = paste0(obs_long$level_row, " × ", obs_long$level_col),
    observed = obs_long$observed,
    expected = round(exp_long$Freq, 1),
    std_residual = round(std_long$Freq, 2),
    stringsAsFactors = FALSE
  )
  dev_all <- dev_all[is.finite(dev_all$std_residual), , drop = FALSE]
  ix_over <- which_extreme(dev_all$std_residual, largest = TRUE)
  top_over <- if (!is.na(ix_over) && dev_all$std_residual[ix_over] > 0)
    dev_all[ix_over, , drop = FALSE] else NULL

Direction check for that cell: in a symmetric map a row and a column category that go together point the same way from the origin. The cosine of the angle between the two position vectors is the computable form of that reading.

same_direction <- NA
  top_cos_angle <- NA_real_
  if (!is.null(top_over)) {
    vr <- coords_row[top_over$level_row, c(1, dim2_idx)]
    vc <- coords_col[top_over$level_col, c(1, dim2_idx)]
    den <- sqrt(sum(vr^2)) * sqrt(sum(vc^2))
    if (is.finite(den) && den > 1e-12) {
      top_cos_angle <- sum(vr * vc) / den
      same_direction <- top_cos_angle > 0
    }
  }

Whether the two positive poles (and the two negative poles) genuinely co-occur more than independence predicts. Checked against the standardized residual of those two cells rather than asserted from the picture — the whole point of this tool is that the picture can mislead.

resid_of <- function(rl, cl) {
    if (is.na(rl) || is.na(cl)) return(NA_real_)
    ix <- which(dev_all$level_row == rl & dev_all$level_col == cl)
    if (length(ix) == 1) dev_all$std_residual[ix] else NA_real_
  }
  pole_pos_resid <- resid_of(pr$pos, pc$pos)
  pole_neg_resid <- resid_of(pr$neg, pc$neg)
  poles_agree <- !is.na(pole_pos_resid) && !is.na(pole_neg_resid) &&
                 pole_pos_resid > 0 && pole_neg_resid > 0

Step 14: Association strength — Cramer's V, same bands as the sibling

cramers_v <- sqrt(total_inertia / (min(dim(tab)) - 1))
  strength_band <- if (is.na(cramers_v)) "unknown"
    else if (cramers_v < 0.1) "negligible"
    else if (cramers_v < 0.3) "weak"
    else if (cramers_v < 0.5) "moderate"
    else "strong"

The map is only worth reading if the table departs from independence.

map_interpretable <- significant

  assoc_df <- data.frame(
    measure = c("Total inertia", "Chi-square statistic", "Degrees of freedom",
                "P-value", "Cramér&#x27;s V", "Dimensions available",
                "Inertia on dimensions 1 and 2"),
    value = c(fmt_num(total_inertia), fmt_num(chi_stat, 2),
              format(chi_df), p_display(chi_p),
              fmt_num(cramers_v, 3), format(n_dims), fmt_pct(pct_plane)),
    interpretation = c(
      paste0("Chi-square divided by the ", format(round(n), big.mark = ","),
             " observations — the total amount of association the map splits up."),
      "How far the observed table sits from the counts independence would predict.",
      paste0("(", nrow(tab), " - 1) × (", ncol(tab), " - 1)."),
      if (significant)
        "Independence is rejected at the 0.05 level, so there is a real pattern to map."
      else
        "Independence is not rejected at the 0.05 level, so the map shows sampling noise.",
      paste0("Association strength is ", strength_band,
             " (0 = none, 1 = perfect; below 0.1 negligible, 0.1 to 0.3 weak, ",
             "0.3 to 0.5 moderate, above 0.5 strong)."),
      paste0("min(rows, columns) - 1 = ", n_dims,
             " independent dimensions carry all of the inertia."),
      paste0("The share of the association visible on the drawn map; the rest lives on ",
             max(0, n_dims - 2), " dimension(s) that are not drawn.")
    ),
    stringsAsFactors = FALSE
  )

Step 15: The reading rules, written with the user's own column names

unreliable_rule <- if (length(low_quality_labels) > 0) {
    paste0(length(low_quality_labels), " categor",
           if (length(low_quality_labels) == 1) "y is" else "ies are",
           " represented by less than 40% on this plane(",
           oxford(low_quality_labels),
           "). Their drawn positions are mostly an artefact of dimensions that are ",
           "not shown — do not read them.")
  } else {
    paste0("Every plotted category has at least ", fmt_pct(min_quality),
           " of its variation captured by these two dimensions, so all drawn ",
           "positions carry meaning.")
  }
  other_rule <- if (pa$n_lumped > 0 || pb$n_lumped > 0) {
    paste0("The \"Other\" point is a pooled mixture of ",
           pa$n_lumped + pb$n_lumped,
           " rare categories, so its position is an average of unlike things and ",
           "should not be interpreted as a category in its own right.")
  } else {
    paste0("No categories were pooled: every level of &#x27;", name_row, "' and '",
           name_col, "&#x27; carried at least ", rare_min,
           " observations and is plotted on its own.")
  }
  reading_df <- data.frame(
    rule = c(
      paste0("Distance between two &#x27;", name_row, "' points"),
      paste0("Distance between two &#x27;", name_col, "' points"),
      paste0("Distance from a point of &#x27;", name_row, "' to a point of '", name_col, "'"),
      "Direction from the origin",
      "Distance from the origin",
      "How much of the map is real",
      "Points you should not interpret",
      "Pooled categories",
      "Method"
    ),
    detail = c(
      paste0("Interpretable. Two &#x27;", name_row,
             "&#x27; categories that sit close together have similar profiles across '",
             name_col, "&#x27;."),
      paste0("Interpretable. Two &#x27;", name_col,
             "&#x27; categories that sit close together have similar profiles across '",
             name_row, "&#x27;."),
      paste0("NOT interpretable as association strength. This is a symmetric map: ",
             "each set of categories is scaled to its own inertia, so a short gap ",
             "between a point of &#x27;", name_row, "' and a point of '", name_col,
             "&#x27; does not mean they go together. This is the mistake almost ",
             "every reader makes."),
      paste0("Interpretable. A category of &#x27;", name_row, "' and a category of '", name_col,
             "&#x27; that lie in the same direction from the origin — a small ",
             "angle at the origin — occur together more than independence predicts; ",
             "opposite directions mean they occur together less."),
      paste0("Interpretable. The further a category sits from the origin, the more ",
             "its profile departs from the average profile. A category at the origin ",
             "is simply average."),
      paste0("Dimensions 1 and 2 carry ", fmt_pct(pct_plane),
             " of the total inertia of ", fmt_num(total_inertia),
             ". What is not on this plane cannot be seen on it."),
      unreliable_rule,
      other_rule,
      paste0("Classical correspondence analysis: the standardized residual matrix ",
             "of the ", nrow(tab), " × ", ncol(tab),
             " table is decomposed by singular value decomposition, and both sets ",
             "of categories are drawn in principal coordinates.")
    ),
    stringsAsFactors = FALSE
  )

  metrics <- list(
    `Observations`      = as.integer(round(n)),
    `Table Size`        = paste0(nrow(tab), " × ", ncol(tab)),
    `Total Inertia`     = round(total_inertia, 4),
    `Chi-Square`        = round(chi_stat, 2),
    `P Value`           = p_display(chi_p),
    `Cramér&#x27;s V`        = round(cramers_v, 3),
    `Dim 1+2 Inertia`   = fmt_pct(pct_plane),
    `Association`       = if (significant) paste0("associated(", strength_band, ")")
                          else "not associated"
  )

  answer <- if (map_interpretable) {
    paste0(
      "Correspondence analysis of &#x27;", name_row, "' by '", name_col, "' over ",
      format(round(n), big.mark = ","), " observations in a ", nrow(tab), " × ",
      ncol(tab), " table: total inertia ", fmt_num(total_inertia),
      " (chi-square ", fmt_num(chi_stat, 2), ", ", p_phrase(chi_p),
      "; Cramér&#x27;s V ", fmt_num(cramers_v, 3), ", ", strength_band,
      "). Dimension 1 carries ", fmt_pct(pct_dim[1]),
      " of that inertia and separates ", pr$neg, " from ", pr$pos, " on the &#x27;",
      name_row, "&#x27; side and ", pc$neg, " from ", pc$pos, " on the '", name_col,
      "&#x27; side; dimensions 1 and 2 together show ", fmt_pct(pct_plane), ".",
      if (!is.null(top_over)) paste0(
        " The strongest over-representation is ", top_over$cell, " (",
        format(round(top_over$observed), big.mark = ","), " observed vs ",
        format(top_over$expected, big.mark = ","), " expected).") else "",
      " Read the map by direction from the origin: in a symmetric map the distance ",
      "from a point of &#x27;", name_row, "' to a point of '", name_col,
      "&#x27; is not a measure of how strongly they go together."
    )
  } else {
    paste0(
      "Correspondence analysis of &#x27;", name_row, "' by '", name_col, "' over ",
      format(round(n), big.mark = ","), " observations in a ", nrow(tab), " × ",
      ncol(tab), " table finds no association to map: total inertia is only ",
      fmt_num(total_inertia), " and the chi-square test of independence does not ",
      "reject independence(", p_phrase(chi_p), "; Cramér&#x27;s V ",
      fmt_num(cramers_v, 3), ", ", strength_band,
      "). The coordinates still exist and are still plotted, but they describe ",
      "sampling noise rather than structure and should not be interpreted."
    )
  }

  json_output <- list(
    answer = answer,
    cards = lapply(
      c("tldr", "overview", "preprocessing", "biplot", "dimension_summary",
        "association_summary", "point_quality", "reading_the_map"),
      function(cid) list(id = cid, metrics = metrics)
    )
  )

  list(
    initial_rows = initial_rows, final_rows = final_rows,
    rows_removed = rows_removed,
    name_row = name_row, name_col = name_col, name_count = name_count,
    has_count = has_count,
    tab = tab, n_obs = n, levels_row = levels_row, levels_col = levels_col,
    n_missing_row = pa$n_missing, n_missing_col = pb$n_missing,
    n_lumped_row = pa$n_lumped, n_lumped_col = pb$n_lumped,
    w_lumped_row = pa$w_lumped, w_lumped_col = pb$w_lumped,
    n_raw_levels_row = pa$n_raw_levels, n_raw_levels_col = pb$n_raw_levels,
    rare_min = rare_min, max_levels = max_levels,
    eig_df = eig_df, n_dims = n_dims, lam = lam, pct_dim = pct_dim,
    total_inertia = total_inertia, pct_plane = pct_plane,
    coords_row = coords_row, coords_col = coords_col,
    biplot_df = biplot_df, point_quality_df = point_quality_df,
    assoc_df = assoc_df, reading_df = reading_df,
    chi_stat = chi_stat, chi_df = chi_df, chi_p = chi_p,
    pct_low_expected = pct_low_expected,
    cramers_v = cramers_v, strength_band = strength_band,
    significant = significant, map_interpretable = map_interpretable,
    top_over = top_over, same_direction = same_direction,
    top_cos_angle = top_cos_angle,
    pole_pos_resid = pole_pos_resid, pole_neg_resid = pole_neg_resid,
    poles_agree = poles_agree,
    low_quality_labels = low_quality_labels, min_quality = min_quality,
    d1_pos = pr$pos, d1_neg = pr$neg, c1_pos = pc$pos, c1_neg = pc$neg,
    metrics = metrics, json_output = json_output
  )
}

Row and column contributions each sum to 100% within their own variable, so the top contributor is reported per variable — pooling the two would compare shares of two different totals.

top_of <- function(v) {
    sub <- pq[pq$variable == v, , drop = FALSE]
    sub[order(-sub$contribution_dim1_pct), , drop = FALSE][1, , drop = FALSE]
  }
  top_r <- top_of(shared$name_row)
  top_c <- top_of(shared$name_col)
  n_poor <- sum(!is.na(pq$quality_pct) & pq$quality_pct < 40)

  list(
    title = "Which Points Can Be Trusted",
    description = "Per-category contribution to each dimension and quality of representation.",
    text = paste0(
      "Two numbers decide whether a point&#x27;s position means anything. ",
      "Contribution says how much of a dimension that category creates; the ",
      "&#x27;", shared$name_row, "' categories account for 100% of each dimension ",
      "between them and the &#x27;", shared$name_col,
      "&#x27; categories independently account for another 100%, so they are read ",
      "within a variable, not across the two. On dimension 1 that is ",
      top_r$category, " at ", fmt_pct(top_r$contribution_dim1_pct), " of the &#x27;",
      shared$name_row, "&#x27; side and ", top_c$category, " at ",
      fmt_pct(top_c$contribution_dim1_pct), " of the &#x27;", shared$name_col,
      "&#x27; side. Quality (cos-squared) says how much of a category's own ",
      "distance from the average profile these two dimensions capture — ",
      best$category, " is best represented at ", fmt_pct(best$quality_pct),
      ", while ", worst$category, " is worst at ", fmt_pct(worst$quality_pct), ". ",
      if (n_poor > 0)
        paste0(n_poor, " categor", if (n_poor == 1) "y falls" else "ies fall",
               " below 40% and ", if (n_poor == 1) "is" else "are",
               " marked as not interpretable: ",
               if (n_poor == 1) "it lies" else "they lie",
               " where the drawn plane happens to project ",
               if (n_poor == 1) "it" else "them",
               ", not where ", if (n_poor == 1) "its" else "their",
               " profile actually differs.")
      else
        paste0("No category falls below 40%, so every drawn position is a fair ",
               "summary of that category&#x27;s profile."),
      " A category with low quality can still sit far from the origin on the ",
      "map — that is exactly why the picture alone is not enough."
    ),
    data = list(point_quality = pq)
  )
}

# Card: reading_the_map (table)
card_reading_the_map <- function(shared, df, params) {
  list(
    title = "Reading the Biplot — and the One Rule Everyone Breaks",
    description = paste0("What each distance and direction on the &#x27;",
                         shared$name_row, "&#x27; by '", shared$name_col,
                         "&#x27; map does and does not mean."),
    text = paste0(
      "The single most common error in reading a correspondence biplot is ",
      "measuring how close a point of &#x27;", shared$name_row, "' sits to a point of '",
      shared$name_col, "&#x27; and calling that the strength of their ",
      "association. In this symmetric map it is not. Both sets are drawn in ",
      "principal coordinates, each scaled to its own inertia, so the two clouds ",
      "have no common yardstick: the gap between a point of &#x27;", shared$name_row,
      "&#x27; and a point of '", shared$name_col,
      "&#x27; mixes two different scales and is not a quantity. What IS ",
      "interpretable is distance within each set, direction from the origin ",
      "across the sets, and distance from the origin as departure from the ",
      "average profile. ",
      if (shared$map_interpretable && isTRUE(shared$poles_agree))
        paste0("Applied here: ", shared$d1_pos, " and ", shared$c1_pos,
               " both sit at the positive end of dimension 1 while ",
               shared$d1_neg, " and ", shared$c1_neg,
               " sit at the negative end. The table confirms what that shared ",
               "direction implies — ", shared$d1_pos, " × ", shared$c1_pos,
               " has a standardized residual of ", fmt_num(shared$pole_pos_resid, 2),
               " and ", shared$d1_neg, " × ", shared$c1_neg, " one of ",
               fmt_num(shared$pole_neg_resid, 2),
               ", both above what independence predicts. Read from the direction ",
               "they share, not from how far apart they are drawn.")
      else if (shared$map_interpretable)
        paste0("Applied here with a caveat: ", shared$d1_pos, " and ", shared$c1_pos,
               " sit at the positive end of dimension 1 and ", shared$d1_neg,
               " and ", shared$c1_neg, " at the negative end, but the ",
               "standardized residuals of those two cells(",
               fmt_num(shared$pole_pos_resid, 2), " and ",
               fmt_num(shared$pole_neg_resid, 2),
               ") do not both exceed what independence predicts. Dimension 1 is ",
               "separating profiles here rather than pairing individual ",
               "categories — check the deviations before reading any single pair ",
               "off the picture.")
      else
        paste0("None of it applies here, because the chi-square test does not ",
               "reject independence(", p_phrase(shared$chi_p),
               "): there is no association for any reading rule to recover."),
      " The rows below spell out each rule for your own columns."
    ),
    data = list(reading_rules = shared$reading_df)
  )
}
Your data has more stories to tell.Run any analysis on your own data — validated R modules, interactive reports, AI insights, and PDF export. 500 free credits on signup.
Try Free — No SignupSign Up Free

Cite this analysis

Report an Issue

Tell us what's wrong. You'll get a free re-run of this analysis so you can try again with different parameters. If the re-run still doesn't meet your expectations, we'll refund your credits.

Want to run this analysis on your own data? Upload CSV — Free Analysis See Pricing