###################################################
# Chapter 7: RFM Analysis                         #
# Chestnut Ridge Multi-channel Retailer Example   #
###################################################

# This script reproduces the full Chestnut Ridge RFM analysis example in R:
#   Step 1. Data setup and RFM scores (independent and sequential sort)
#   Step 2. RFM analysis exercise (breakeven rate and purchase rate of each RFM cell)
#   Step 3. Profitability and ROMI (RFM cell tables and targeting results in Table 7.4)
# Run it from top to bottom. Each step prints its result to the console or Plots pane.

###################################################
# Step 1: Data Setup                              #
###################################################

## Install Packages (if needed - only installs packages that are missing)
packages <- c("dplyr", "ggplot2", "scales")
new_packages <- packages[!(packages %in% installed.packages()[, "Package"])]
if (length(new_packages) > 0) install.packages(new_packages)

## Load Packages and Set Seed
library(dplyr)
library(ggplot2)
library(scales)
set.seed(1)

## Read in RFM data
rfm <- read.csv(file.choose()) ## Choose retail_rfm.csv file

## Look at the data (see Table 7.3 for variable definitions)
head(rfm)
summary(rfm)

## How many levels for each
groups <- 5 ## This will use quintiles to sort and give 125 total groups

## Run RFM Analysis with Independent Sort
## Each of R, F, and M is sorted on its own. Recency is multiplied by -1 so that
## the most recent purchasers (fewest days) get the highest score.
rfm <- rfm %>%
  mutate(recency_score_indep   = ntile(recency_days * -1, groups),
         frequency_score_indep = ntile(number_of_orders, groups),
         monetary_score_indep  = ntile(revenue, groups),
         rfm_score_indep       = recency_score_indep * 100 + frequency_score_indep * 10 + monetary_score_indep)

## Run RFM Analysis with Sequential Sort
## First sort on R; then sort on F within each R group; then sort on M within each R-F group.
rfm <- rfm %>%
  mutate(recency_score_seq = ntile(recency_days * -1, groups)) %>%
  group_by(recency_score_seq) %>%
  mutate(frequency_score_seq = ntile(number_of_orders, groups)) %>%
  group_by(recency_score_seq, frequency_score_seq) %>%
  mutate(monetary_score_seq = ntile(revenue, groups)) %>%
  ungroup() %>%
  mutate(rfm_score_seq = recency_score_seq * 100 + frequency_score_seq * 10 + monetary_score_seq)

## Look at the RFM results for the first few customers
head(rfm)


###################################################
# Step 2: RFM Analysis Exercise                   #
###################################################

## Campaign economics
avg_purchase  <- 40.00   ## Average purchase amount from the campaign
avg_cogs      <- 19.20   ## Average cost of goods sold (48% of purchase)
avg_shipping  <- 6.00    ## Average cost to ship the product
cost_per_mail <- 2.00    ## Average cost of the marketing campaign (catalog) per customer

## Breakeven rate
profit_per_buyer <- avg_purchase - avg_cogs - avg_shipping - cost_per_mail
breakeven <- cost_per_mail / profit_per_buyer
profit_per_buyer ## $12.80
breakeven        ## 0.1563 (15.63%)

## Summarize each RFM cell: number of customers, number of purchasers, and purchase rate
cells_indep <- rfm %>%
  group_by(rfm_score = rfm_score_indep, recency = recency_score_indep,
           frequency = frequency_score_indep, monetary = monetary_score_indep) %>%
  summarise(customers = n(), purchasers = sum(purchase), purchase_rate = mean(purchase),
            .groups = "drop") %>%
  mutate(target = purchase_rate > breakeven)

cells_seq <- rfm %>%
  group_by(rfm_score = rfm_score_seq, recency = recency_score_seq,
           frequency = frequency_score_seq, monetary = monetary_score_seq) %>%
  summarise(customers = n(), purchasers = sum(purchase), purchase_rate = mean(purchase),
            .groups = "drop") %>%
  mutate(target = purchase_rate > breakeven)

## Function to plot the purchase rate of each RFM cell (Figures 7.2 and 7.3)
plot_rfm_bars <- function(cells, title) {
  ggplot(cells, aes(x = factor(rfm_score), y = purchase_rate)) +
    geom_col(fill = "grey35") +
    geom_hline(yintercept = breakeven, linetype = "dashed") +
    scale_y_continuous(labels = percent) +
    labs(title = title, x = "RFM Cell", y = "Percentage of Purchasers") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5, size = 6),
          panel.grid.major.x = element_blank())
}

## Figure 7.2: Purchasers Using RFM with Independent Sort
plot_rfm_bars(cells_indep, "RFM Score with Independent Sort")

## Figure 7.3: Purchasers Using RFM with Sequential Sort
plot_rfm_bars(cells_seq, "RFM Score with Sequential Sort")

## Cells with the highest purchase rates
cells_indep %>% arrange(desc(purchase_rate)) %>% head(5)  ## e.g., cell 535 has a 60% purchase rate
cells_seq %>% arrange(desc(purchase_rate)) %>% head(5)    ## e.g., cells 555 and 554 have 72.5% and 66.25%

## Number of RFM cells above the breakeven rate
sum(cells_indep$target) ## 37 of 125 cells
sum(cells_seq$target)   ## 56 of 125 cells


###################################################
# Step 3: Computing Profitability and ROMI        #
###################################################

## Function to create an RFM cell table (Figures 7.4 to 7.9)
## Rows are Recency and Frequency, columns are Monetary. Cells above the
## breakeven rate are shaded dark. The value shown in each cell can be the
## purchase rate, the number of purchasers, or the number of customers.
plot_rfm_table <- function(cells, value, title) {
  cells$label <- if (value == "purchase_rate") sprintf("%.4f", cells$purchase_rate) else cells[[value]]
  ggplot(cells, aes(x = factor(monetary), y = factor(frequency, levels = groups:1))) +
    geom_tile(aes(fill = target), color = "white") +
    geom_text(aes(label = label, color = target), size = 3) +
    facet_grid(recency ~ ., switch = "y") +
    scale_x_discrete(position = "top") +
    scale_fill_manual(values = c(`FALSE` = "grey90", `TRUE` = "#2C5F8A"),
                      labels = c(`FALSE` = "Below breakeven", `TRUE` = "Above breakeven"), name = NULL) +
    scale_color_manual(values = c(`FALSE` = "black", `TRUE` = "white"), guide = "none") +
    labs(title = title, x = "Monetary Score", y = "Recency Score / Frequency Score") +
    theme_minimal() +
    theme(panel.grid = element_blank(), strip.placement = "outside",
          strip.text.y.left = element_text(angle = 0, face = "bold"),
          legend.position = "bottom")
}

## Independent Sort
## Figure 7.4: Purchaser Percentage Table Using RFM with Independent Sort
plot_rfm_table(cells_indep, "purchase_rate", "Percentage of Purchasers in Each Cell Using Independent Sort")

## Figure 7.5: Purchaser Count Table Using RFM with Independent Sort
plot_rfm_table(cells_indep, "purchasers", "Count of Purchasers in Each Cell Using Independent Sort")

## Figure 7.6: Customer Count Table Using RFM with Independent Sort
plot_rfm_table(cells_indep, "customers", "Count of Customers in Each Cell Using Independent Sort")

## Number of purchasers and customers in the cells above the breakeven rate
sum(cells_indep$purchasers[cells_indep$target]) ## 1,314 purchasers
sum(cells_indep$customers[cells_indep$target])  ## 4,459 customers

## Sequential Sort
## Figure 7.7: Purchaser Percentage Table Using RFM with Sequential Sort
plot_rfm_table(cells_seq, "purchase_rate", "Percentage of Purchasers in Each Cell Using Sequential Sort")

## Figure 7.8: Purchaser Count Table Using RFM with Sequential Sort
plot_rfm_table(cells_seq, "purchasers", "Count of Purchasers in Each Cell Using Sequential Sort")

## Figure 7.9: Customer Count Table Using RFM with Sequential Sort
plot_rfm_table(cells_seq, "customers", "Count of Customers in Each Cell Using Sequential Sort")

## Number of purchasers and customers in the cells above the breakeven rate
sum(cells_seq$purchasers[cells_seq$target]) ## 1,306 purchasers
sum(cells_seq$customers[cells_seq$target])  ## 4,480 customers

## Function to compute profitability and ROMI for a targeting strategy
campaign_results <- function(targeted, buyers) {
  revenue   <- buyers * avg_purchase
  cogs      <- buyers * avg_cogs
  shipping  <- buyers * avg_shipping
  marketing <- targeted * cost_per_mail
  profit    <- revenue - cogs - shipping - marketing
  c(customers = nrow(rfm), targeted = targeted, pct_targeted = targeted / nrow(rfm),
    buyers = buyers, response_rate = buyers / targeted, revenue = revenue, cogs = cogs,
    shipping = shipping, marketing = marketing, profit = profit, romi = profit / marketing)
}

## Table 7.4: RFM Analysis Results
results <- cbind(
  "Random Targeting"               = campaign_results(nrow(rfm), sum(rfm$purchase)),
  "Targeted: Independent Sort RFM" = campaign_results(sum(cells_indep$customers[cells_indep$target]),
                                                      sum(cells_indep$purchasers[cells_indep$target])),
  "Targeted: Sequential Sort RFM"  = campaign_results(sum(cells_seq$customers[cells_seq$target]),
                                                      sum(cells_seq$purchasers[cells_seq$target])))

## Format the table for easier reading
results_table <- rbind(
  "Number of Customers"     = comma(results["customers", ]),
  "Number Targeted"         = comma(results["targeted", ]),
  "% of Customers Targeted" = percent(results["pct_targeted", ], accuracy = 0.01),
  "Number of Buyers"        = comma(results["buyers", ]),
  "Response Rate"           = percent(results["response_rate", ], accuracy = 0.01),
  "Revenues"                = dollar(results["revenue", ], accuracy = 0.01),
  "Cost of Goods Sold"      = dollar(results["cogs", ], accuracy = 0.01),
  "Shipping"                = dollar(results["shipping", ], accuracy = 0.01),
  "Targeted Marketing"      = dollar(results["marketing", ], accuracy = 0.01),
  "Profit"                  = dollar(results["profit", ], accuracy = 0.01),
  "ROMI"                    = percent(results["romi", ], accuracy = 0.01))
colnames(results_table) <- colnames(results)
noquote(results_table)