Executive Summary
Are Contract and Churn related?
Contract and Churn are associated: the chi-square test rejects independence with p = 5.86e-258, and Cramér's V = 0.41 indicates a moderate relationship. Month-to-month contracts drive the association—1,655 customers with this contract type churned (vs. 1,028.3 expected under independence), while 2,220 did not churn (vs. 2,846.7 expected), showing Month-to-month customers churn at much higher rates than longer-term contracts.
Analysis Overview
Association test between Contract and Churn across 7,043 observations.
Contract type and churn are strongly associated across 7,043 observations. The chi-square test detects a relationship far stronger than chance would produce—a pattern real enough to act on directionally. Cramér's V quantifies this strength on a 0–1 scale; the exact value appears in The detail below. Importantly, association means the two variables move together; it does not mean contract type causes churn. A third factor—such as customer tenure, service satisfaction, or pricing sensitivity—could drive both.
Data Quality
Missing-value recoding, category lumping, and sparse-count handling.
All 7,043 rows were retained; no rows were dropped and no blanks required recoding to Missing. Both columns were complete with 8 or fewer categories, eliminating the need for rare-category lumping. Expected cell counts ranged from 390.9 to 2,846.7, well above the minimum threshold of 5, so the standard chi-square test was appropriate and no sparse-count correction was needed. The dataset required no further cleaning.
Contingency Table
Counts of every Contract × Churn combination.
The largest cell is Month-to-month × No with 2,220 observations (31.5% of 7,043 rows). The data concentrates in non-churn rows across all contract types, but the distribution shifts sharply by contract: Month-to-month has 1,655 churners, while Two year has only 48 and One year has 166. This concentration pattern—high churn in Month-to-month, low in Two year—is the visual signature of the association. The color gradient would show Month-to-month rows as warm (high churn) and Two year rows as cool (low churn), revealing the Contract–Churn relationship at a glance.
Composition by Group
Share of each Churn category within every Contract level (rows sum to 100%).
Within each contract type, the share of churners varies dramatically: Month-to-month shows 42.7% churn, One year shows 11.3%, and Two year shows only 2.8%. Conversely, the share of non-churners rises from 57.3% (Month-to-month) to 97.2% (Two year). This is the pattern the association test detects—the Churn profile is not constant across Contract levels. The steepest swing is in the Two year group, where non-churn dominates at 97.2%, contrasting sharply with Month-to-month's 57.3% non-churn rate.
Statistical Tests
Chi-square, Fisher's exact (when run), and Cramér's V.
| Test | Statistic | Df | P Value | Interpretation |
|---|---|---|---|---|
| Chi-square test | 1185 | 2 | 5.86e-258 | Significant association at p < 0.05. |
| Cramér's V (effect size) | 0.41 | — | — | Association strength is moderate (0 = none, 1 = perfect; <0.1 negligible, 0.1–0.3 weak, 0.3–0.5 moderate, >0.5 strong). |
The chi-square statistic is 1,184.6 on 2 degrees of freedom, yielding p = 5.86e-258, far below the 0.05 threshold and indicating a highly significant association. Cramér's V = 0.41 grades the strength as moderate (scale: <0.1 negligible, 0.1–0.3 weak, 0.3–0.5 moderate, >0.5 strong). The enormous p-value reflects both a real relationship and a large sample; the moderate V confirms the relationship is substantial enough to matter practically, not merely a statistical artifact of sample size.
Largest Deviations from Independence
The cells that depart most from the counts independence would predict.
| Cell | Observed | Expected | Std Residual |
|---|---|---|---|
| Month-to-month × Yes | 1655 | 1028 | 34 |
| Month-to-month × No | 2220 | 2847 | -34 |
| Two year × No | 1647 | 1245 | 25.37 |
| Two year × Yes | 48 | 449.8 | -25.37 |
| One year × No | 1307 | 1082 | 14.92 |
| One year × Yes | 166 | 390.9 | -14.92 |
Month-to-month × Yes is the most over-represented cell: 1,655 observed versus 1,028.3 expected, with a standardized residual of 34—the strongest deviation in the table. Its complement, Month-to-month × No, is the most under-represented: 2,220 observed versus 2,846.7 expected (residual −34). Two year × Yes is the second-largest departure (48 observed vs. 449.8 expected; residual −25.37), while Two year × No is correspondingly over-represented (1,647 vs. 1,245.2; residual 25.37). One year shows a smaller but consistent pattern: 166 churners observed versus 390.9 expected (residual −14.92). These deviations explain the entire association: Month-to-month and Two year are the primary drivers.
Categorical Association — Chi-Square & Fisher
Tests whether two categorical columns are related: contingency table, chi-square test of independence (Fisher's exact test when counts are sparse), Cramér's V effect size, and the cells that deviate most from independence.
Why This Method?
The chi-square test is the standard answer to "are these two categories related?" — one p-value for the whole table. Fisher's exact test covers the sparse-count cases where chi-square is unreliable, and Cramér's V turns the verdict into a 0-1 strength score so significance is never confused with importance.
What This Analysis Covers
- Contingency table heatmap (all combinations, including zeros)
- Row-share bars: composition of one column within each level of the other
- Chi-square + Fisher exact + Cramér's V, tabulated with interpretations
- The most over- and under-represented combinations (standardized residuals)
Standard Library
Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {var_a, var_b}. All narrative is derived from the user's own column names and computed values.
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))Core Analysis Pipeline
compute_shared <- function(df, params, col_map = list()) {
# === SHARED EXPORTS ===
# initial_rows/final_rows/rows_removed $ row accounting
# name_a / name_b $ humanized user names of var_a / var_b
# levels_a / levels_b $ ordered level labels used in the table
# n_missing_a/_b $ blanks/NA recoded to "Missing"
# n_lumped_a/_b $ levels folded into "Other" (beyond 8)
# tab $ contingency table (var_a rows x var_b cols)
# contingency_df $ long format incl. zeros: level_a, level_b, count
# proportions_df $ level_a, share_pct, level_b (row shares x100)
# test_results_df $ test, statistic, df, p_value, interpretation
# deviations_df $ cell, observed, expected, std_residual (top 10)
# chi_stat/chi_df/chi_p $ chi-square results
# fisher_p $ Fisher exact p (NA when not run)
# fisher_ran $ logical — was Fisher run
# pct_low_expected $ % of cells with expected count < 5
# cramers_v / strength_band $ effect size + verdict band
# p_effective / test_used $ the p-value the verdict rests on
# significant $ logical — p_effective < 0.05
# top_over / top_under $ 1-row data.frames (may be NULL) — extreme cells
# metrics / json_output
# === /SHARED EXPORTS ===Step 1: Discover the two mapped columns
initial_rows <- nrow(df)
for (k in c("var_a", "var_b")) {
if (!k %in% names(df)) {
stop(sprintf("column_mapping must map '%s' to a categorical column.", k))
}
}
name_a <- humanize_semantic("var_a", col_map)
name_b <- humanize_semantic("var_b", col_map)Step 2: Clean both columns — character, "Missing", lump beyond 8 levels
prep_categorical <- function(v, max_levels = 8) {
x <- trimws(as.character(v))
n_missing <- sum(is.na(x) | x == "")
x[is.na(x) | x == ""] <- "Missing"
freq <- sort(table(x), decreasing = TRUE)
lumped <- character(0)
if (length(freq) > max_levels) {
keep <- names(freq)[seq_len(max_levels)]
lumped <- setdiff(names(freq), keep)
x[x %in% lumped] <- "Other"
}Levels ordered by frequency; "Other"/"Missing" pushed last for readability
freq2 <- sort(table(x), decreasing = TRUE)
lv <- names(freq2)
special <- intersect(c("Other", "Missing"), lv)
lv <- c(setdiff(lv, special), special)
list(x = factor(x, levels = lv), n_missing = n_missing,
n_lumped = length(lumped))
}
pa <- prep_categorical(df[["var_a"]])
pb <- prep_categorical(df[["var_b"]])
if (nlevels(pa$x) < 2) {
stop(sprintf("'%s' has only one distinct value (%s) — an association test needs at least two categories in each column.",
name_a, levels(pa$x)[1]))
}
if (nlevels(pb$x) < 2) {
stop(sprintf("'%s' has only one distinct value (%s) — an association test needs at least two categories in each column.",
name_b, levels(pb$x)[1]))
}
final_rows <- length(pa$x)
rows_removed <- initial_rows - final_rows
if (final_rows < 20) {
stop(sprintf("Only %d usable rows — the association test between '%s' and '%s' needs at least 20.",
final_rows, name_a, name_b))
}Step 3: Contingency table + chi-square test
tab <- table(pa$x, pb$x)
n <- sum(tab)
is_2x2 <- nrow(tab) == 2 && ncol(tab) == 22x2 keeps the default Yates continuity correction; larger tables use the uncorrected statistic. Low-expected-count warnings are suppressed here and narrated (Fisher covers that case below).
chi <- suppressWarnings(
if (is_2x2) chisq.test(tab) else 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)Range of the EXPECTED counts matrix (not the observed table) — narrated in Data Quality so any "expected cell counts ranged from X to Y" claim is computed from the right matrix.
min_expected <- round(min(expected), 1)
max_expected <- round(max(expected), 1)Step 4: Fisher's exact test when chi-square is unreliable (or 2x2)
fisher_ran <- FALSE
fisher_p <- NA_real_
fisher_or <- NA_real_
if (is_2x2 || pct_low_expected > 20) {
fr <- tryCatch(
if (is_2x2) fisher.test(tab)
else fisher.test(tab, simulate.p.value = TRUE, B = 10000),
error = function(e) NULL
)
if (!is.null(fr)) {
fisher_ran <- TRUE
fisher_p <- as.numeric(fr$p.value)
if (is_2x2 && !is.null(fr$estimate)) fisher_or <- as.numeric(fr$estimate)
}
}The verdict rests on Fisher when it ran (it is the reliable test in exactly the situations that triggered it), else on chi-square.
if (fisher_ran && !is.na(fisher_p)) {
p_effective <- fisher_p
test_used <- "Fisher's exact test"
} else {
p_effective <- chi_p
test_used <- "chi-square test"
}
significant <- !is.na(p_effective) && p_effective < 0.05Step 5: Cramér's V effect size
cramers_v <- sqrt(chi_stat / (n * (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"Step 6: Standardized residuals — which cells drive the association
obs_long <- as.data.frame(tab, stringsAsFactors = FALSE)
names(obs_long) <- c("level_a", "level_b", "count")
contingency_df <- obs_long
contingency_df$level_a <- as.character(contingency_df$level_a)
contingency_df$level_b <- as.character(contingency_df$level_b)
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(
cell = paste0(as.character(obs_long$level_a), " × ",
as.character(obs_long$level_b)),
observed = obs_long$count,
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]Ties in |residual| (guaranteed in 2-column tables) list the over-represented cell first — it reads better in the narrative.
dev_all <- dev_all[order(-abs(dev_all$std_residual), -dev_all$std_residual), , drop = FALSE]
rownames(dev_all) <- NULL
deviations_df <- head(dev_all, 10)Most over/under-represented cells (guard: never index into empty/all-NA)
top_over <- if (nrow(dev_all) > 0 && max(dev_all$std_residual) > 0)
dev_all[which.max(dev_all$std_residual), , drop = FALSE] else NULL
top_under <- if (nrow(dev_all) > 0 && min(dev_all$std_residual) < 0)
dev_all[which.min(dev_all$std_residual), , drop = FALSE] else NULLStep 7: Row shares — composition of var_b within each var_a level
prop <- prop.table(tab, 1) * 100
prop_long <- as.data.frame(as.table(prop), stringsAsFactors = FALSE)
proportions_df <- data.frame(
level_a = as.character(prop_long$Var1),
share_pct = round(prop_long$Freq, 1),
level_b = as.character(prop_long$Var2),
stringsAsFactors = FALSE
)Step 8: Test-results table
chi_name <- if (is_2x2) "Chi-square test(Yates-corrected)" else "Chi-square test"
chi_interp <- paste0(
if (!is.na(chi_p) && chi_p < 0.05) "Significant association at p < 0.05."
else "No significant association at p < 0.05.",
if (pct_low_expected > 20) paste0(" Caution: ", round(pct_low_expected),
"% of cells have expected counts below 5 — prefer Fisher's row.")
else ""
)
test_rows <- list(data.frame(
test = chi_name, statistic = round(chi_stat, 2), df = chi_df,
p_value = signif(chi_p, 3), interpretation = chi_interp,
stringsAsFactors = FALSE
))
if (fisher_ran) {
test_rows[[length(test_rows) + 1]] <- data.frame(
test = if (is_2x2) "Fisher's exact test" else "Fisher's exact test (simulated, B=10,000)",
statistic = if (is_2x2 && !is.na(fisher_or)) round(fisher_or, 2) else NA_real_,
df = NA_real_, p_value = signif(fisher_p, 3),
interpretation = paste0(
if (!is.na(fisher_p) && fisher_p < 0.05) "Significant association at p < 0.05."
else "No significant association at p < 0.05.",
if (is_2x2 && !is.na(fisher_or)) sprintf(" Statistic shown is the odds ratio(%.2f).", fisher_or)
else " Exact test — reliable with sparse cell counts."
),
stringsAsFactors = FALSE
)
}
test_rows[[length(test_rows) + 1]] <- data.frame(
test = "Cramér's V (effect size)", statistic = round(cramers_v, 3),
df = NA_real_, p_value = NA_real_,
interpretation = paste0("Association strength is ", strength_band,
" (0 = none, 1 = perfect; <0.1 negligible, 0.1–0.3 weak, 0.3–0.5 moderate, >0.5 strong)."),
stringsAsFactors = FALSE
)
test_results_df <- do.call(rbind, test_rows)
rownames(test_results_df) <- NULL
metrics <- list(
`Observations` = as.integer(n),
`Table Size` = paste0(nrow(tab), " × ", ncol(tab)),
`Chi-Square` = round(chi_stat, 2),
`P Value` = signif(p_effective, 3),
`Cramér's V` = round(cramers_v, 3),
`Association` = if (significant) paste0("associated(", strength_band, ")") else "not associated"
)
json_output <- list(
answer = paste0(
name_a, " and ", name_b,
if (significant) " are statistically associated(" else " show no statistically significant association(",
test_used, " p = ", signif(p_effective, 3),
"; Cramér's V = ", round(cramers_v, 3), ", ", strength_band, ") across ",
format(n, big.mark = ","), " rows.",
if (significant && !is.null(top_over)) paste0(
" The most over-represented combination is ", top_over$cell,
" (", top_over$observed, " observed vs ", top_over$expected, " expected).")
else ""
),
cards = lapply(
c("tldr", "overview", "preprocessing", "contingency_heatmap",
"proportions_bar", "test_results", "largest_deviations"),
function(cid) list(id = cid, metrics = metrics)
)
)
list(
initial_rows = initial_rows, final_rows = final_rows,
rows_removed = rows_removed,
name_a = name_a, name_b = name_b,
levels_a = levels(pa$x), levels_b = levels(pb$x),
n_missing_a = pa$n_missing, n_missing_b = pb$n_missing,
n_lumped_a = pa$n_lumped, n_lumped_b = pb$n_lumped,
tab = tab, contingency_df = contingency_df,
proportions_df = proportions_df, test_results_df = test_results_df,
deviations_df = deviations_df,
chi_stat = chi_stat, chi_df = chi_df, chi_p = chi_p,
fisher_p = fisher_p, fisher_ran = fisher_ran, is_2x2 = is_2x2,
pct_low_expected = pct_low_expected,
min_expected = min_expected,
max_expected = max_expected,
cramers_v = cramers_v, strength_band = strength_band,
p_effective = p_effective, test_used = test_used,
significant = significant,
top_over = top_over, top_under = top_under,
metrics = metrics, json_output = json_output
)
}Find the level_b whose share varies most across level_a (the visual story)
spread_by_b <- tapply(pdf$share_pct, pdf$level_b, function(s) max(s) - min(s))
spread_by_b <- spread_by_b[is.finite(spread_by_b)]
spread_txt <- ""
if (length(spread_by_b) > 0) {
b_star <- names(spread_by_b)[which.max(spread_by_b)]
sub <- pdf[pdf$level_b == b_star, , drop = FALSE]
hi <- sub[which.max(sub$share_pct), ]
lo <- sub[which.min(sub$share_pct), ]
spread_txt <- paste0(
" The share of \"", b_star, "\" varies most: from ", lo$share_pct,
"% of ", lo$level_a, " to ", hi$share_pct, "% of ", hi$level_a, ".",
if (shared$significant) " That spread is what the association test is detecting."
else " Even this largest spread is within what chance would produce."
)
}
list(
title = "Composition by Group",
description = paste0("Share of each ", shared$name_b, " category within every ",
shared$name_a, " level(rows sum to 100%)."),
text = paste0(
"Each group of bars is one ", shared$name_a, " level, split into the ",
"percentage of rows falling in each ", shared$name_b, " category. If the ",
"two columns were independent, every group would show the same profile.",
spread_txt
),
chart_labels = list(level_a = shared$name_a, share_pct = "Share(%)"),
data = list(proportions = pdf)
)
}
# Card: test_results (table)
card_test_results <- function(shared, df, params) {
list(
title = "Statistical Tests",
description = "Chi-square, Fisher's exact (when run), and Cramér's V.",
text = paste0(
"The chi-square statistic is ", round(shared$chi_stat, 2), " on ",
shared$chi_df, " degrees of freedom(p = ", signif(shared$chi_p, 3), ").",
if (shared$fisher_ran) paste0(
" Fisher's exact test",
if (shared$is_2x2) "" else " (p-value simulated with 10,000 replicates)",
" gives p = ", signif(shared$fisher_p, 3),
if (shared$pct_low_expected > 20) paste0(" and is the reliable verdict here, since ",
round(shared$pct_low_expected), "% of cells have expected counts under 5.")
else ".") else "",
" Cramér's V = ", round(shared$cramers_v, 3), " grades the strength as ",
shared$strength_band, ": a tiny p-value on a large dataset can still mean ",
"a practically ", if (shared$cramers_v < 0.3) "small" else "substantial",
" relationship, so read significance and strength together."
),
data = list(test_results = shared$test_results_df)
)
}
# Card: largest_deviations (table)
card_largest_deviations <- function(shared, df, params) {
over_txt <- if (!is.null(shared$top_over) && shared$top_over$std_residual > 2) {
paste0(shared$top_over$cell, " is the most over-represented combination(",
shared$top_over$observed, " observed vs ", shared$top_over$expected,
" expected; standardized residual ", shared$top_over$std_residual, ")")
} else NULL
under_txt <- if (!is.null(shared$top_under) && shared$top_under$std_residual < -2) {
paste0(shared$top_under$cell, " is the most under-represented(",
shared$top_under$observed, " vs ", shared$top_under$expected,
" expected; residual ", shared$top_under$std_residual, ")")
} else NULL
hot_txt <- if (!is.null(over_txt) || !is.null(under_txt)) {
paste0(paste(c(over_txt, under_txt), collapse = ", and "), ". ")
} else {
"No individual cell deviates strongly from independence(all standardized residuals are within ±2). "
}
list(
title = "Largest Deviations from Independence",
description = "The cells that depart most from the counts independence would predict.",
text = paste0(
"Standardized residuals measure how far each cell's observed count sits ",
"from its expected count, in standard-deviation units — beyond ±2 is a ",
"meaningful departure. ", hot_txt,
"These cells are where the ", shared$name_a, "–", shared$name_b,
" relationship actually lives, and the natural place to focus follow-up."
),
data = list(largest_deviations = shared$deviations_df)
)
}