customer_segmentation

RFM in R

Jiaxiang Li 2019-02-21

RFM 和 cohort 分析联系不大，但是都是分析用户很重要的两个分析方法。

一般地，RFM 模型有几种迭代。

1. 每一个指标 (R, F, M) 都标准化后，平均打分。
2. 跑模型加一下权重，例如 PCA
3. 将每个指标的具体变量一起建立一个复杂模型，不损失信息

但是一开始就建立最后一种迭代，会让读者难以接受模型，因为过于复杂。 因此最好的方式是按顺序迭代，并且参考下文，给出比较好的展示方式。

library(data.table)
suppressMessages(library(tidyverse))
online <- fread("data/chapter_2/online12M.csv",drop = 1)

注意这里的数据只使用最近12个月的数据，这也是一种 sense。

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:data.table':
## 
##     hour, isoweek, mday, minute, month, quarter, second, wday,
##     week, yday, year

## The following object is masked from 'package:base':
## 
##     date

rfm_level_func <- function(x){
    if (x >= 10) {
        'top'
    } else if (x >= 6) {
        'middle'
    } else {
        'low'
    }
}

online_rfm <- 
online %>% 
    group_by(CustomerID) %>% 
    summarise(
        recency = as.Date('2011-12-10 ') - max(as.Date(InvoiceDate))
        ,frequency = n_distinct(InvoiceNo)
        ,monetary_value = sum(UnitPrice * Quantity)
    ) %>% 
    mutate(
        r = ntile(recency,4)
        ,f = ntile(frequency,4)
        ,m = ntile(monetary_value,4)
    ) %>% 
    mutate(
        rfm_score = r + f + m
    ) %>% 
    mutate(
        rfm_level = case_when(
            rfm_score >= 10 ~ 'top'
            ,(rfm_score >= 6 & rfm_score <10) ~ 'middle'
            ,TRUE ~ 'low'
        )
    ) %>% 
    mutate(rfm_level2 = map_chr(rfm_score,rfm_level_func))
online_rfm %>% head

## # A tibble: 6 x 10
##   CustomerID recency frequency monetary_value     r     f     m rfm_score
##        <int> <time>      <int>          <dbl> <int> <int> <int>     <int>
## 1      12747 "  3 d…        10           949.     1     4     4         9
## 2      12748 "  1 d…       143          7046.     1     4     4         9
## 3      12749 "  4 d…         4           813.     1     3     4         8
## 4      12820 "  4 d…         4           268.     1     3     3         7
## 5      12822 " 71 d…         2           146.     3     2     3         8
## 6      12823 297 da…         1           306      4     1     3         8
## # ... with 2 more variables: rfm_level <chr>, rfm_level2 <chr>

online_rfm %>% 
    summarise(
        sum(rfm_level != rfm_level2)
    )

## # A tibble: 1 x 1
##   `sum(rfm_level != rfm_level2)`
##                            <int>
## 1                              0

注意这里的 if else 表达不支持向量化，需要自己使用 map 函数构建， 参考jiaxiangbu。

online_rfm %>% 
    group_by(rfm_level) %>% 
    summarise(
        r = mean(recency)
        ,f = mean(frequency)
        ,m = mean(monetary_value)
        ,m_sum = sum(monetary_value)
    )

## # A tibble: 3 x 5
##   rfm_level r                    f     m   m_sum
##   <chr>     <time>           <dbl> <dbl>   <dbl>
## 1 low       " 39.32475 days"  1.17  47.3  23887.
## 2 middle    100.99887 days    3.72 373.  994632.
## 3 top       " 85.52110 days"  5.89 700.  331921.

这样就完成了迭代的第一顺序，并且可以发现，

1. r
2. f
3. m

都符合尝试，Top 级别都比较高 (r 越低越好)。