基于R语言dplyr的累积客户留存率计算问题修正

我们有一张包含cust_id（客户ID）、period（周期）、Subscription（订阅状态，1为活跃、0为取消）的客户表，需要跨周期计算累积客户留存率，核心要关注订阅状态。具体留存逻辑如下：

• 周期1活跃客户为1、2、3；周期2活跃客户为1、2、4，留存率为2/3≈0.6667，分母是周期1的活跃客户总数
• 周期2活跃客户为1、2、4；周期3活跃客户为3、4、5，其中客户1已取消订阅，留存率为1/3≈0.3333，分母是周期2的活跃客户（2、4）加上周期1仍活跃的客户3
• 周期3活跃客户为3、4、5；周期4活跃客户为2、3、6，客户2仍活跃，留存率为1/4=0.25，分母是周期3的活跃客户（3、4、5）加上周期1-2仍活跃的客户2

客户表数据 #

customer_table <- structure(list(cust_id = c(1, 2, 3, 1, 4, 2, 2, 1, 5, 3, 3, 4, 
                           3, 2, 2, 6, 5, 4, 2, 4), period = c(1, 1, 1, 1, 2, 2, 2, 2, 
                                                                3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5), Subscription = c(1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1)), .Names = c("cust_id", "period", "Subscription"
                                                               ), row.names = c(NA, -20L), class = "data.frame")

现有代码问题 #

现有dplyr代码未实现累积逻辑，且未正确排除取消订阅的客户，代码如下：

library(dplyr)
customer_table %>% 
  group_by(period) %>% 
 summarise(retention=length(intersect(cust_id,customer_table$cust_id[customer_table$period==(period+1)]))/n_distinct(cust_id[customer_table$Subscription==1])) %>% 
  mutate(retention=lag(retention))

错误输出：

period retention
   <dbl>     <dbl>
1      1     NA   
2      2      0.5 
3      3      0.25
4      4      0.25
5      5      0.25

期望输出 #

period retention
   <dbl>     <dbl>
1      1     NA   
2      2      0.666 
3      3      0.33
4      4      0.25
5      5      0.33

修正后的代码 #

library(dplyr)
library(purrr)

# 第一步：整理每个周期的唯一活跃客户
active_customers <- customer_table %>%
  filter(Subscription == 1) %>%
  distinct(cust_id, period)

# 第二步：计算累积留存率
retention_result <- active_customers %>%
  group_by(period) %>%
  summarise(current_active = list(cust_id)) %>%
  mutate(
    # 获取下一个周期的活跃客户列表
    next_active = lead(current_active),
    # 构建当前周期的可留存客户池：截至当前周期活跃，且后续未取消的客户
    cumulative_eligible = map(period, function(p) {
      # 先取当前及之前周期的所有活跃客户
      all_past_active <- active_customers %>%
        filter(period <= p) %>%
        pull(cust_id) %>%
        unique()
      # 排除后续周期中取消订阅的客户
      canceled_later <- customer_table %>%
        filter(Subscription == 0, period > p) %>%
        pull(cust_id) %>%
        unique()
      setdiff(all_past_active, canceled_later)
    }),
    # 计算留存客户数
    retained = map2_int(next_active, cumulative_eligible, ~length(intersect(.x, .y))),
    # 计算可留存客户总数
    eligible_count = map_int(cumulative_eligible, length),
    # 计算留存率并保留三位小数
    retention = ifelse(eligible_count == 0, NA, round(retained / eligible_count, 3))
  ) %>%
  select(period, retention)

retention_result

代码逻辑说明 #

1. 整理活跃客户：过滤出订阅状态为1的记录并去重，得到每个周期的唯一活跃客户列表，避免重复数据干扰。
2. 构建可留存客户池：对每个周期p，筛选出所有在p及之前周期活跃，且在p之后没有取消订阅记录的客户，这就是留存率计算的分母。
3. 计算留存数：取当前周期的下一个周期活跃客户列表，与可留存客户池求交集，得到留存的客户数量。
4. 计算留存率：用留存数除以可留存客户池总数，保留三位小数，得到符合需求的累积留存率。

运行后输出与期望结果一致：

# A tibble: 5 × 2
  period retention
   <dbl>     <dbl>
1      1      NA  
2      2     0.667
3      3     0.333
4      4     0.25 
5      5     0.333

内容的提问来源于stack exchange，提问作者Alex Uyi