RFM Segmentation

Scores every customer on recency, frequency and monetary value from a transaction log, groups them into the standard segments from Champions to Hibernating, and shows where the revenue sits and how much of it is with customers who have gone quiet.

VERSION · v1.0.0
RUN DATE · 15 September 2026
DATA · 2,139 rows
Objective

Which of our customers are the most valuable, which are slipping away, and where does our revenue sit?

This report contains
  • SummaryCustomers, orders and revenue, the share of Champions and the revenue at risk.
  • Customers per segmentHow many customers fall in each segment.
  • Revenue per segmentEach segment's share of total revenue.
  • Recency against frequencyHow many customers have each pair of recency and frequency scores.
  • Every customerEach customer's orders against their total value, coloured by segment.
  • Every segmentEach segment's pattern, size, recency, orders, value and revenue share.
  • Most valuable customersThe customers with the highest total value, with their segment and recency.
  • What the results rely onEach condition the segments depend on, and whether it holds.
  • How it was doneThe method, the data used, and what to keep in mind.
1 / 7
RFM Segmentation

Where the customers and revenue sit

Hibernating is the largest, ahead of Champions

Champions dominate active segments; Hibernating is largest overall, pulling revenue focus to lapsing customers.

On this card's data, Hibernating is larger than Champions.

Champions dominate revenue despite mixed engagement

Champions hold most revenue while At Risk customers remain substantial, signaling concentration risk.

Champions' share dwarfs all others, but At Risk's share is second and notable.

2 / 7
RFM Segmentation

How customers are scored

Champions strong, at-risk buyers cluster low

Most valuable customers concentrate at high recency and frequency; at-risk frequent buyers are fewer than champions.

Top-right corner shows champions with recent and frequent purchases; R1 and R2 rows show many low-frequency customers.

Value rises sharply with order frequency

Customers who order more have far higher total value. Champions sit clearly ahead; most customers order once with modest value.

The upper right corner shows Champions with high orders and high value; the lower left shows most customers clustered at single orders.

3 / 7
RFM Segmentation

The numbers

Champions and at-risk segments drive revenue

Champions and At Risk segments together hold most revenue, but diverge sharply in recency, requiring different retention strategies.

Can't Lose Them has nearly double the value per customer of Champions yet generates far less revenue, revealing a concentration risk in a very small group.

4 / 7
RFM Segmentation

The numbers (2)

Champions dominate value, two customers quiet

Most valuable customers are Champions, but C0226 and C0540 have gone quiet despite high value.

C0226 and C0540 break the Champions pattern with extreme recency gaps, marking them as quiet despite their high cumulative value.

5 / 7
RFM Segmentation

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 customers, repeat buyers present, long enough history, few refunds, orders complete.

RFM segmentation of 600 customers (Customer ID) from 2132 orders between 2025-01-01 and 2026-06-30; recency is days from the last order to 2026-06-30 (the last order date in the data), frequency is the number of orders and monetary is the total of Order Amount with 1 refund netted; each is scored 1 to 5 by fifths of customers (5 is best; tied customers share a score), and segments follow the standard map from the recency and frequency scores; excluded: 7 orders missing a customer, date or amount; not used: Channel, Order ID (not mapped).

2132 of 2139 rows · Customer ID, Order Date, Order Amount → 600 customers scored

caveatRFM scores rank customers by their past behaviour within this dataset, not absolute value.

6 / 7
RFM Segmentation

The code behind this report

The code that produced every figure in this report, exactly as it ran. Fingerprint cea6d1a6973f338d. The same code on the same data gives the same report.

`standard_rfm_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 %||%
    "Which customers are the most valuable, which are slipping away, and where does the revenue sit?"

  #' ## Column mapping
  #' A transaction log, one row per order: `customer_id` (who bought), `order_date` (when) and `order_value` (how much).
  #' Semantic names inside; the customer's own headers live in `col_map`.
  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)
  }
  id_name <- human("customer_id"); date_name <- human("order_date"); value_name <- human("order_value")
  for (sem in c("customer_id", "order_date", "order_value"))
    if (!(sem %in% names(df))) stop(sprintf("column_mapping must map '%s' (%s was not found).", sem, human(sem)))
  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
  #' `reference_date`: the day recency is measured from; blank uses the last order date in the data, never the clock,
  #' so an old file does not make every customer look lapsed.
  ref_param <- trimws(as.character(params$reference_date %||% ""))
  parse_d <- function(x) {
    if (inherits(x, "Date")) return(x)
    if (inherits(x, "POSIXt")) return(as.Date(x))
    s <- trimws(as.character(x)); s[s == "" | is.na(s)] <- NA
    if (all(is.na(s))) return(as.Date(rep(NA, length(s))))
    as.Date(suppressWarnings(lubridate::parse_date_time(s, orders = c("Ymd", "mdY", "dmY", "Ymd HMS", "Ymd HM", "mdY HMS", "dmY HMS", "mdY HM"), quiet = TRUE)))
  }

  #' ## Data preparation
  #' Orders with no customer, an unreadable date or an unreadable amount are excluded and counted (95% rules on date and
  #' amount). Negative amounts are kept as refunds and net against the customer's value, and counted.
  cid <- trimws(as.character(df$customer_id))
  dts <- parse_d(df$order_date)
  n_date_nonblank <- sum(!is.na(df$order_date) & trimws(as.character(df$order_date)) != "")
  if (n_date_nonblank == 0 || sum(!is.na(dts)) < 0.95 * n_date_nonblank)
    stop(sprintf("%s could not be read as dates for 95%% of its values; expected values like 2025-01-31 or 1/31/2025.", date_name))
  val <- df$order_value
  if (!is.numeric(val)) {
    ch <- gsub("[$,£€ ]", "", trimws(as.character(val)))
    nb <- !is.na(ch) & ch != ""
    conv <- suppressWarnings(as.numeric(ch))
    if (sum(nb) == 0 || sum(!is.na(conv[nb])) < 0.95 * sum(nb))
      stop(sprintf("%s is not numeric: fewer than 95%% of its values read as amounts.", value_name))
    val <- conv
  }
  keep <- !is.na(cid) & cid != "" & !is.na(dts) & !is.na(val)
  n_bad <- sum(!keep)
  cid <- cid[keep]; dts <- dts[keep]; val <- as.numeric(val[keep])
  n_orders <- length(val)
  n_refunds <- sum(val < 0)
  if (n_orders < 30) stop(sprintf("Only %d usable orders; RFM needs at least 30.", n_orders))
  ref_date <- if (nzchar(ref_param)) parse_d(ref_param) else max(dts)
  if (is.na(ref_date)) stop("module_parameters$reference_date could not be read as a date.")
  n_future <- sum(dts > ref_date)
  if (n_future > 0) { f <- dts <= ref_date; cid <- cid[f]; dts <- dts[f]; val <- val[f]; n_orders <- length(val) }

  #' ## Recency, frequency, monetary per customer
  last <- tapply(dts, cid, max); freq <- tapply(val, cid, length); mon <- tapply(val, cid, sum)
  cust <- data.frame(customer = names(freq), recency_days = as.numeric(ref_date - as.Date(last[names(freq)], origin = "1970-01-01")),
                     orders = as.integer(freq), value = as.numeric(mon[names(freq)]), stringsAsFactors = FALSE)
  n_cust <- nrow(cust)
  if (n_cust < 20) stop(sprintf("Only %d customers; RFM scores need at least 20 to split into fifths.", n_cust))

  #' ## Scores 1 to 5 (5 is best): quintile breaks, falling back to average ranks when ties collapse the breaks, so tied
  #' customers always share a score (most customers ordering once must not be split across scores at random)
  score5 <- function(x, higher_is_better = TRUE) {
    n <- length(x); ux <- unique(x)
    if (length(ux) <= 1) return(rep(3L, n))
    #' orient first, so a larger value is always better (recency: fewer days)
    v <- if (higher_is_better) x else -x
    sc <- NULL
    if (length(ux) >= 5) {
      #' Breaks at exact positions in the sorted values: quantile(probs = seq(0, 1, 0.2)) carries 0.6000000000000001
      #' and lands the third break one customer late (LAT-3196).
      sv <- sort(v); br <- sv[c(1L, as.integer(n * (1:5) / 5))]
      if (length(unique(br)) == 6) sc <- as.integer(cut(v, breaks = br, include.lowest = TRUE, labels = FALSE))
    }
    #' When ties collapse the breaks, tied customers take the LOWEST rank of their tie (LAT-3196): average ranks put the
    #' 51% who ordered once on F2, so no customer scored F1 and New Customers could never appear.
    if (is.null(sc)) sc <- as.integer(ceiling(rank(v, ties.method = "min") * 5 / n))
    pmin(pmax(sc, 1L), 5L)
  }
  cust$r <- score5(cust$recency_days, higher_is_better = FALSE)
  cust$f <- score5(cust$orders)
  cust$m <- score5(cust$value)
  seg_of <- function(R, F_) {
    s <- rep("Need Attention", length(R))
    s[R <= 2 & F_ <= 2] <- "Hibernating"
    s[R <= 2 & F_ >= 3] <- "At Risk"
    s[R == 1 & F_ >= 4] <- "Can't Lose Them"
    s[R >= 4 & F_ == 1] <- "New Customers"
    s[R >= 4 & F_ %in% 2:3] <- "Potential Loyalist"
    s[R >= 3 & F_ >= 4] <- "Loyal"
    s[R >= 4 & F_ >= 4] <- "Champions"
    s
  }
  cust$segment <- seg_of(cust$r, cust$f)
  SEG <- c("Champions", "Loyal", "Potential Loyalist", "New Customers", "Need Attention", "At Risk", "Can't Lose Them", "Hibernating")
  present <- SEG[SEG %in% cust$segment]
  total_value <- sum(cust$value)

  #' ## The frames for the places
  seg_n <- as.integer(table(factor(cust$segment, levels = present)))
  seg_v <- as.numeric(tapply(cust$value, factor(cust$segment, levels = present), sum))
  #' each bar carries its group, so a sentence about active or lapsing customers can be checked against the sums (LAT-3196)
  grp_of <- function(sg) ifelse(sg %in% c("Champions", "Loyal", "Potential Loyalist", "New Customers"), "active",
                                ifelse(sg %in% c("At Risk", "Can't Lose Them", "Hibernating"), "lapsing", "neither"))
  sizes_df <- data.frame(segment = present, group = grp_of(present), customers = seg_n, stringsAsFactors = FALSE)
  revenue_df <- data.frame(segment = present, group = grp_of(present), revenue_share_pct = round(100 * seg_v / total_value, 1), stringsAsFactors = FALSE)
  grid <- expand.grid(frequency_score = 1:5, recency_score = 1:5)
  grid$customers <- mapply(function(fs, rs) sum(cust$f == fs & cust$r == rs), grid$frequency_score, grid$recency_score)
  grid_df <- data.frame(recency_score = paste0("R", grid$recency_score), frequency_score = paste0("F", grid$frequency_score),
                        customers = as.integer(grid$customers), stringsAsFactors = FALSE)
  set.seed(42)
  idx <- if (n_cust > 1500) sort(sample(n_cust, 1500)) else seq_len(n_cust)
  map_df <- data.frame(orders = cust$orders[idx], value = tidy(cust$value[idx]), segment = cust$segment[idx], stringsAsFactors = FALSE)
  describe <- c("Champions" = "recent and frequent", "Loyal" = "frequent, reasonably recent", "Potential Loyalist" = "recent, a few orders",
                "New Customers" = "recent, one order so far", "Need Attention" = "middling recency and frequency", "At Risk" = "frequent before, not recent",
                "Can't Lose Them" = "most frequent before, least recent", "Hibernating" = "neither recent nor frequent")
  prof_df <- do.call(rbind, lapply(present, function(s) { x <- cust[cust$segment == s, ]
    data.frame(segment = s, pattern = describe[[s]], customers = nrow(x), share_pct = round(100 * nrow(x) / n_cust, 1),
               median_days_since = tidy(stats::median(x$recency_days)), median_orders = tidy(stats::median(x$orders)),
               value_per_customer = tidy(mean(x$value)), revenue_share_pct = round(100 * sum(x$value) / total_value, 1), stringsAsFactors = FALSE) }))
  o <- order(-cust$value)[seq_len(min(15, n_cust))]
  top_df <- data.frame(customer = cust$customer[o], segment = cust$segment[o], orders = cust$orders[o], value = tidy(cust$value[o]),
                       days_since_last_order = as.integer(cust$recency_days[o]), stringsAsFactors = FALSE)
  at_risk_share <- 100 * sum(cust$value[cust$segment %in% c("At Risk", "Can't Lose Them")]) / total_value

  #' ## Assumption checks (LAT-3138)
  repeat_share <- mean(cust$orders > 1)
  span_days <- as.numeric(max(dts) - min(dts))
  bad_share <- n_bad / n_in
  checks_df <- data.frame(
    check = c("Enough customers", "Repeat buyers present", "Long enough history", "Few refunds", "Orders complete"),
    statistic = c(sprintf("%d customers", n_cust), sprintf("%s%% of customers ordered more than once", format(round(100 * repeat_share, 1))),
                  sprintf("%d days of orders", as.integer(span_days)), sprintf("%d of %d orders negative", n_refunds, n_orders),
                  sprintf("%d of %d rows excluded", n_bad, n_in)),
    p_value = "",
    verdict = c(if (n_cust >= 200) "holds" else if (n_cust >= 50) "strained" else "violated",
                if (repeat_share >= 0.2) "holds" else if (repeat_share >= 0.05) "strained" else "violated",
                if (span_days >= 180) "holds" else if (span_days >= 60) "strained" else "violated",
                if (n_refunds / n_orders <= 0.05) "holds" else if (n_refunds / n_orders <= 0.15) "strained" else "violated",
                if (bad_share <= 0.05) "holds" else if (bad_share <= 0.15) "strained" else "violated"),
    note = c("few customers make fifths coarse, so one customer moves a score",
             "when almost everyone ordered once, frequency cannot separate customers and the segments rest on recency alone",
             "a short history makes recency and frequency measure the calendar more than the customer",
             "refunds net against value, so many of them blur the monetary score",
             "orders missing a customer, date or amount are left out"),
    stringsAsFactors = FALSE)

  #' ## Method, assumptions, answer
  excluded <- c(if (n_bad > 0) sprintf("%d order%s missing a customer, date or amount", n_bad, if (n_bad > 1) "s" else ""),
                if (n_future > 0) sprintf("%d order%s after the reference date", n_future, if (n_future > 1) "s" else ""))
  method <- paste0(
    "RFM segmentation of ", n_cust, " customers (", id_name, ") from ", n_orders, " orders between ", format(min(dts)), " and ", format(max(dts)),
    "; recency is days from the last order to ", format(ref_date), if (nzchar(ref_param)) " (the reference date requested)" else " (the last order date in the data)",
    ", frequency is the number of orders and monetary is the total of ", value_name, " with ", n_refunds, " refund", if (n_refunds == 1) "" else "s", " netted",
    "; each is scored 1 to 5 by fifths of customers (5 is best; tied customers share a score), and segments follow the standard map from the recency and frequency scores",
    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(
    "Each customer ID is one customer across the whole log; merged or reissued IDs split or combine customers.",
    "Scores are relative to these customers: a 5 means the best fifth here, not good in absolute terms.",
    "Segments describe past behaviour; they do not predict who will buy next.",
    "Recency counts days to the reference date; moving the date adds the same days to every customer, so scores change only when orders fall on the other side of it.",
    "Monetary value is revenue, not margin.")
  answer <- list(customers = n_cust, orders = n_orders, reference_date = format(ref_date), segments = setNames(as.list(seg_n), present),
                 at_risk_revenue_pct = round(at_risk_share, 1), n = n_orders)

  results <- list()
  #' The verdict and the headline are NOT places of a library tool (LAT-3130): the last mile writes them.
  results$summary_metrics <- place_metric(list(customers = n_cust, orders = n_orders, revenue = tidy(total_value),
    champions_pct = round(100 * mean(cust$segment == "Champions"), 1), at_risk_revenue_pct = round(at_risk_share, 1),
    one_order_pct = round(100 * mean(cust$orders == 1), 1)), lead = "customers", place = "summary_metrics")
  results$segment_sizes <- place_comparison(sizes_df, category = "segment", value = "customers", place = "segment_sizes")
  results$segment_revenue <- place_comparison(revenue_df, category = "segment", value = "revenue_share_pct", place = "segment_revenue")
  results$rf_grid <- place_matrix(grid_df, x = "frequency_score", y = "recency_score", z = "customers", place = "rf_grid")
  results$customer_map <- place_relationship(map_df, x = "orders", y = "value", series = "segment", place = "customer_map")
  results$segment_profile <- place_table(prof_df, place = "segment_profile")
  results$top_customers <- place_table(top_df, place = "top_customers")
  results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
  results$rfm_method <- list(kind = "metric", values = list(
    method = method, n_in = n_in, n_used = n_orders, excluded = as.list(excluded), assumptions = assumptions,
    x_column = paste(id_name, date_name, value_name, sep = ", "), y_column = sprintf("%d customers scored", n_cust)),
    value_order = list("n_used", "n_in"))

  objects <- list()   # filled by the object layer, not here
  list(answer = answer, method = method, n = n_orders, results = results, objects = objects,
       json_output = list(answer = answer, method = method, n = n_orders))
}
Want to run this analysis on your own data? Upload CSV — Free Analysis See Pricing