Chapter 7 Project 5: RFM + K-Means Customer Segmentation

Not all customers are equal. Segmentation allows businesses to tailor strategies to distinct customer groups — from high-value champions to at-risk accounts. In this chapter, we combine classic RFM (Recency, Frequency, Monetary) analysis with K-Means clustering to create data-driven customer segments.

7.1 Business Context

Customer segmentation enables:

  • Targeted marketing: Different messages for champions vs. new customers
  • Resource allocation: Prioritize retention spend on high-value segments
  • Product development: Understand which segments drive feature adoption
  • Churn prevention: Identify at-risk segments before they leave

7.2 RFM Calculation

RFM scores customers on three dimensions: - Recency (R): How recently did they purchase? (lower = better) - Frequency (F): How often do they purchase? (higher = better) - Monetary (M): How much do they spend? (higher = better)

library(tidyverse)
library(DBI)

calculate_rfm <- function(con, analysis_date = Sys.Date()) {
  tbl(con, "orders") %>%
    filter(order_date >= analysis_date - years(2)) %>%
    group_by(customer_id) %>%
    summarise(
      recency = as.numeric(analysis_date - max(order_date, na.rm = TRUE)),
      frequency = n_distinct(order_id),
      monetary = sum(order_total, na.rm = TRUE),
      avg_order_value = mean(order_total, na.rm = TRUE),
      avg_purchase_cycle = as.numeric(mean(diff(sort(order_date)), na.rm = TRUE)),
      category_breadth = n_distinct(product_category),
      discount_dependency = mean(discount_applied > 0, na.rm = TRUE),
      .groups = "drop"
    ) %>%
    collect() %>%
    mutate(
      # Quintile scores (1 = worst, 5 = best)
      r_score = ntile(desc(recency), 5),
      f_score = ntile(frequency, 5),
      m_score = ntile(monetary, 5),

      # Combined RFM score
      rfm_segment = r_score * 100 + f_score * 10 + m_score,

      # Business-friendly labels
      segment_label = case_when(
        r_score >= 4 & f_score >= 4 & m_score >= 4 ~ "Champions",
        r_score >= 3 & f_score >= 3 & m_score >= 4 ~ "Loyal Customers",
        r_score >= 4 & f_score <= 2 ~ "New Customers",
        r_score >= 3 & f_score >= 3 & m_score <= 2 ~ "Potential Loyalists",
        r_score <= 2 & f_score >= 3 ~ "At Risk",
        r_score <= 2 & f_score <= 2 & m_score >= 3 ~ "Cannot Lose Them",
        r_score <= 2 & f_score <= 2 & m_score <= 2 ~ "Lost",
        TRUE ~ "Others"
      )
    )
}

Note: We use ntile() to create quintiles. For recency, we use desc() because lower recency (more recent) is better. For frequency and monetary, higher values are better.

7.3 Advanced Features

Beyond raw RFM, we engineer features that capture behavioral patterns.

build_segmentation_features <- function(rfm_df) {
  rfm_df %>%
    mutate(
      # Predicted 12-month CLV
      clv_12m_predicted = frequency * avg_order_value * 
        (365 / pmax(avg_purchase_cycle, 1)),

      # Behavioral flags
      trending_up = as.integer(monetary > quantile(monetary, 0.6, na.rm = TRUE)),
      bargain_hunter = as.integer(discount_dependency > 0.7),
      category_specialist = as.integer(category_breadth == 1),
      explorer = as.integer(category_breadth > 5)
    ) %>%
    select(-customer_id) %>%
    na.omit()
}

7.4 Finding Optimal K with K-Means

K-Means requires specifying the number of clusters. We use the silhouette method to find the optimal K.

library(cluster)
library(factoextra)
library(caret)

find_optimal_k <- function(data, max_k = 10) {
  fviz_nbclust(
    scale(data),
    kmeans,
    method = "silhouette",
    k.max = max_k
  )
}

The silhouette score measures how similar an object is to its own cluster (cohesion) compared to other clusters (separation). Values range from -1 to 1, where higher is better.

7.5 K-Means Segmentation

segment_customers <- function(features_df, k = 8) {
  # Preprocessing: center and scale
  preproc <- preProcess(features_df, method = c("center", "scale"))
  scaled_data <- predict(preproc, features_df)

  # K-Means with multiple starts to avoid local optima
  set.seed(42)
  km <- kmeans(scaled_data, centers = k, nstart = 25, iter.max = 100)

  # PCA for visualization
  pca <- prcomp(scaled_data, center = TRUE, scale. = TRUE)

  list(
    model = km,
    preprocessing = preproc,
    clusters = km$cluster,
    centers = km$centers,
    pca = pca,
    wss = km$tot.withinss
  )
}

Tip: nstart = 25 runs K-Means 25 times with different random initializations and returns the best result. This dramatically improves cluster quality.

7.6 Cluster Profiling

Understanding what each cluster represents is critical for business actionability.

profile_clusters <- function(rfm_df, clusters) {
  rfm_df %>%
    mutate(cluster = clusters) %>%
    group_by(cluster) %>%
    summarise(
      n = n(),
      pct = n() / nrow(rfm_df),
      avg_recency = mean(recency),
      avg_frequency = mean(frequency),
      avg_monetary = mean(monetary),
      avg_clv = mean(clv_12m_predicted, na.rm = TRUE),
      .groups = "drop"
    ) %>%
    arrange(desc(avg_clv))
}

7.7 Visualization

plot_clusters <- function(segmentation_result, features_df) {
  fviz_cluster(
    segmentation_result$model,
    data = scale(features_df),
    palette = "jco",
    ggtheme = theme_minimal(),
    main = "Customer Segmentation (K-Means)"
  )
}

7.8 Production Deployment

7.8.1 Automated Segmentation Pipeline

# targets pipeline
tar_target(rfm_data, calculate_rfm(con)),
tar_target(features, build_segmentation_features(rfm_data)),
tar_target(segments, segment_customers(features, k = 8)),
tar_target(profiles, profile_clusters(rfm_data, segments$clusters)),
tar_target(segment_export, 
  write_csv(
    rfm_data %>% mutate(cluster = segments$clusters),
    "output/customer_segments.csv"
  )
)

7.8.2 Segment-Based Actions

trigger_segment_actions <- function(customer_segments) {
  customer_segments %>%
    mutate(action = case_when(
      segment_label == "Champions" ~ "VIP_program_invite",
      segment_label == "At Risk" ~ "retention_campaign",
      segment_label == "New Customers" ~ "onboarding_sequence",
      segment_label == "Cannot Lose Them" ~ "executive_outreach",
      TRUE ~ "standard_nurture"
    )) %>%
    group_by(action) %>%
    group_walk(~ send_to_crm(.x, action = .y$action))
}

7.9 Exercises

  1. Implement hierarchical clustering (hclust) and compare results with K-Means.
  2. Use factoextra::fviz_pca_biplot() to understand which features drive each cluster.
  3. Build a Shiny app that allows users to adjust K and see real-time cluster updates.
  4. Implement RFM scoring using deciles (10 groups) instead of quintiles and compare granularity.

Next, we’ll build a real-time fraud detection system that scores transactions in milliseconds.