Executive Summary
Churn across 7,043 customers
The short answer
Of 7,043 customers, 1,869 (26.5%) have churned. The median customer lifetime was not reached within the observed window, meaning most customers outlasted the data. The strongest churn driver is Contract: Two year vs Month-to-month (odds ratio 0.098, p = 2.61e-47), which is associated with substantially lower churn.
The detail
Churn rate is 26.5% (1,869 churned out of 7,043 total). The Kaplan-Meier survival curve never crosses 50%, so the median lifetime is not reached. The top churn driver—Contract: Two year vs Month-to-month—has an odds ratio of 0.098 with a p-value of 2.61e-47, indicating a strong association with reduced churn. Customers on two-year contracts are far less likely to churn than those on month-to-month terms.
What this can't tell you
The odds ratio measures association strength, not causation. Two-year contracts may retain customers because commitment reduces churn, or because customers who sign long contracts were already more loyal; the data cannot distinguish these pathways. Longer observation of newer cohorts would clarify whether the trend of rising churn in recent cohorts continues.
Analysis Overview
Churn rate, survival, and drivers across 7,043 customers.
The short answer
The dataset contains 7,043 customers observed through February 2020, of whom 1,869 (26.5%) have churned. Because 5,174 customers remain active at the reference date, their true lifetimes are still unfolding; the Kaplan-Meier method accounts for this censoring correctly, whereas a simple average would wrongly treat them as if their stories had ended. Odds ratios rank which factors correlate with churn, but correlation is not causation.
The detail
The reference date is 2020-02-01. Churn was read as a yes/no indicator from 7,043 rows; all rows were usable and no date parsing failures occurred. Kaplan-Meier estimation is appropriate because the 5,174 active customers have not yet churned—their lifetimes are only known to exceed their observed tenure. Odds ratios from logistic regression measure the strength and direction of association for each driver, jointly fit.
What this can't tell you
Association does not imply causation. A low odds ratio (e.g., two-year contracts) reflects correlation with lower churn, not proof that contract terms mechanically cause or prevent it. Unmeasured factors (e.g., customer intent at signup, market conditions) could drive both contract choice and churn independently.
Data Quality
Date parsing, churn coercion, and exclusions.
The short answer
All 7,043 rows loaded and were retained; no records were dropped for date parsing errors or missing churn values. Numeric drivers were standardized (so odds ratios express per-standard-deviation changes), and categorical drivers lumped rare categories into 'Other' and blanks into 'Missing' to stabilize estimates.
The detail
Initial rows: 7,043; final rows used: 7,043; rows removed: 0. The 'Churn' column was successfully coerced to yes/no. All mapped driver columns were usable; none were excluded as constant, empty, or identifier-like. Standardization of numeric drivers ensures that odds ratios across continuous and categorical predictors are comparable in magnitude.
What this can't tell you
The export does not reveal whether any driver columns contained structural missingness patterns (e.g., a field only populated for a subset of cohorts). If driver availability varies by cohort or time period, the odds ratios may reflect selection rather than true association. Consider requesting a data dictionary or sample rows to confirm driver completeness by cohort.
Churn by Signup Cohort
Churn rate per year of start date.
The short answer
Churn has risen sharply in newer cohorts: from 6.4% in the 2014 cohort to 60.9% in the 2020 cohort. However, recent cohorts have had less time at risk, so their higher churn rates partly reflect less observation time rather than a true trend. Comparing cohorts of similar age is needed to isolate a genuine change.
The detail
Churn by signup year shows a consistent upward trajectory: 2014 cohort 6.4%, 2015 cohort 13.4%, 2016 cohort 19%, 2017 cohort 21%, 2018 cohort 28.1%, 2019 cohort 41.6%, and 2020 cohort 60.9%. The 2020 cohort has been observed for only one month (to the reference date 2020-02-01), so its 60.9% churn rate reflects a much shorter risk window than the 2014 cohort's six years. Older cohorts have had more time to churn, inflating their observed rates. Cohorts of similar age must be compared to detect a true trend in churn behavior.
What this can't tell you
The rising churn rates in recent cohorts cannot be interpreted as a trend without accounting for observation time. The 2020 cohort's 60.9% rate is not directly comparable to the 2014 cohort's 6.4% because they have been at risk for vastly different periods. A cohort-by-tenure analysis would clarify whether newer customers are genuinely more likely to churn at equivalent ages.
Customer Survival Curve
Share of customers still active by lifetime (Kaplan-Meier).
The short answer
Most customers do not churn early: 92.8% survive past 90 days and 84.3% past one year. The survival curve declines steadily but never reaches 50%, so the median customer lifetime is not observed within the data window. Churn is spread across the entire customer lifetime rather than concentrated in an early high-risk period.
The detail
The Kaplan-Meier survival curve shows survival at 0 days: 100%, 31 days: 94.6%, 62 days: 92.78%, 92 days: 91.37%, 365 days: 84.32%. The curve continues to decline gradually, reaching 78.87% at 730 days and never crossing 50%. At 90 days, 92.8% of customers are still active; at one year (365 days), 84.32% remain. The decline is steady and gradual rather than steep, indicating churn is distributed across the customer lifetime.
What this can't tell you
The curve does not reach 50%, so we cannot estimate the median lifetime from this data. A longer observation window or follow-up of censored customers would be needed to establish when half of all customers have churned. The shape suggests that most churn occurs beyond the observed window rather than early in the relationship.
Churn Drivers
Odds ratios per driver, with 95% confidence intervals.
The short answer
Contract type dominates: two-year contracts cut churn odds to 0.098 and one-year contracts to 0.278 relative to month-to-month—both highly significant. Internet service type and payment method are secondary protective factors. SeniorCitizen status is the only risk factor, but its effect (odds ratio 1.052) is not statistically significant. Ten of 12 drivers are significant at p < 0.05.
The detail
Top three protective factors (lowest odds ratios): Contract Two year (0.098, 95% CI 0.072–0.134); InternetService No vs Fiber (0.145, CI 0.092–0.229); Contract One year (0.278, CI 0.23–0.337). Other significant protective factors: DSL vs Fiber (0.442), Credit card automatic (0.543), Online Security Yes (0.563), Bank transfer automatic (0.584), Tech Support Yes (0.675), Paperless Billing No (0.721), Mailed check (0.765). Risk factor: SeniorCitizen (1.052, CI 0.993–1.114, not significant). MonthlyCharges per SD (0.908, CI 0.758–1.086, not significant).
What this can't tell you
Odds ratios measure association, not causation. The strong two-year contract effect may reflect selection (loyal customers choose longer terms) rather than contracts creating loyalty. Similarly, online security adoption may signal engagement rather than the service itself preventing churn. Causal claims would require randomized assignment or instrumental variables. Consider qualitative research with churned customers to distinguish intent from service features.
Lifetime Distribution — Churned vs Active
Observed lifetimes split by customer status.
The short answer
Churned customers lasted a median of 260 days before leaving, while active customers have already been around a median of 1,172 days. This gap is consistent with churn concentrating early: customers who survive the first year are much more likely to stick around. Note that active customer lifetimes are still growing (right-censored), so the true median active tenure will rise.
The detail
Churned customer median tenure: 260 days. Active customer median tenure: 1,172 days. The disparity—active customers already outlasting the typical churned lifetime by more than four times—reflects strong early churn. Interquartile ranges (estimated from the box data): churned customers show wide spread (from 184 to 761 days in the sample), while active customers cluster in the longer range (306 to 2,191 days). The longest-tenured churned customer (2,041 days) is an outlier but rare.
What this can't tell you
Active customer lifetimes are right-censored at the 2020-02-01 reference date; their true medians will shift upward as time passes. The comparison of medians is valid for identifying early churn concentration, but the active median will grow. A follow-up analysis in 6–12 months would show whether the active median stabilizes or continues to rise, and whether the churned median shifts as newer, shorter-tenured customers churn.
Cohort Detail
Per-year cohort sizes and churn.
| Cohort Month | Customers | Churned | Churn Rate PCT |
|---|---|---|---|
| 2014-01-01 | 1331 | 85 | 6.4 |
| 2015-01-01 | 842 | 113 | 13.4 |
| 2016-01-01 | 763 | 145 | 19 |
| 2017-01-01 | 818 | 172 | 21 |
| 2018-01-01 | 994 | 279 | 28.1 |
| 2019-01-01 | 1671 | 695 | 41.6 |
| 2020-01-01 | 624 | 380 | 60.9 |
The short answer
The largest cohort is 2019 with 1,671 customers, of whom 695 (41.6%) have churned. The oldest cohort (2014) has the lowest churn rate at 6.4% but has also been at risk for the longest. Churn rates rise consistently with newer signup years, though recency bias (shorter observation time) inflates the rates for 2020.
The detail
Cohort sizes range from 624 (2020) to 1,671 (2019). Churn rates by cohort: 2014 (6.4%, 85 of 1,331), 2015 (13.4%, 113 of 842), 2016 (19%, 145 of 763), 2017 (21%, 172 of 818), 2018 (28.1%, 279 of 994), 2019 (41.6%, 695 of 1,671), 2020 (60.9%, 380 of 624). The 2019 cohort is the largest and has experienced substantial churn; the 2020 cohort shows the highest rate but has been observed for only one month.
What this can't tell you
Comparing churn rates across cohorts of different ages conflates time at risk with actual churn propensity. The 2020 cohort's 60.9% rate is not equivalent to the 2014 cohort's 6.4% because observation windows differ by nearly six years. Cohort-by-tenure analysis (churn rates at matched ages across cohorts) would separate genuine changes in churn behavior from recency bias.
Churn Analysis — Rate, Survival, Drivers
Customer-level churn analysis: overall churn rate, monthly signup-cohort churn, a Kaplan-Meier survival curve of customer lifetime (censoring-aware), and a logistic-regression driver analysis ranking which mapped columns most raise or lower the odds of churning.
Why This Method?
A raw churn rate hides when customers leave and who leaves. Kaplan-Meier survival handles the customers who have not churned yet (censoring) instead of ignoring them, and logistic regression puts every candidate driver on the same odds-ratio scale so they can be ranked honestly.
What This Analysis Covers
- Overall churn rate and median customer lifetime (KM)
- Churn rate by monthly signup cohort
- Survival curve with 95% confidence band
- Churn drivers ranked by odds ratio with confidence intervals
- Lifetime distribution, churned vs active
Standard Library
Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {start_date, churn_status, base_1..base_N}. 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(survival))
suppressPackageStartupMessages(library(Matrix))
suppressPackageStartupMessages(library(cluster))
suppressPackageStartupMessages(library(data.table))Core Analysis Pipeline
Step 1: Required columns + humanized names
initial_rows <- nrow(df)
if (!"start_date" %in% names(df) || !"churn_status" %in% names(df)) {
stop("column_mapping must map both start_date and churn_status")
}
start_name <- humanize_semantic("start_date", col_map)
churn_name <- humanize_semantic("churn_status", col_map)
base_cols <- grep("^base_[0-9]+$", names(df), value = TRUE)
base_cols <- base_cols[order(as.integer(sub("^base_", "", base_cols)))]
driver_names <- setNames(humanize_semantic(base_cols, col_map), base_cols)Step 2: Parse start dates (multi-format, lubridate)
start_date <- parse_dates_flex(df$start_date)
if (sum(!is.na(start_date)) < 0.5 * initial_rows) {
stop(paste0("Could not read '", start_name, "' as dates — fewer than half ",
"of the values parse in any common date format."))
}Step 3: Coerce churn_status — churn/cancel DATE, 0/1 flag, or yes/no text
raw_churn <- df$churn_status
raw_chr <- trimws(as.character(raw_churn))
is_blank <- is.na(raw_chr) | raw_chr == ""
n_nonblank <- sum(!is_blank)
churned <- rep(NA, initial_rows)
churn_date <- as.Date(rep(NA, initial_rows))
churn_mode <- NULL
cd_try <- parse_dates_flex(raw_churn)
if (n_nonblank > 0 && sum(!is.na(cd_try)) >= 0.8 * n_nonblank) {Date mode: non-blank = churn/cancel date, blank = still active
churn_mode <- "date"
churned <- !is.na(cd_try)
churn_date <- cd_try
} else {
num_try <- suppressWarnings(as.numeric(raw_chr))
num_ok <- !is.na(num_try)
if (n_nonblank > 0 && sum(num_ok) >= 0.95 * n_nonblank &&
all(num_try[num_ok] %in% c(0, 1))) {Flag mode: 1 = churned, 0 = active (blank treated as unknown -> dropped)
churn_mode <- "flag"
churned <- ifelse(is_blank, NA, num_try == 1)
} else {Text mode: yes/churned/cancelled vs no/active
lo <- tolower(raw_chr)
yes_set <- c("yes", "y", "true", "churned", "churn", "cancelled",
"canceled", "cancel", "inactive", "lost", "closed")
no_set <- c("no", "n", "false", "active", "current", "retained",
"open", "subscribed")
mapped <- ifelse(lo %in% yes_set, TRUE, ifelse(lo %in% no_set, FALSE, NA))
if (n_nonblank > 0 && sum(!is.na(mapped[!is_blank])) >= 0.8 * n_nonblank) {
churn_mode <- "text"
churned <- mapped
} else {
stop(paste0("Could not read '", churn_name, "' as a churn indicator — ",
"expected a churn/cancel date column(blank = active), a 0/1 ",
"flag, or yes/no text."))
}
}
}Step 4: Reference date, tenure, row filtering
ref_date <- suppressWarnings(max(c(start_date, churn_date), na.rm = TRUE))
if (!is.finite(as.numeric(ref_date))) {
stop(paste0("No usable dates found in '", start_name, "'."))
}
keep <- !is.na(start_date) & !is.na(churned)Churned rows in date mode need churn_date >= start_date; others need start <= ref
tenure <- ifelse(churned & !is.na(churn_date),
as.numeric(churn_date - start_date),
as.numeric(ref_date - start_date))
keep <- keep & !is.na(tenure) & tenure >= 0
work <- data.frame(start_date = start_date, churned = churned,
tenure = tenure, stringsAsFactors = FALSE)[keep, , drop = FALSE]
for (bc in base_cols) work[[bc]] <- df[[bc]][keep]
final_rows <- nrow(work)
rows_removed <- initial_rows - final_rowsStep 5: Minimum-data guards (clear, humanized messages)
if (final_rows < 30) {
stop(paste0("Only ", final_rows, " usable rows after reading '", start_name,
"' and '", churn_name, "' — churn analysis needs at least 30 ",
"customers."))
}
n_churned <- sum(work$churned)
n_active <- final_rows - n_churned
if (n_churned < 5) {
stop(paste0("Only ", n_churned, " churned customer(s) found in '", churn_name,
"' — at least 5 are needed to analyse churn."))
}
churn_rate <- n_churned / final_rowsStep 6: Signup cohorts (month; lumped to quarter/year if > 24 cohorts)
cohort_unit <- "month"
coh <- lubridate::floor_date(work$start_date, "month")
if (length(unique(coh)) > 24) { cohort_unit <- "quarter"; coh <- lubridate::floor_date(work$start_date, "quarter") }
if (length(unique(coh)) > 24) { cohort_unit <- "year"; coh <- lubridate::floor_date(work$start_date, "year") }
cohort_df <- work %>%
mutate(cohort = coh) %>%
group_by(cohort) %>%
summarise(customers = n(), churned = sum(churned), .groups = "drop") %>%
arrange(cohort) %>%
mutate(churn_rate_pct = round(100 * churned / customers, 1),
cohort_month = as.character(cohort)) %>%
select(cohort_month, customers, churned, churn_rate_pct) %>%
as.data.frame(stringsAsFactors = FALSE)Step 7: Kaplan-Meier survival of customer lifetime (censoring-aware)
km_fit <- survival::survfit(survival::Surv(work$tenure, work$churned) ~ 1,
conf.int = 0.95)
km_full <- data.frame(
tenure_days = km_fit$time,
survival_pct = round(100 * km_fit$surv, 2),
lower_pct = round(100 * ifelse(is.na(km_fit$lower), km_fit$surv, km_fit$lower), 2),
upper_pct = round(100 * ifelse(is.na(km_fit$upper), km_fit$surv, km_fit$upper), 2),
stringsAsFactors = FALSE
)
km_full <- km_full[order(km_full$tenure_days), , drop = FALSE]
if (nrow(km_full) > 500) {
idx <- unique(round(seq(1, nrow(km_full), length.out = 500)))
km_df <- km_full[idx, , drop = FALSE]
} else {
km_df <- km_full
}
rownames(km_df) <- NULL
km_table <- summary(km_fit)$table
median_lifetime <- suppressWarnings(as.numeric(km_table["median"]))
if (length(median_lifetime) == 0) median_lifetime <- NA_real_Step 8: Churn drivers — logistic regression on the mapped base_* columns
drivers_df <- NULL
top_driver <- NULL
dropped_drivers <- character(0)
drivers_skipped_reason <- NULL
usable <- character(0)
model_data <- data.frame(churned = as.integer(work$churned))
term_source <- list() # model column -> list(base, kind)
if (length(base_cols) == 0) {
drivers_skipped_reason <- "no driver columns were mapped"
} else if (n_active == 0 || n_churned == 0) {
drivers_skipped_reason <- paste0(
"driver analysis needs both churned and active customers; this data has ",
if (n_active == 0) "no active(retained) customers" else "no churned customers")
} else {
for (bc in base_cols) {
v <- work[[bc]]
hn <- driver_names[[bc]]
v_chr <- trimws(as.character(v))
nonblank <- !is.na(v_chr) & v_chr != ""
if (sum(nonblank) == 0) {
dropped_drivers <- c(dropped_drivers, paste0(hn, " (empty)")); next
}
conv <- suppressWarnings(as.numeric(v_chr))
if (sum(!is.na(conv[nonblank])) >= 0.95 * sum(nonblank)) {Numeric driver (95% rule): impute median, standardize -> OR per SD
conv[is.na(conv)] <- median(conv, na.rm = TRUE)
sdv <- stats::sd(conv)
if (is.na(sdv) || sdv == 0) {
dropped_drivers <- c(dropped_drivers, paste0(hn, " (constant)")); next
}
model_data[[bc]] <- as.numeric(scale(conv))
term_source[[bc]] <- list(base = bc, kind = "numeric")
usable <- c(usable, bc)
} else {Categorical driver: blanks -> Missing, identifier-like dropped, lump to <=8 levels
lv <- ifelse(nonblank, v_chr, "Missing")
n_lev <- length(unique(lv))
if (n_lev > 0.5 * final_rows || n_lev > 50) {
dropped_drivers <- c(dropped_drivers, paste0(hn, " (identifier-like)")); next
}
if (n_lev < 2) {
dropped_drivers <- c(dropped_drivers, paste0(hn, " (constant)")); next
}
tab <- sort(table(lv), decreasing = TRUE)
if (n_lev > 8) {
keep_lv <- names(tab)[1:8]
lv <- ifelse(lv %in% keep_lv, lv, "Other")
tab <- sort(table(lv), decreasing = TRUE)
}
model_data[[bc]] <- stats::relevel(factor(lv), ref = names(tab)[1])
term_source[[bc]] <- list(base = bc, kind = "categorical",
ref = names(tab)[1])
usable <- c(usable, bc)
}
}
if (length(usable) == 0) {
drivers_skipped_reason <-
"none of the mapped driver columns were usable(constant, empty, or identifier-like)"
} else {
fit <- tryCatch(
stats::glm(churned ~ ., data = model_data, family = stats::binomial()),
error = function(e) NULL, warning = function(w) {
suppressWarnings(stats::glm(churned ~ ., data = model_data,
family = stats::binomial()))
})
if (is.null(fit)) {
drivers_skipped_reason <- "the churn-driver model could not be fitted on this data"
} else {
cf <- summary(fit)$coefficients
cf <- cf[rownames(cf) != "(Intercept)", , drop = FALSE]
rows <- list()
for (tm in rownames(cf)) {
est <- cf[tm, "Estimate"]; se <- cf[tm, "Std. Error"]
pv <- cf[tm, "Pr(>|z|)"]
if (is.na(est) || is.na(se) || abs(est) > 10) next # separation / aliased
src <- NULL
for (bc in usable) if (startsWith(tm, bc)) {
if (is.null(src) || nchar(bc) > nchar(src$base)) src <- term_source[[bc]]
}
if (is.null(src)) next
hn <- driver_names[[src$base]]
label <- if (src$kind == "numeric") {
paste0(hn, " (per SD)")
} else {
paste0(hn, ": ", sub(paste0("^", src$base), "", tm),
" vs ", src$ref)
}
rows[[length(rows) + 1]] <- data.frame(
driver = label,
odds_ratio = round(exp(est), 3),
or_lower = round(exp(est - 1.96 * se), 3),
or_upper = round(exp(est + 1.96 * se), 3),
p_value = signif(pv, 3),
log_or = est,
stringsAsFactors = FALSE
)
}
if (length(rows) > 0) {
dd <- do.call(rbind, rows)
dd$effect <- ifelse(dd$odds_ratio >= 1, "increases churn", "decreases churn")
dd$significance <- ifelse(is.na(dd$p_value), "",
ifelse(dd$p_value < 0.001, "***",
ifelse(dd$p_value < 0.01, "**",
ifelse(dd$p_value < 0.05, "*", ""))))
dd <- dd[order(-abs(dd$log_or)), , drop = FALSE]
rownames(dd) <- NULLTop driver: NA-safe — prefer significant terms, else strongest effect
ok_idx <- which(!is.na(dd$log_or))
sig_idx <- which(!is.na(dd$p_value) & dd$p_value < 0.05)
pick <- if (length(sig_idx) > 0) sig_idx[1] else if (length(ok_idx) > 0) ok_idx[1] else NA
if (!is.na(pick)) {
top_driver <- list(label = dd$driver[pick],
odds_ratio = dd$odds_ratio[pick],
p_value = dd$p_value[pick],
effect = dd$effect[pick])
}
drivers_df <- head(dd[, c("driver", "odds_ratio", "or_lower",
"or_upper", "p_value", "effect",
"significance")], 12)
} else {
drivers_skipped_reason <-
"no driver term produced a stable estimate(separation or aliasing)"
}
}
}
}Step 9: Lifetime distribution by status (box)
set.seed(42)
tidx <- if (final_rows > 1000) sample(final_rows, 1000) else seq_len(final_rows)
tenure_df <- data.frame(
status = ifelse(work$churned[tidx], "Churned", "Active"),
tenure_days = round(work$tenure[tidx], 1),
stringsAsFactors = FALSE
)Step 10: Metrics + json answer (all computed)
med_txt <- if (is.na(median_lifetime)) "not reached in the observed window"
else paste0(round(median_lifetime), " days")
metrics <- list(
`Customers` = final_rows,
`Churned` = as.integer(n_churned),
`Churn Rate %` = round(100 * churn_rate, 1),
`Median Lifetime(days)` = if (is.na(median_lifetime)) NA else round(median_lifetime),
`Top Churn Driver` = if (!is.null(top_driver)) top_driver$label else "n/a"
)
json_output <- list(
answer = paste0(
"Churn analysis of ", format(final_rows, big.mark = ","), " customers(from '",
start_name, "' and '", churn_name, "'): ", round(100 * churn_rate, 1),
"% have churned(", format(n_churned, big.mark = ","), " churned, ",
format(n_active, big.mark = ","), " still active as of ",
as.character(ref_date), "). Median customer lifetime(Kaplan-Meier, ",
"censoring-aware) is ", med_txt, ". ",
if (!is.null(top_driver)) paste0(
"The strongest churn driver is ", top_driver$label, " (odds ratio ",
top_driver$odds_ratio, ", ", top_driver$effect,
if (!is.na(top_driver$p_value)) paste0(", p = ", top_driver$p_value) else "",
").")
else paste0("Driver analysis was skipped: ",
drivers_skipped_reason %||% "no usable drivers", ".")
),
cards = lapply(
c("tldr", "overview", "preprocessing", "churn_by_cohort", "survival_curve",
"churn_drivers", "tenure_distribution", "cohort_table"),
function(cid) list(id = cid, metrics = metrics)
)
)
list(
initial_rows = initial_rows, final_rows = final_rows,
rows_removed = rows_removed,
start_name = start_name, churn_name = churn_name,
churn_mode = churn_mode, ref_date = ref_date,
n_churned = as.integer(n_churned), n_active = as.integer(n_active),
churn_rate = churn_rate, median_lifetime = median_lifetime,
cohort_df = cohort_df, cohort_unit = cohort_unit,
km_df = km_df, drivers_df = drivers_df, top_driver = top_driver,
driver_names = driver_names, dropped_drivers = dropped_drivers,
drivers_skipped_reason = drivers_skipped_reason,
tenure_df = tenure_df,
metrics = metrics, json_output = json_output
)
}NA-safe landmark reads off the curve
s_at <- function(d) {
idx <- which(km$tenure_days <= d)
if (length(idx) == 0) return(NA_real_)
km$survival_pct[max(idx)]
}
s90 <- s_at(90); s365 <- s_at(365)
med_txt <- if (is.na(shared$median_lifetime))
"The curve never crosses 50%, so the median lifetime is not reached within the observed window."
else paste0("The curve crosses 50% at ", round(shared$median_lifetime),
" days — the median customer lifetime.")
text <- paste0(
"The curve shows the share of customers still active after each number of ",
"days since '", shared$start_name, "', using the Kaplan-Meier estimator so ",
"that still-active(censored) customers are counted correctly rather than ",
"treated as churned or dropped. ",
if (!is.na(s90)) paste0(round(s90, 1), "% of customers survive past 90 days",
if (!is.na(s365)) paste0(" and ", round(s365, 1), "% past a year") else "",
". ") else "",
med_txt
)
km <- km[, c("tenure_days", "survival_pct")]
list(
title = "Customer Survival Curve",
description = "Share of customers still active by lifetime(Kaplan-Meier).",
text = text,
chart_labels = list(
tenure_days = "Customer lifetime(days)",
survival_pct = "Still active(%)"
),
data = list(survival_curve = km)
)
}
# Card: churn_drivers (horizontal_bar)
card_churn_drivers <- function(shared, df, params) {
if (is.null(shared$drivers_df)) {
return(list(
title = "Churn Drivers",
description = "No usable driver columns.",
text = paste0("Driver analysis was skipped: ",
shared$drivers_skipped_reason %||% "no usable drivers",
". Map columns such as plan, price tier, region, or usage ",
"metrics as driver columns to rank what predicts churn."),
data = list()
))
}
dd <- shared$drivers_df
n_sig <- sum(dd$p_value < 0.05, na.rm = TRUE)
risk <- dd[dd$odds_ratio >= 1, , drop = FALSE]
prot <- dd[dd$odds_ratio < 1, , drop = FALSE]
text <- paste0(
"Each bar is a driver's churn odds ratio from a logistic regression fit on ",
"all drivers jointly: above 1 means higher churn odds, below 1 lower; the ",
"whiskers are 95% confidence intervals(an interval crossing 1 means the ",
"effect is not statistically distinguishable from none). ",
shared$top_driver$label, " has the strongest effect(odds ratio ",
shared$top_driver$odds_ratio, ", ", shared$top_driver$effect, "). ",
n_sig, " of ", nrow(dd), " terms are significant at p < 0.05.",
if (nrow(risk) > 0 && nrow(prot) > 0) paste0(
" Risk factors: ", paste(head(risk$driver, 3), collapse = "; "),
". Protective: ", paste(head(prot$driver, 3), collapse = "; "), ".") else "",
" Numeric drivers are per standard deviation; odds ratios measure ",
"association, not causation."
)
list(
title = "Churn Drivers",
description = "Odds ratios per driver, with 95% confidence intervals.",
text = text,
chart_labels = list(
driver = "Driver",
odds_ratio = "Churn odds ratio(1 = no effect)"
),
data = list(churn_drivers = dd[, c("driver", "odds_ratio",
"or_lower", "or_upper")])
)
}
# Card: tenure_distribution (box)
card_tenure_distribution <- function(shared, df, params) {
td <- shared$tenure_df
med_ch <- suppressWarnings(median(td$tenure_days[td$status == "Churned"]))
med_ac <- suppressWarnings(median(td$tenure_days[td$status == "Active"]))
both <- length(unique(td$status)) == 2
text <- paste0(
"Each box shows the spread of customer lifetimes(days since '",
shared$start_name, "'). ",
if (both) paste0(
"Churned customers lasted a median of ", round(med_ch),
" days before leaving, while still-active customers have already been ",
"around a median of ", round(med_ac), " days",
if (!is.na(med_ch) && !is.na(med_ac) && med_ac > med_ch) paste0(
" — active customers already outlast the typical churned lifetime, ",
"consistent with churn concentrating early") else "", ". ")
else paste0("All customers in this data share the status '",
unique(td$status), "'. "),
"Note the Active boxes are right-censored: those lifetimes are still growing."
)
list(
title = "Lifetime Distribution — Churned vs Active",
description = "Observed lifetimes split by customer status.",
text = text,
chart_labels = list(
status = "Customer status",
tenure_days = "Lifetime(days)"
),
data = list(tenure_by_status = td)
)
}
# Card: cohort_table (table)
card_cohort_table <- function(shared, df, params) {
cd <- shared$cohort_df
biggest <- cd[which.max(cd$customers), ]
text <- paste0(
"One row per ", shared$cohort_unit, " signup cohort: how many customers ",
"started, how many have churned, and the cohort's churn rate. The largest ",
"cohort is ", biggest$cohort_month, " with ",
format(biggest$customers, big.mark = ","), " customers(",
biggest$churn_rate_pct, "% churned). Older cohorts have had more time at ",
"risk, so read the rates alongside cohort age."
)
list(
title = "Cohort Detail",
description = paste0("Per-", shared$cohort_unit, " cohort sizes and churn."),
text = text,
data = list(cohort_table = cd)
)
}