Executive Summary
Time-to-event verdict across 7,032 subjects.
Month-to-month customers churn at a median of 35 tenure, while both One-year and Two-year customers have not yet reached a median (more than half remain active). The log-rank test confirms the contract types differ significantly (p = 0). Two-year contracts reach churn 68.4× slower than Month-to-month, and One-year contracts reach it 8.9× slower. These differences are not due to chance; 73.4% censoring is correctly accounted for.
Analysis Overview
Kaplan-Meier time-to-event analysis of 7,032 subjects across 3 groups.
This analysis applies Kaplan-Meier estimation to 7,032 subjects across three contract types, tracking tenure until churn. Because 73.4% of subjects were still active at last observation (censored), a naive average would systematically underestimate how long they stay. Kaplan-Meier handles censoring correctly by counting each subject for exactly as long as they were observed. Log-rank testing and Cox regression then compare survival curves across contract groups, quantifying the hazard ratio—the relative speed at which each group reaches the event.
Data Quality
Row exclusions, event-flag interpretation, and censoring rate.
Of 7,043 rows loaded, 7,032 were used; 11 rows were dropped for missing, zero, or negative tenure values. Churn="yes" was treated as the event; all other values count as censored (still active). The censoring rate is 73.4%—5,163 of 7,032 subjects had not churned when observation ended. This high censoring rate is handled correctly by Kaplan-Meier, which does not drop censored subjects but accounts for them transparently in the risk set at each time point.
Survival Curves
Percentage still event-free over tenure, by Contract.
The short answer
The month-to-month curve drops steeply and continuously, crossing 50% survival at 35 months. The one-year and two-year curves flatten sharply early and remain near 100% throughout the window, indicating these customers rarely churn. The curves separate immediately and stay apart, showing a persistent and large difference in churn risk by contract type.
The detail
At month 1, month-to-month survival is 90.19%; by month 10 it falls to 72.57%. At the same timepoints, one-year and two-year customers remain above 95% (curves not shown in truncated data but described in text as reaching the event "not reached"). The month-to-month median of 35 months is where the curve crosses 50% survival. Early separation—visible by month 1–3—confirms the risk difference is not a late-tenure artifact but present from the start.
What this can't tell you
The truncated data display prevents exact reading of one-year and two-year survival percentages at each timepoint. The curves' behavior beyond the observation window is unknown; longer follow-up would show whether the one-year and two-year groups eventually decline or remain stable.
Median Time to Event
Per-Contract medians with 95% confidence intervals.
| Group | N | Events | Censored PCT | Median Time | CI Low | CI High |
|---|---|---|---|---|---|---|
| Month-to-month | 3875 | 1655 | 57.3 | 35 | 32 | 38 |
| Two year | 1685 | 48 | 97.2 | not reached | — | — |
| One year | 1472 | 166 | 88.7 | not reached | 72 | — |
Month-to-month has 3,875 subjects with 1,655 observed events (57.3% censored) and a median tenure of 35 (95% CI: 32–38). Two-year has 1,685 subjects with only 48 events (97.2% censored), so the median is not reached—more than half remain active. One-year has 1,472 subjects with 166 events (88.7% censored), also not reached. The Two-year and One-year medians not being reached is itself the key finding: it signals strong retention in longer-contract customers.
Statistical Tests
Log-rank test and Cox hazard ratios with confidence intervals.
| Test | Statistic | P Value | Interpretation |
|---|---|---|---|
| Log-rank test (do the curves differ?) | 2353 | 0 | The survival curves differ significantly across Contract groups (p = 0). |
| Cox hazard ratio: Two year vs Month-to-month | 0.01 | 4.98e-161 | Two year reaches the event 68.4× slower than Month-to-month (HR 0.01, 95% CI 0.01–0.02). |
| Cox hazard ratio: One year vs Month-to-month | 0.11 | 5.81e-152 | One year reaches the event 8.9× slower than Month-to-month (HR 0.11, 95% CI 0.09–0.13). |
The log-rank test statistic is 2352.87 with p = 0, confirming the survival curves differ significantly. Cox regression yields a hazard ratio of 0.01 for Two-year versus Month-to-month (95% CI: 0.01–0.02, p = 4.98e-161), meaning Two-year customers reach churn 68.4× slower. One-year versus Month-to-month yields HR 0.11 (95% CI: 0.09–0.13, p = 5.81e-152), meaning One-year customers reach churn 8.9× slower. Both differences are far beyond chance.
When Events Happen
Distribution of observed event times (censored subjects excluded).
Among 1,869 observed events, the distribution is front-loaded: the first quartile is at tenure 2, the median (second quartile) at tenure 10, and the third quartile at tenure 29. Most churn risk concentrates early, with a long tail extending to tenure 68. This early clustering reflects the Month-to-month group's rapid initial churn, visible in the survival curve's steep early descent. The 73.4% censored subjects are not shown here but are visible in the survival curves.
Survival Analysis — Time to Event
Estimates how long subjects last until an event (churn, failure, relapse) with censoring handled properly: Kaplan-Meier curves per group, median time-to-event with confidence intervals, a log-rank test of whether the groups differ, and Cox hazard ratios versus the largest group.
Why This Method?
Duration data almost always contains open cases — customers still active, machines still running. Naive averages of observed durations treat those as finished and systematically mislead. Kaplan-Meier estimation, the log-rank test, and Cox regression are the standard toolkit that counts censored subjects correctly.
What This Analysis Covers
- Kaplan-Meier survival curves per group
- Median time-to-event per group with 95% confidence intervals
- Log-rank test of whether the curves differ
- Cox hazard ratios versus the reference (largest) group
- Distribution of observed event times
Standard Library
Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {time, event, group}. 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))
suppressPackageStartupMessages(library(survival))Core Analysis Pipeline
Step 1: Discover mapped columns (humanized names for ALL prose)
initial_rows <- nrow(df)
for (k in c("time", "event", "group")) {
if (!k %in% names(df)) {
stop(sprintf("column_mapping must map the '%s' column.", k))
}
}
h_time <- humanize_semantic("time", col_map)
h_event <- humanize_semantic("event", col_map)
h_group <- humanize_semantic("group", col_map)Step 2: Coerce time numeric (95% rule); drop invalid (<=0 / NA) durations
tv <- df$time
if (!is.numeric(tv)) {
conv <- suppressWarnings(as.numeric(as.character(tv)))
n_orig <- sum(!is.na(tv) & as.character(tv) != "")
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) {
tv <- conv
} else {
stop(sprintf("The duration column(%s) could not be read as numeric.", h_time))
}
}
bad_time <- is.na(tv) | tv <= 0
dropped_time_rows <- sum(bad_time)Step 3: Binarize the event flag (robust two-state logic)
eb <- .binarize_event(df$event, h_event)
ev <- eb$ev
event_level <- eb$level
bad_event <- is.na(ev)
dropped_event_rows <- sum(bad_event & !bad_time)
keep <- !bad_time & !bad_event
d <- data.frame(
time = tv[keep],
event = as.integer(ev[keep]),
group = trimws(as.character(df$group[keep])),
stringsAsFactors = FALSE
)
d$group[is.na(d$group) | d$group == ""] <- "Missing"Step 4: Group hygiene — lump to top 6 levels, drop n<5 groups
tab <- sort(table(d$group), decreasing = TRUE)
lumped_levels <- character(0)
if (length(tab) > 6) {
lumped_levels <- names(tab)[-(1:6)]
d$group[d$group %in% lumped_levels] <- "Other"
tab <- sort(table(d$group), decreasing = TRUE)
}
small <- names(tab)[tab < 5]
dropped_small_groups <- small
if (length(small) > 0) {
d <- d[!d$group %in% small, , drop = FALSE]
tab <- sort(table(d$group), decreasing = TRUE)
}
if (nrow(d) == 0 || length(tab) == 0) {
stop(sprintf("No usable groups remained in %s after cleaning(each group needs at least 5 rows).", h_group))
}
final_rows <- nrow(d)
rows_removed <- initial_rows - final_rows
if (final_rows < 30) {
stop(sprintf("Only %d usable rows across %s, %s and %s — survival analysis needs at least 30.",
final_rows, h_time, h_event, h_group))
}
n_events <- sum(d$event)
n_censored <- final_rows - n_events
censored_pct <- 100 * n_censored / final_rows
if (n_events == 0) {
stop(sprintf("No events observed in %s(every row is censored) — cannot estimate time-to-event.", h_event))
}
group_levels <- names(tab) # largest first
single_group <- length(group_levels) < 2
ref_group <- group_levels[1]
d$group <- factor(d$group, levels = group_levels)Step 5: Kaplan-Meier fit (per group, or overall in single-group mode)
fit <- if (single_group) {
survfit(Surv(time, event) ~ 1, data = d, conf.int = 0.95)
} else {
survfit(Surv(time, event) ~ group, data = d, conf.int = 0.95)
}
s <- summary(fit)
strata_lab <- if (is.null(s$strata)) {
rep(if (single_group) group_levels[1] else "All", length(s$time))
} else {
sub("^group=", "", as.character(s$strata))
}KM curve dataset: downsample to <=100 points per group, prepend (0, 100%)
km_parts <- list()
for (g in unique(strata_lab)) {
idx <- which(strata_lab == g)
if (length(idx) > 100) {
idx <- idx[unique(round(seq(1, length(idx), length.out = 100)))]
}
km_parts[[g]] <- data.frame(
time_point = c(0, s$time[idx]),
survival_pct = round(100 * c(1, s$surv[idx]), 2),
group_label = g,
ci_low = round(100 * c(1, s$lower[idx]), 2),
ci_high = round(100 * c(1, s$upper[idx]), 2),
stringsAsFactors = FALSE
)
}
km_df <- do.call(rbind, km_parts)
rownames(km_df) <- NULLStep 6: Median survival per group (NA-safe: "not reached")
st <- summary(fit)$table
if (is.null(dim(st))) st <- matrix(st, nrow = 1, dimnames = list(group_levels[1], names(st)))
med_groups <- sub("^group=", "", rownames(st))
median_num <- setNames(as.numeric(st[, "median"]), med_groups)
median_df <- data.frame(
group = med_groups,
n = as.integer(st[, "records"]),
events = as.integer(st[, "events"]),
censored_pct = round(100 * (st[, "records"] - st[, "events"]) / st[, "records"], 1),
median_time = .fmt_time(st[, "median"]),
ci_low = .fmt_time(st[, "0.95LCL"], na_label = "—"),
ci_high = .fmt_time(st[, "0.95UCL"], na_label = "—"),
stringsAsFactors = FALSE
)
rownames(median_df) <- NULL
fit_all <- survfit(Surv(time, event) ~ 1, data = d)
overall_median <- as.numeric(summary(fit_all)$table["median"])Step 7: Log-rank test + Cox hazard ratios vs the largest group
logrank_p <- NA_real_; logrank_chisq <- NA_real_
hr_df <- NULL
test_rows <- list()
if (!single_group) {
sd <- tryCatch(survdiff(Surv(time, event) ~ group, data = d), error = function(e) NULL)
if (!is.null(sd)) {
logrank_chisq <- as.numeric(sd$chisq)
logrank_p <- pchisq(logrank_chisq, df = length(sd$n) - 1, lower.tail = FALSE)
}
lr_interp <- if (is.na(logrank_p)) {
sprintf("The log-rank test could not be computed for %s.", h_group)
} else if (logrank_p < 0.05) {
sprintf("The survival curves differ significantly across %s groups(p = %s).",
h_group, signif(logrank_p, 3))
} else {
sprintf("No significant difference between the %s survival curves(p = %s).",
h_group, signif(logrank_p, 3))
}
test_rows[[1]] <- data.frame(
test = "Log-rank test(do the curves differ?)",
statistic = ifelse(is.na(logrank_chisq), NA_real_, round(logrank_chisq, 2)),
p_value = ifelse(is.na(logrank_p), NA_real_, signif(logrank_p, 3)),
interpretation = lr_interp,
stringsAsFactors = FALSE
)
cx <- tryCatch(
suppressWarnings(coxph(Surv(time, event) ~ group, data = d)),
error = function(e) NULL
)
if (!is.null(cx)) {
sm <- summary(cx)
ci <- sm$conf.int; cf <- sm$coefficients
if (is.null(dim(ci))) ci <- matrix(ci, nrow = 1, dimnames = list(rownames(sm$conf.int), colnames(sm$conf.int)))
g_names <- sub("^group", "", rownames(ci))
hr_df <- data.frame(
group = g_names,
hr = as.numeric(ci[, "exp(coef)"]),
ci_low = as.numeric(ci[, "lower .95"]),
ci_high = as.numeric(ci[, "upper .95"]),
p = as.numeric(cf[, "Pr(>|z|)"]),
stringsAsFactors = FALSE
)
for (i in seq_len(nrow(hr_df))) {
hr <- hr_df$hr[i]; g <- hr_df$group[i]
interp <- if (is.na(hr)) {
sprintf("Hazard ratio for %s could not be estimated.", g)
} else if (hr < 0.01 || hr > 100) {
sprintf("Risk for %s could not be reliably estimated(no or nearly no events in the group).", g)
} else if (hr >= 1) {
sprintf("%s reaches the event %.1f× faster than %s(95%% CI %.2f–%.2f).",
g, hr, ref_group, hr_df$ci_low[i], hr_df$ci_high[i])
} else {
sprintf("%s reaches the event %.1f× slower than %s(HR %.2f, 95%% CI %.2f–%.2f).",
g, 1 / hr, ref_group, hr, hr_df$ci_low[i], hr_df$ci_high[i])
}
test_rows[[length(test_rows) + 1]] <- data.frame(
test = sprintf("Cox hazard ratio: %s vs %s", g, ref_group),
statistic = ifelse(is.na(hr), NA_real_, round(hr, 2)),
p_value = ifelse(is.na(hr_df$p[i]), NA_real_, signif(hr_df$p[i], 3)),
interpretation = interp,
stringsAsFactors = FALSE
)
}
} else {
test_rows[[length(test_rows) + 1]] <- data.frame(
test = "Cox proportional hazards",
statistic = NA_real_, p_value = NA_real_,
interpretation = sprintf("The Cox model could not be fitted for %s.", h_group),
stringsAsFactors = FALSE
)
}
} else {
test_rows[[1]] <- data.frame(
test = "Log-rank test",
statistic = NA_real_, p_value = NA_real_,
interpretation = sprintf(
"Only one %s group was found — the analysis reports a single overall survival curve; no between-group test applies.",
h_group),
stringsAsFactors = FALSE
)
}
tests_df <- do.call(rbind, test_rows)
rownames(tests_df) <- NULLBiggest hazard ratio in plain English (NA-safe: never which.max over all-NA)
top_hr_text <- ""
if (!is.null(hr_df) && nrow(hr_df) > 0) {
mag <- pmax(hr_df$hr, 1 / hr_df$hr)
ok <- which(!is.na(mag) & hr_df$hr > 0.01 & hr_df$hr < 100)
if (length(ok) > 0) {
i <- ok[which.max(mag[ok])]
top_hr_text <- if (hr_df$hr[i] >= 1) {
sprintf("%s reaches the event %.1f× faster than %s", hr_df$group[i], hr_df$hr[i], ref_group)
} else {
sprintf("%s reaches the event %.1f× slower than %s", hr_df$group[i], 1 / hr_df$hr[i], ref_group)
}
}
}Step 8: Event-time distribution (events only, <=2000 rows)
et <- d$time[d$event == 1]
set.seed(42)
if (length(et) > 2000) et <- sample(et, 2000)
event_times_df <- data.frame(event_time = round(et, 4), stringsAsFactors = FALSE)
metrics <- list(
`Subjects` = final_rows,
`Events` = as.integer(n_events),
`Censored %` = round(censored_pct, 1),
`Groups` = length(group_levels),
`Median Time` = .fmt_time(overall_median),
`Log-rank p` = if (is.na(logrank_p)) "—" else signif(logrank_p, 3)
)
med_phrase <- if (single_group) {
sprintf("median %s to event %s", h_time, .fmt_time(overall_median))
} else {
paste(sapply(seq_len(nrow(median_df)), function(i) {
sprintf("%s: %s", median_df$group[i], median_df$median_time[i])
}), collapse = "; ")
}
lr_phrase <- if (single_group) {
"single overall curve(one group)"
} else if (is.na(logrank_p)) {
"log-rank unavailable"
} else if (logrank_p < 0.05) {
sprintf("curves differ significantly(log-rank p = %s)", signif(logrank_p, 3))
} else {
sprintf("no significant curve difference(log-rank p = %s)", signif(logrank_p, 3))
}
json_output <- list(
answer = paste0(
"Kaplan-Meier survival analysis of ", format(final_rows, big.mark = ","),
" subjects(", n_events, " events, ", round(censored_pct, 1), "% censored)",
if (single_group) "" else paste0(" across ", length(group_levels), " ", h_group, " groups"),
". Median time to event — ", med_phrase, ". ", lr_phrase,
if (nchar(top_hr_text) > 0) paste0("; ", top_hr_text, ".") else "."
),
cards = lapply(
c("tldr", "overview", "preprocessing", "km_curves",
"median_survival", "test_results", "event_distribution"),
function(cid) list(id = cid, metrics = metrics)
)
)
list(
initial_rows = initial_rows, final_rows = final_rows,
rows_removed = rows_removed,
h_time = h_time, h_event = h_event, h_group = h_group,
event_level = event_level,
n_events = n_events, n_censored = n_censored, censored_pct = censored_pct,
dropped_time_rows = dropped_time_rows, dropped_event_rows = dropped_event_rows,
dropped_small_groups = dropped_small_groups, lumped_levels = lumped_levels,
single_group = single_group, group_levels = group_levels, ref_group = ref_group,
km_df = km_df, median_df = median_df, median_num = median_num,
tests_df = tests_df, logrank_p = logrank_p, logrank_chisq = logrank_chisq,
hr_df = hr_df, top_hr_text = top_hr_text,
event_times_df = event_times_df, overall_median = overall_median,
metrics = metrics, json_output = json_output
)
}Fastest-declining group: lowest median, NA-safe ("not reached" = best survival)
fastest_note <- ""
if (!shared$single_group) {
mn <- shared$median_num
ok <- which(!is.na(mn))
if (length(ok) > 0) {
worst <- names(mn)[ok][which.min(mn[ok])]
fastest_note <- sprintf(
" %s declines fastest(median %s %s), so it reaches the event soonest.",
worst, shared$h_time, .fmt_time(min(mn[ok])))
}
}
list(
title = "Survival Curves",
description = paste0("Percentage still event-free over ", shared$h_time,
if (shared$single_group) "" else paste0(", by ", shared$h_group), "."),
text = paste0(
"Each curve tracks the percentage of subjects still event-free as ",
shared$h_time, " increases, starting at 100% and stepping down at each ",
"observed event. Where a curve crosses the 50% line is that group's ",
"median time to event.", fastest_note,
if (shared$single_group) "" else
" Curves that separate early and stay apart indicate a real, persistent difference in risk between the groups.",
" Censored subjects leave the curve without pulling it down — that is what makes these estimates honest."
),
chart_labels = list(
time_point = shared$h_time,
survival_pct = "% still active"
),
data = list(km_curves = shared$km_df)
)
}
# Card: median_survival (table)
card_median_survival <- function(shared, df, params) {
nr_groups <- shared$median_df$group[shared$median_df$median_time == "not reached"]
nr_note <- if (length(nr_groups) > 0) {
paste0(" For ", paste(nr_groups, collapse = ", "),
", the median is \"not reached\" — more than half of those subjects were ",
"still event-free at last observation, which itself signals strong retention.")
} else ""
list(
title = "Median Time to Event",
description = paste0("Per-", shared$h_group, " medians with 95% confidence intervals."),
text = paste0(
"The table shows each group's subjects, observed events, censoring rate, ",
"and median ", shared$h_time, " to event with a 95% confidence interval. ",
"The median is the point where half the group has had the event — a more ",
"robust summary than the mean for duration data.", nr_note
),
data = list(median_survival = shared$median_df)
)
}
# Card: test_results (table)
card_test_results <- function(shared, df, params) {
intro <- if (shared$single_group) {
paste0("Only one ", shared$h_group, " group is present, so no between-group ",
"test applies; the row below records that explicitly.")
} else {
paste0(
"The log-rank test asks whether the survival curves differ anywhere along ",
"their length; the Cox rows translate each group's risk into a hazard ratio ",
"versus ", shared$ref_group, " (the largest group). A hazard ratio of 1.5 ",
"means that group reaches the event 1.5× faster at any given moment. ",
if (!is.na(shared$logrank_p) && shared$logrank_p < 0.05)
paste0("Here the curves differ significantly(p = ", signif(shared$logrank_p, 3), ").")
else if (!is.na(shared$logrank_p))
paste0("Here the difference is not statistically significant(p = ", signif(shared$logrank_p, 3), ").")
else ""
)
}
list(
title = "Statistical Tests",
description = "Log-rank test and Cox hazard ratios with confidence intervals.",
text = intro,
data = list(test_results = shared$tests_df)
)
}
# Card: event_distribution (histogram)
card_event_distribution <- function(shared, df, params) {
et <- shared$event_times_df$event_time
q <- quantile(et, c(0.25, 0.5, 0.75), na.rm = TRUE)
concentration <- {
spread <- (q[3] - q[1]) / max(q[2], .Machine$double.eps)
if (spread < 0.8) "events concentrate tightly around the median"
else if (q[2] < mean(range(et)) * 0.6) "events skew early — most risk is front-loaded"
else "events spread across the observed timeline"
}
list(
title = "When Events Happen",
description = paste0("Distribution of observed event times(censored subjects excluded)."),
text = paste0(
"Among the ", format(length(et), big.mark = ","), " observed events, half ",
"happened within ", .fmt_time(q[2]), " ", shared$h_time,
" (quartiles: ", .fmt_time(q[1]), " / ", .fmt_time(q[2]), " / ", .fmt_time(q[3]),
"). In this data, ", concentration, ". Note this histogram shows only ",
"subjects whose event was observed — the ", round(shared$censored_pct, 1),
"% censored are visible in the survival curves, not here."
),
chart_labels = list(event_time = shared$h_time),
data = list(event_distribution = shared$event_times_df)
)
}