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.

VERSION · v1.0.0
RUN DATE · 14 September 2026
DATA · 4,044 rows
Objective

How many of our customers keep ordering after their first month, and is retention improving for newer cohorts?

This report contains
  • 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.
1 / 9
Cohort Retention

Who comes back

Later cohorts retain better early, then converge

Later cohorts start stronger but all retention falls steeply then stabilizes, with no sustained improvement.

Period one shows later cohorts clearly ahead, but the gap closes and reverses by period four onward.

2 / 9
Cohort Retention

Who comes back

Newer cohorts show stronger second month retention

Newer cohorts retain more in early periods, but all fade similarly after month two.

Compare P1 retention across cohorts: 2025-11 and 2025-07 lead, while 2025-01 and 2025-04 lag behind.

3 / 9
Cohort Retention

Across cohorts

First-period retention rises sharply for newest cohorts

Newest cohorts show stronger retention than earlier ones, answering whether retention improves for newer arrivals.

The November cohort stands clearly ahead; earlier cohorts from April through June cluster at the low end.

Customer arrivals stay roughly level across periods

New customer arrivals stay roughly level across all cohorts, so cohort size does not skew retention comparisons.

Each cohort shows similar customer counts with no sustained trend upward or downward across the timeline.

4 / 9
Cohort Retention

Between groups

Pro customers retain better than Basic

Pro customers stay active at higher rates than Basic through most periods, answering retention by segment.

Pro line starts higher at period one and stays above Basic through period ten, showing the gap clearly.

5 / 9
Cohort Retention

The numbers

Retention declines sharply after first month

Most customers order again within one month, but retention falls steeply by month six across all cohorts.

2025-06 shows an anomalous rise in three-month retention compared to one-month, breaking the typical decline pattern.

6 / 9
Cohort Retention

Assumptions

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.

7 / 9
Cohort Retention

How it was done

Cohort retention for 704 customers (Customer ID) by month of first activity in Order Date: 12 cohorts from 2025-01 to 2025-12; 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; Plan 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; excluded: 6 rows with no customer or an unreadable date; the incomplete final month (2026-01, data ends 2026-01-15): 161 rows; not used: Channel, Order Value (not mapped).

3877 of 4044 rows · Customer ID → Order Date

caveatRetention is activity in a month, so customers inactive now but returning later count as lapsed.

8 / 9
Cohort Retention

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)))
}
Want to run this analysis on your own data? Upload CSV — Free Analysis See Pricing