Несколько месяцев назад я попытался провести некоторый когортный анализ лондонской группы встречи Neo4j, которая была интересным экспериментом, но, к сожалению, привела к тому, что график был совершенно неразборчивым.
Я не был уверен, как продвигаться дальше, но несколько дней назад я наткнулся на когортную тепловую карту, которая казалась лучшим способом визуализации вещей с течением времени.
Основная идея остается той же — мы сравниваем разные группы пользователей друг с другом, чтобы увидеть, повлияло ли изменение или вмешательство, которое мы сделали в определенное время.
Однако то, как мы отображаем когорты, меняется, и я думаю, что к лучшему.
Напомним, что мы начнем со следующего фрейма данных:
df = read.csv("/tmp/df.csv")
> df %>% sample_n(5)
rsvp.time person.id time date
255 1.354277e+12 12228948 2012-11-30 12:05:08 2012-11
2475 1.407342e+12 19057581 2014-08-06 16:26:04 2014-08
3988 1.421769e+12 66122172 2015-01-20 15:58:02 2015-01
4411 1.419377e+12 165750262 2014-12-23 23:27:44 2014-12
1010 1.383057e+12 74602292 2013-10-29 14:24:32 2013-10И нам нужно преобразовать это в фрейм данных, который сгруппирован по группам (участники, которые посетили свою первую встречу в конкретном месяце). Следующий код доставит нас туда:
firstMeetup = df %>%
group_by(person.id) %>%
summarise(firstEvent = min(time), count = n()) %>%
arrange(desc(count))
firstMeetup$date = format(as.Date(firstMeetup$firstEvent), "%Y-%m")
countsForCohort = function(df, firstMeetup, cohort) {
members = (firstMeetup %>% filter(date == cohort))$person.id
attendance = df %>%
filter(person.id %in% members) %>%
count(person.id, date) %>%
ungroup() %>%
count(date)
allCohorts = df %>% select(date) %>% unique
cohortAttendance = merge(allCohorts, attendance, by = "date", all.x = TRUE)
cohortAttendance[is.na(cohortAttendance) & cohortAttendance$date > cohort] = 0
cohortAttendance %>% mutate(cohort = cohort, retention = n / length(members), members = n)
}
cohorts = collect(df %>% select(date) %>% unique())[,1]
cohortAttendance = data.frame()
for(cohort in cohorts) {
cohortAttendance = rbind(cohortAttendance,countsForCohort(df, firstMeetup, cohort))
}
monthNumber = function(cohort, date) {
cohortAsDate = as.yearmon(cohort)
dateAsDate = as.yearmon(date)
if(cohortAsDate > dateAsDate) {
"NA"
} else {
paste(round((dateAsDate - cohortAsDate) * 12), sep="")
}
}
cohortAttendanceWithMonthNumber = cohortAttendance %>%
group_by(row_number()) %>%
mutate(monthNumber = monthNumber(cohort, date)) %>%
filter(monthNumber != "NA") %>%
filter(!is.na(members)) %>%
mutate(monthNumber = as.numeric(monthNumber)) %>%
arrange(monthNumber)
> cohortAttendanceWithMonthNumber %>% head(10)
Source: local data frame [10 x 7]
Groups: row_number()
date n cohort retention members row_number() monthNumber
1 2011-06 4 2011-06 1.00 4 1 0
2 2011-07 1 2011-06 0.25 1 2 1
3 2011-08 1 2011-06 0.25 1 3 2
4 2011-09 2 2011-06 0.50 2 4 3
5 2011-10 1 2011-06 0.25 1 5 4
6 2011-11 1 2011-06 0.25 1 6 5
7 2012-01 1 2011-06 0.25 1 7 7
8 2012-04 2 2011-06 0.50 2 8 10
9 2012-05 1 2011-06 0.25 1 9 11
10 2012-06 1 2011-06 0.25 1 10 12Теперь давайте создадим нашу первую карту тепла.
t <- max(cohortAttendanceWithMonthNumber$members)
cols <- c("#e7f0fa", "#c9e2f6", "#95cbee", "#0099dc", "#4ab04a", "#ffd73e", "#eec73a", "#e29421", "#e29421", "#f05336", "#ce472e")
ggplot(cohortAttendanceWithMonthNumber, aes(y=cohort, x=date, fill=members)) +
theme_minimal() +
geom_tile(colour="white", linewidth=2, width=.9, height=.9) +
scale_fill_gradientn(colours=cols, limits=c(0, t),
breaks=seq(0, t, by=t/4),
labels=c("0", round(t/4*1, 1), round(t/4*2, 1), round(t/4*3, 1), round(t/4*4, 1)),
guide=guide_colourbar(ticks=T, nbin=50, barheight=.5, label=T, barwidth=10)) +
theme(legend.position='bottom',
legend.direction="horizontal",
plot.title = element_text(size=20, face="bold", vjust=2),
axis.text.x=element_text(size=8, angle=90, hjust=.5, vjust=.5, face="plain")) +
ggtitle("Cohort Activity Heatmap (number of members who attended event)")
‘t’ — максимальное количество участников в когорте, которые посетили собрание в данном месяце. Это позволяет легко увидеть, какие группы начали с большинства участников, но затрудняет сравнение их удержания с течением времени.
Мы можем исправить это, указав процент участников в группе, которые посещают каждый месяц, а не используя абсолютные значения. Для этого мы должны сначала добавить дополнительный столбец, содержащий значения в процентах:
cohortAttendanceWithMonthNumber$retentionPercentage = ifelse(!is.na(cohortAttendanceWithMonthNumber$retention), cohortAttendanceWithMonthNumber$retention * 100, 0)
t <- max(cohortAttendanceWithMonthNumber$retentionPercentage)
cols <- c("#e7f0fa", "#c9e2f6", "#95cbee", "#0099dc", "#4ab04a", "#ffd73e", "#eec73a", "#e29421", "#e29421", "#f05336", "#ce472e")
ggplot(cohortAttendanceWithMonthNumber, aes(y=cohort, x=date, fill=retentionPercentage)) +
theme_minimal() +
geom_tile(colour="white", linewidth=2, width=.9, height=.9) +
scale_fill_gradientn(colours=cols, limits=c(0, t),
breaks=seq(0, t, by=t/4),
labels=c("0", round(t/4*1, 1), round(t/4*2, 1), round(t/4*3, 1), round(t/4*4, 1)),
guide=guide_colourbar(ticks=T, nbin=50, barheight=.5, label=T, barwidth=10)) +
theme(legend.position='bottom',
legend.direction="horizontal",
plot.title = element_text(size=20, face="bold", vjust=2),
axis.text.x=element_text(size=8, angle=90, hjust=.5, vjust=.5, face="plain")) +
ggtitle("Cohort Activity Heatmap (number of members who attended event)")
Эта версия позволяет нам сравнивать когорты друг с другом, но теперь у нас нет точных чисел, что означает, что более ранние когорты будут выглядеть лучше, так как в них меньше людей. Мы можем получить лучшее из обоих миров, сохранив эту визуализацию, но показывая фактические значения внутри каждого блока:
t <- max(cohortAttendanceWithMonthNumber$retentionPercentage)
cols <- c("#e7f0fa", "#c9e2f6", "#95cbee", "#0099dc", "#4ab04a", "#ffd73e", "#eec73a", "#e29421", "#e29421", "#f05336", "#ce472e")
ggplot(cohortAttendanceWithMonthNumber, aes(y=cohort, x=date, fill=retentionPercentage)) +
theme_minimal() +
geom_tile(colour="white", linewidth=2, width=.9, height=.9) +
scale_fill_gradientn(colours=cols, limits=c(0, t),
breaks=seq(0, t, by=t/4),
labels=c("0", round(t/4*1, 1), round(t/4*2, 1), round(t/4*3, 1), round(t/4*4, 1)),
guide=guide_colourbar(ticks=T, nbin=50, barheight=.5, label=T, barwidth=10)) +
theme(legend.position='bottom',
legend.direction="horizontal",
plot.title = element_text(size=20, face="bold", vjust=2),
axis.text.x=element_text(size=8, angle=90, hjust=.5, vjust=.5, face="plain")) +
ggtitle("Cohort Activity Heatmap (number of members who attended event)") +
geom_text(aes(label=members),size=3)
В целом, мы можем узнать, что большинство людей, похоже, имеют проходящий интерес, и тогда у нас будет меньший процент тех, кто будет продолжать посещать мероприятия.
Похоже, что мы лучше справились с удержанием посетителей в середине прошлого года — одна из гипотез состоит в том, что события, которые мы провели, были более убедительными, но мне нужно больше анализировать.
Далее я собираюсь углубиться в некоторые из недавних событий и посмотреть, из какой группы пришли участники.