R语言数据分析笔记——Cohort 存留分析

杜雨，EasyCharts团队成员，R语言中文社区专栏作者

兴趣方向为：Excel商务图表，R语言数据可视化，地理信息数据可视化。

个人公众号：数据小魔方（微信ID：datamofang） ，“数据小魔方”创始人。 

推荐课程：体系全面，最具调性！R语言可视化&商务图表实战课程

---

相信经常做数据分析的同学都听说过Cohort 分析，特别是互联网运营中，用于分析客户存留等场景，以往这种分析大都借助SQL+Excel完成。

最近在尝试学习 Cohort 用户存留分析时，找到了国外一个数据分析爱好者Cohort 存留分析的Python版本完整代码，并且很良心到的提供了练习数据，作为一个R比Python要熟练的菜鸟分析师，自然是首先想到如何把这个代码翻译成R版本。

http://www.gregreda.com/2015/08/23/cohort-analysis-with-python/

终于功夫不顾有心人，忙活了一天用R语言代码还原了这个Cohort分析的R语言版本，这里分享给大家，代码不佳之处，敬请见谅，只是一个demo，还没有做封装。

1、数据导入：

library('xlsx')

library('ggplot2')

library('dplyr')

library('magrittr')

library('tidyr')

library('reshape2')

​

​

2、数据清洗：

存留分析使用到的字段只有购买日期、用户ID等信息，分析月度存留，需要将日期规范化成年月形式，同时按照客户id分组，计算出用户首次购买的日期，代码如下：

setwd("D:/R/File/")df <- read.xlsx('relay-foods.xlsx', sheetName = 'Purchase Data')

2.1 创建购买月份字段

df$OrderPeriod = format(df$OrderDate,'%Y-%m') #购买日期

2.2 创建用户首次购买字段

CohortGroup = df %>% group_by(UserId) %>%

summarize( CohortGroup = min(OrderDate))

#计算用户首购日期

CohortGroup$CohortGroup <- CohortGroup$CohortGroup %>% format('%Y-%m') df <- df %>% left_join(CohortGroup,by = 'UserId')

#将首购日期与原始订单表合并对齐

2.3 分组（按照首购日期、购买日期）计算总用户数、总订单数、总支付金额（用户ID要去重）

chorts <- df %>% group_by(CohortGroup,OrderPeriod) %>%

summarize(

UserId = n_distinct(UserId),

OrderId = n_distinct(OrderId),

TotalCharges = sum(TotalCharges)

) %>% rename(TotalUsers= UserId , TotalOrders = OrderId)

2.4 按照用户ID分组并根据购买日期月份添加顺序标签

chorts <- chorts %>%

arrange(CohortGroup,OrderPeriod) %>%

group_by(CohortGroup) %>%

mutate( CohortPeriod =row_number())

3、计算当月购买新用户数

cohort_group_size <- chorts %>%

filter(CohortPeriod == 1) %>%

select(CohortGroup,OrderPeriod,TotalUsers)user_retention <- chorts %>%

select(CohortGroup,CohortPeriod,TotalUsers) %>%

spread(CohortGroup,TotalUsers) #长表转换为宽表#将具体用户数换算为占基准月份比率

user_retention[,-1] <- user_retention[,-1] %>% t() %>% `/`(cohort_group_size$TotalUsers) %>% t() %>% as.data.frame()

宽表转为长表

user_retention1 <- user_retention %>% select(1:5) %>%

melt(

id.vars = 'CohortPeriod',

variable.name = 'CohortGroup',

value.name = 'TotalUsers'

)

4、存留曲线

ggplot(user_retention1,aes(CohortPeriod,TotalUsers)) +

geom_line(aes(group = CohortGroup,colour = CohortGroup)) +

scale_x_continuous(breaks = 1:15) +

scale_colour_brewer(type = 'div')

​

​

最终的存留热力图数据源：

user_retentionT <- t(user_retention) %>% .[2:nrow(.),] %>% as.data.frameuser_retentionT$CohortPeriod <- row.names(user_retentionT)row.names(user_retentionT) <- NULLuser_retentionT <- user_retentionT[,c(16,1:15)]user_retentionT1 <- user_retentionT %>%

melt(

id.vars = 'CohortPeriod',

variable.name = 'CohortGroup',

value.name = 'TotalUsers'

)

5、存留分析热力图：

library("Cairo")

library("showtext")

font_add("myfont","msyh.ttc")

CairoPNG("C:/Users/RAINDU/Desktop/emoji1.png",1000,750)

showtext_begin()

ggplot(user_retentionT1 ,aes(CohortGroup,CohortPeriod,fill=TotalUsers))+

geom_tile(colour='white') +

geom_text(aes(label = ifelse(TotalUsers != 0,paste0(round(100*TotalUsers,2),'%'),'')),colour = 'blue') +

scale_fill_gradient2(limits=c(0,.55),

low="#00887D",

mid ='yellow',

high="orange",

midpoint = median(user_retentionT1$TotalUsers, na.rm =TRUE),

na.value = "grey90") +

scale_y_discrete(limits = rev(unique(user_retentionT1$CohortPeriod))) +

scale_x_discrete(position = "top")+

labs(title="XXX产品Chort留存分析",

subtitle="XXX产品在2019年1月至2010年三月中间的留存率趋势")+

theme(

text = element_text(family = 'myfont',size = 15),

rect = element_blank()

)

showtext_end()

dev.off()

​

存留分析是互联网数据分析和运用中经常会用到分析工具，本节的R代码是源于篇首Python代码的思路，大家可以对比两者的优劣，作为今后分析使用的参考资料。

写在最后：

如果你想要深入的去学ggplot2，但是又苦于平时学习、工作太忙木有时间研究浩如烟海的源文档，那也没关系，本小编最近花了不少功夫，把我自己学习ggplot2过程中的一些心得体会、学习经验、仿入坑指南精心整理，现已成功上线了R语言ggplot2可视化的视频课程，由天善智能独家发行，希望这门课程可以给你的R语言数据可视化学习带来更加丰富的体验!

最后八小时，仅此一次的优惠！

点击阅读全文，即刻加入课程！

别让你的对手捷足先登！

​