Cohort Retention
Shows how many customers stay active in each period after they first arrive, cohort by cohort, whether newer cohorts retain better than older ones, and which segments keep customers longest.
RUN DATE · 27 October 2026
DATA · 17,020 rows
Of customers who first bought from January 2010 on, how many come back after their first month, cohort by cohort, and do newer cohorts keep more customers than older ones? Customers already buying in December 2009, the first month of the data, are left out because we cannot see when they started.
- SummaryHow many customers, how many cohorts, and the share still active after one, three and six periods.
- Retention by periodThe share still active each period after arrival, all cohorts and earlier against later.
- Every cohort by periodEach cohort's share still active each period after it arrived.
- First-period retention by cohortEach cohort's share still active one period after arriving.
- Cohort sizesHow many customers first arrived in each period.
- Retention by segmentThe share still active each period, one line per segment.
- Every cohortEach cohort's size and its share still active after one, three, six and twelve periods.
- What the results rely onEach condition the retention figures depend on, and whether it holds.
- How it was doneThe method, the data used, and what to keep in mind.
Come back here means bought in that month. The data run to 9 December 2011; the report's data ends 2011-12-01 reflects the extract's first-of-month dates, and December 2011 is a partial month that is not used.
Data: Chen, D. (2012). Online Retail II. UCI Machine Learning Repository. CC BY 4.0. doi:10.24432/C5CG6D. Changes: one row per customer per month with a purchase (rows with no customer ID, cancellations, and zero or negative quantity or price removed); customers whose first purchase was December 2009 removed; December 2011 is a partial month and not used.
Who comes back
Later cohorts sit above earlier cohorts
After a steep first drop the curve flattens, and later cohorts stay above earlier ones at every period both have reached.
Compare the later and earlier lines at periods one and two, where the gap is wide, and again near period nine.
Later cohorts sit above earlier cohorts
All three lines fall sharply from arrival, hold near level through the middle periods, then slip lower toward the end. The later line is above the earlier line at each shared period, but the gap is uneven: wide early, narrow around the third and middle periods, then wider again near the ninth, so the lines do not simply converge. The later line stops sooner because those cohorts are younger. The far end rests on few, old cohorts and its rebound at the last period is less certain.
Compare the later and earlier lines at periods one and two, where the gap is wide, and again near period nine.
Who comes back
Retention falls fast, then sits in a narrow band
Every cohort starts full and drops sharply, after which cells settle into a fairly narrow low band with a few high outliers.
Start with the full first column, then see how far the later cells drop and how tightly they cluster.
Retention falls fast, then sits in a narrow band
The first column is full for every cohort, and later cells are far lower, with a middle range that stays fairly tight. A few cells sit well above that range, which is why the upper tail is long. Blank cells are periods a cohort has not reached, so short rows for newer cohorts are not low retention. To judge newer against older, compare cohorts at the same period, starting with the first period after arrival.
Start with the full first column, then see how far the later cells drop and how tightly they cluster.
Across cohorts
First-period retention is higher in newer cohorts
First-period retention is generally higher for newer cohorts, though 2010 bounces around, so newer cohorts do keep more customers early.
Follow the bars from 2011-04 onward, ending at 2011-10 as the highest, and note 2010-12 as the lowest.
First-period retention is higher in newer cohorts
Across 2010 the bars move up and down without a clear direction, with 2010-10 a high and 2010-12 the lowest. From 2011-04 onward the bars sit consistently higher, and 2011-10 is the highest, ahead of 2011-08 and 2011-09. The run supports a rise, not just the first and last bars, but it is noisy. 2010-12 is a small cohort, so its low value may overstate a real dip. The newest cohort has no bar yet.
Follow the bars from 2011-04 onward, ending at 2011-10 as the highest, and note 2010-12 as the lowest.
Across cohorts
Arrivals shrank, then recovered late in 2011
Early 2010 cohorts were the largest, arrivals thinned out into 2011, then picked up again in the autumn.
Look at the tall bars in early 2010, then the very small bars at 2010-12 and 2011-01.
Arrivals shrank, then recovered late in 2011
The largest cohort is 2010-03 and the smallest is 2011-01, with 2010-12 also very small. Mid 2011 cohorts are modest, and arrivals rebuild from 2011-09 onward. Small cohorts such as 2010-12 and 2011-01 make their retention swing more, so read their rates with caution. Newer cohorts are generally smaller than the early 2010 ones, which makes comparisons across the two halves noisier.
Look at the tall bars in early 2010, then the very small bars at 2010-12 and 2011-01.
Between groups
not shown for this data
no segment column was mapped, so retention is not compared between groups
The numbers
Newer cohorts lead early, later periods mixed
Newer cohorts do better at the first period, but at the third, sixth and twelfth periods no clear age pattern appears.
On this card's data, 2010-03 is the largest, ahead of 2011-10.
Newer cohorts lead early, later periods mixed
At the first period, the newest cohorts such as 2011-10, 2011-08 and 2011-09 are well ahead of most 2010 cohorts. At the third period the highest values are 2010-08, 2010-01 and 2010-07, so older cohorts lead there, while 2010-09 to 2010-12 are low. Sixth and twelfth period values are mixed and only older cohorts reach the twelfth. Blank cells are periods not yet reached, not zero. Cohort size has almost no link to retention.
On this card's data, 2010-03 is the largest, ahead of 2011-10.
Assumptions and method
All five checks hold
All five assumption checks hold, so nothing here limits how far the results can be trusted.
Holding: enough cohorts, cohorts large enough, long enough to watch retention, repeat activity recorded, dates readable.
All five checks hold
The checks that hold: enough cohorts, cohorts large enough, long enough to watch retention, repeat activity recorded, dates readable.
Holding: enough cohorts, cohorts large enough, long enough to watch retention, repeat activity recorded, dates readable.
Cohort retention for 4895 customers (customer_id) by month of first activity in activity_date: 23 cohorts from 2010-01 to 2011-11; a customer is retained at period N when active in the month N months after their first; averages over cohorts are weighted by cohort size and use only cohorts that have reached that period; earlier and later cohorts are the first and second half by arrival, each point drawn only where two or more of its cohorts and 50 customers have reached that period; excluded: the incomplete final month (2011-12, data ends 2011-12-01): 427 rows.
16593 of 17020 rows · customer_id → activity_date
caveatRetention counts only activity in the exact month, and the incomplete final month was dropped; the run's checks say this held.
Cohorts are set by each customer's first month of activity, and the unfinished last month was excluded so it would not look like lost customers. A month with no activity counts as not retained even if the customer returns later, so these figures understate eventual return. Later periods rest on fewer, older cohorts, and seasonality or campaigns are folded into each cohort, so compare older and newer cohorts only at the same period.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint 5120e0222728c710. The same code on the same data gives the same report.
`standard_cohort_retention_v2` <- function(pf) {
`%||%` <- function(a, b) if (!is.null(a)) a else b
#' Readable figures (LAT-3180, LAT-3181): whole numbers from a thousand up, one decimal from a hundred, two from
#' one, three significant figures below one. A cell carries what the value needs, not what R prints.
tidy <- function(x) {
x <- as.numeric(x)
ifelse(is.na(x), NA_real_,
ifelse(abs(x) >= 1000, round(x, 0),
ifelse(abs(x) >= 100, round(x, 1),
ifelse(abs(x) >= 1, round(x, 2), signif(x, 3)))))
}
inputs <- pf$taskList$inputs
params <- inputs$module_parameters %||% list()
# THE QUESTION this tool answers: the customer's objective, verbatim, when given.
question <- (inputs$userContext %||% list())$objective %||%
"How many customers come back after they first arrive, and is retention getting better or worse?"
#' ## Column mapping
#' An activity log, one row per order, visit or event: `customer_id` (who) and `activity_date` (when), and optionally
#' `segment` (a plan, channel or region) to compare retention between groups. Semantic names inside.
col_map <- inputs$column_mapping %||% list()
df <- renderObject.taskFunction.init(inputs, col_map) # df has SEMANTIC names
human <- function(sem) {
v <- col_map[[sem]]
if (is.null(v) || !nzchar(as.character(v))) sem else as.character(v)
}
cust_name <- human("customer_id"); date_name <- human("activity_date")
for (sem in c("customer_id", "activity_date"))
if (!(sem %in% names(df))) stop(sprintf("column_mapping must map '%s' (%s was not found).", sem, human(sem)))
has_segment <- "segment" %in% names(df)
n_in <- nrow(df)
raw_names <- local({
ds <- inputs$dataset %||% inputs$df
if (is.data.frame(ds)) return(names(ds))
if (is.list(ds) && length(ds) > 0) {
rows <- ds[seq_len(min(length(ds), 50))]
nm <- unique(unlist(lapply(rows, function(r) if (is.list(r)) names(r) else NULL)))
if (length(nm)) return(nm)
if (!is.null(names(ds)) && all(nzchar(names(ds)))) return(names(ds))
}
character(0)
})
mapped_actual <- unique(as.character(unlist(col_map)))
ignored_cols <- setdiff(raw_names, unique(c(mapped_actual, make.names(mapped_actual))))
#' ## Parameters
#' `period`: month (the default), week or quarter; a customer's cohort is the period of their first activity, and
#' retention at period N is the share of the cohort active N periods later. Up to 12 periods and the 24 latest cohorts.
period <- tolower(as.character(params$period %||% "month"))
if (!(period %in% c("week", "month", "quarter"))) stop("module_parameters$period must be week, month or quarter")
H <- 12L; MAXC <- 24L
unit <- c(week = "week", month = "month", quarter = "quarter")[[period]]
#' ## Data preparation
#' Dates are read in the common formats (95% rule). Rows with a blank customer or an unreadable date are excluded and
#' counted. A final period the data does not reach the end of is incomplete, so it is left out and named; otherwise its
#' low activity would read as churn.
cust <- trimws(as.character(df$customer_id))
dts <- local({
x <- df$activity_date
if (inherits(x, "Date")) return(x)
if (inherits(x, "POSIXt")) return(as.Date(x))
s <- trimws(as.character(x)); s[s == ""] <- NA
as.Date(suppressWarnings(lubridate::parse_date_time(s, orders = c("Ymd", "mdY", "dmY", "Ymd HMS", "Ymd HM", "mdY HMS", "dmY HMS"), quiet = TRUE)))
})
n_nonblank <- sum(!is.na(df$activity_date) & trimws(as.character(df$activity_date)) != "")
if (n_nonblank == 0 || sum(!is.na(dts)) < 0.95 * n_nonblank)
stop(sprintf("The %s column could not be read as dates for 95%% of its values; expected values like 2025-01-31 or 1/31/2025.", date_name))
keep <- !is.na(dts) & !is.na(cust) & cust != ""
n_bad <- sum(!keep)
cust <- cust[keep]; dts <- dts[keep]
seg <- if (has_segment) { s <- trimws(as.character(df$segment[keep])); s[is.na(s) | s == ""] <- "(none)"; s } else NULL
pidx <- switch(period,
month = as.integer(format(dts, "%Y")) * 12L + as.integer(format(dts, "%m")) - 1L,
quarter = as.integer(format(dts, "%Y")) * 4L + (as.integer(format(dts, "%m")) - 1L) %/% 3L,
week = as.integer(floor(as.numeric(dts - as.Date("1970-01-05")) / 7)))
pstart <- function(i) switch(period,
month = as.Date(sprintf("%04d-%02d-01", i %/% 12L, i %% 12L + 1L)),
quarter = as.Date(sprintf("%04d-%02d-01", i %/% 4L, 3L * (i %% 4L) + 1L)),
week = as.Date("1970-01-05") + 7L * i)
plabel <- function(i) switch(period,
month = format(pstart(i), "%Y-%m"),
quarter = sprintf("%04d-Q%d", i %/% 4L, i %% 4L + 1L),
week = format(pstart(i), "%Y-%m-%d"))
last_i <- max(pidx); last_date <- max(dts)
next_start <- pstart(last_i + 1L)
partial <- last_date < next_start - 1
if (partial) { drop <- pidx == last_i; n_partial_rows <- sum(drop); cust <- cust[!drop]; dts <- dts[!drop]; pidx <- pidx[!drop]; if (!is.null(seg)) seg <- seg[!drop]; last_i <- last_i - 1L } else n_partial_rows <- 0L
if (!length(pidx)) stop("No complete period of activity remains once the incomplete final period is left out.")
first <- tapply(pidx, cust, min)
cohorts_all <- sort(unique(as.integer(first)))
n_old <- max(0L, length(cohorts_all) - MAXC)
cohorts <- utils::tail(cohorts_all, MAXC)
if (length(cohorts) < 2) stop(sprintf("Every customer first appears in the same %s; cohort retention needs customers arriving in at least two %ss.", unit, unit))
if (last_i - min(cohorts) < 1) stop(sprintf("The complete activity spans a single %s; at least two are needed to measure retention.", unit))
cust_seg <- if (!is.null(seg)) tapply(seq_along(cust), cust, function(ix) seg[ix[which.min(pidx[ix])]]) else NULL
in_scope <- names(first)[as.integer(first) %in% cohorts]
sel <- cust %in% in_scope
ev <- unique(data.frame(cust = cust[sel], p = pidx[sel], stringsAsFactors = FALSE))
ev$cohort <- as.integer(first[ev$cust]); ev$m <- ev$p - ev$cohort
sizes <- as.integer(table(factor(as.integer(first[in_scope]), levels = cohorts)))
n_customers <- length(in_scope)
#' ## The retention matrix: distinct customers active m periods after their cohort, over the cohort's size; a cell a
#' cohort has not reached is left out, never written as zero
maxm <- min(H, last_i - min(cohorts))
cells <- do.call(rbind, lapply(seq_along(cohorts), function(i) {
cc <- cohorts[i]; top <- min(H, last_i - cc)
data.frame(ci = i, m = 0:top, active = vapply(0:top, function(m) sum(ev$cohort == cc & ev$m == m), integer(1)))
}))
cells$pct <- 100 * cells$active / sizes[cells$ci]
matrix_df <- data.frame(cohort = vapply(cohorts[cells$ci], plabel, character(1)), period = paste0("P", cells$m),
retention_pct = round(cells$pct, 1), stringsAsFactors = FALSE)
#' A point on a curve needs at least `min_c` cohorts and 50 customers that have reached that period (LAT-3190 run 1: the
#' later-cohorts line at period 5 was one cohort, and the report read it as a reversal)
wavg <- function(ci_set, m, min_c = 1) { r <- cells[cells$m == m & cells$ci %in% ci_set, ]
if (nrow(r) < min_c || sum(sizes[r$ci]) < (if (min_c > 1) 50 else 1)) NA_real_ else 100 * sum(r$active) / sum(sizes[r$ci]) }
all_ci <- seq_along(cohorts); half <- ceiling(length(cohorts) / 2)
early_ci <- all_ci[seq_len(half)]; late_ci <- setdiff(all_ci, early_ci)
curve_df <- do.call(rbind, lapply(0:maxm, function(m) data.frame(
period = m, retention_pct = round(c(wavg(all_ci, m), wavg(early_ci, m, 2), wavg(late_ci, m, 2)), 1),
series = c("All cohorts", "Earlier cohorts", "Later cohorts"), stringsAsFactors = FALSE)))
curve_df <- curve_df[!is.na(curve_df$retention_pct), , drop = FALSE]
sizes_df <- data.frame(cohort = vapply(cohorts, plabel, character(1)), new_customers = sizes, stringsAsFactors = FALSE)
p1 <- cells[cells$m == 1, ]
p1_df <- data.frame(cohort = vapply(cohorts[p1$ci], plabel, character(1)), p1_retention_pct = round(p1$pct, 1), stringsAsFactors = FALSE)
at <- function(ci, m) { r <- cells[cells$ci == ci & cells$m == m, "pct"]; if (length(r)) round(r, 1) else NA_real_ }
table_df <- data.frame(cohort = sizes_df$cohort, new_customers = sizes,
p1_pct = vapply(all_ci, at, numeric(1), m = 1), p3_pct = vapply(all_ci, at, numeric(1), m = 3),
p6_pct = vapply(all_ci, at, numeric(1), m = 6), p12_pct = vapply(all_ci, at, numeric(1), m = 12), stringsAsFactors = FALSE)
seg_df <- NULL; seg_note <- if (!has_segment) "no segment column was mapped, so retention is not compared between groups" else NULL
if (has_segment) {
segs <- cust_seg[in_scope]; tops <- names(sort(table(segs), decreasing = TRUE))[seq_len(min(6, length(unique(segs))))]
if (length(tops) < 2) seg_note <- sprintf("%s has one value among these customers, so there is nothing to compare", human("segment")) else {
seg_df <- do.call(rbind, lapply(tops, function(sg) {
ids <- names(segs)[segs == sg]
do.call(rbind, lapply(0:maxm, function(m) {
elig <- ids[as.integer(first[ids]) + m <= last_i]
if (length(elig) < 30) return(NULL) # run 1: tails on ten customers crossed and uncrossed at random
act <- sum(unique(ev[ev$cust %in% elig & ev$m == m, "cust"]) %in% elig)
data.frame(period = m, retention_pct = round(100 * act / length(elig), 1), segment = sg, stringsAsFactors = FALSE)
}))
}))
}
}
#' ## Assumption checks (LAT-3138)
multi <- mean(tapply(ev$p, ev$cust, function(x) length(unique(x)) > 1))
obs_oldest <- last_i - min(cohorts)
checks_df <- data.frame(
check = c("Enough cohorts", "Cohorts large enough", "Long enough to watch retention", "Repeat activity recorded", "Dates readable"),
statistic = c(sprintf("%d cohorts", length(cohorts)), sprintf("median cohort: %s customers", format(stats::median(sizes))),
sprintf("oldest cohort observed for %d %ss", obs_oldest, unit), sprintf("%s%% of customers active in more than one %s", format(round(100 * multi, 1)), unit),
sprintf("%d of %d rows excluded", n_bad, n_in)),
p_value = "",
verdict = c(if (length(cohorts) >= 6) "holds" else if (length(cohorts) >= 3) "strained" else "violated",
if (stats::median(sizes) >= 30) "holds" else if (stats::median(sizes) >= 10) "strained" else "violated",
if (obs_oldest >= 6) "holds" else if (obs_oldest >= 3) "strained" else "violated",
if (multi >= 0.05) "holds" else if (multi > 0) "strained" else "violated",
if (n_bad / n_in <= 0.01) "holds" else if (n_bad / n_in <= 0.05) "strained" else "violated"),
note = c("few cohorts make any trend across cohorts a guess",
"a small cohort's retention swings by several points on one customer",
"a short window shows early retention only; later periods rest on the oldest cohorts",
"if almost nobody returns, the data may record first purchases or signups only, not ongoing activity",
"rows with an unreadable date or no customer are left out"),
stringsAsFactors = FALSE)
#' ## Method, assumptions, answer
excluded <- c(if (n_bad > 0) sprintf("%d row%s with no customer or an unreadable date", n_bad, if (n_bad > 1) "s" else ""),
if (partial) sprintf("the incomplete final %s (%s, data ends %s): %d row%s", unit, plabel(last_i + 1L), format(last_date), n_partial_rows, if (n_partial_rows != 1) "s" else ""),
if (n_old > 0) sprintf("%d older cohort%s beyond the latest 24", n_old, if (n_old > 1) "s" else ""))
method <- paste0(
"Cohort retention for ", n_customers, " customers (", cust_name, ") by ", unit, " of first activity in ", date_name, ": ", length(cohorts),
" cohorts from ", plabel(min(cohorts)), " to ", plabel(max(cohorts)), "; a customer is retained at period N when active in the ", unit,
" N ", unit, "s after their first; averages over cohorts are weighted by cohort size and use only cohorts that have reached that period",
"; earlier and later cohorts are the first and second half by arrival, each point drawn only where two or more of its cohorts and 50 customers have reached that period",
if (!is.null(seg_df)) sprintf("; %s compared by each customer's value at first activity, each point drawn where 30 or more of that segment's customers have reached the period", human("segment")) else "",
if (length(excluded)) paste0("; excluded: ", paste(excluded, collapse = "; ")) else "",
if (length(ignored_cols)) paste0("; not used: ", paste(utils::head(ignored_cols, 12), collapse = ", "), " (not mapped)") else "", ".")
assumptions <- list(
"Retention here is activity: a customer with nothing recorded in a period counts as not retained that period, even if they return later.",
"Each customer ID is one customer across the whole log; merged or reissued IDs distort cohorts.",
"Later periods rest on fewer, older cohorts, so the end of a curve is less certain than its start.",
"A cohort's retention reflects everything that happened to it, including seasonality and campaigns, not the product alone.",
"Earlier and later cohorts differ in how long they have been watched; compare them at the same period only.")
r_at <- function(m) wavg(all_ci, m)
answer <- list(period = unit, cohorts = length(cohorts), customers = n_customers,
retention_p1_pct = round(r_at(1), 1), retention_p3_pct = if (maxm >= 3) round(r_at(3), 1) else NULL,
retention_p6_pct = if (maxm >= 6) round(r_at(6), 1) else NULL, n = length(cust))
results <- list()
#' The verdict and the headline are NOT places of a library tool (LAT-3130): the last mile writes them.
sm <- list(customers = n_customers, cohorts = length(cohorts), p1_retention_pct = round(r_at(1), 1))
if (maxm >= 3) sm$p3_retention_pct <- round(r_at(3), 1)
if (maxm >= 6) sm$p6_retention_pct <- round(r_at(6), 1)
sm$periods_observed <- as.integer(maxm)
results$summary_metrics <- place_metric(sm, lead = "p1_retention_pct", place = "summary_metrics")
results$retention_matrix <- place_matrix(matrix_df, x = "period", y = "cohort", z = "retention_pct", place = "retention_matrix")
results$retention_curve <- place_trend(curve_df, x = "period", y = "retention_pct", series = "series", place = "retention_curve")
results$cohort_sizes <- place_comparison(sizes_df, category = "cohort", value = "new_customers", place = "cohort_sizes")
results$first_period_retention <- place_comparison(p1_df, category = "cohort", value = "p1_retention_pct", place = "first_period_retention")
if (!is.null(seg_df) && nrow(seg_df) > 0) {
results$segment_retention <- place_trend(seg_df, x = "period", y = "retention_pct", series = "segment", place = "segment_retention")
} else {
results$segment_retention <- place_dropped(seg_note %||% "no segment had ten customers old enough to compare", place = "segment_retention")
}
results$cohort_table <- place_table(table_df, place = "cohort_table")
results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
results$retention_method <- list(kind = "metric", values = list(
method = method, n_in = n_in, n_used = length(cust), excluded = as.list(excluded), assumptions = assumptions,
x_column = cust_name, y_column = date_name),
value_order = list("n_used", "n_in"))
objects <- list() # filled by the object layer, not here
list(answer = answer, method = method, n = length(cust), results = results, objects = objects,
json_output = list(answer = answer, method = method, n = length(cust)))
}