Несколько недель назад я наткнулся на сообщение в блоге, объясняющее, как применить когортный анализ к удержанию клиентов с помощью R, и я подумал, что было бы забавно вычислить что-то подобное для участников встречи.
В примере удержания клиентов мы отслеживаем покупки клиентов на ежемесячной основе, и каждый клиент помещается в когорту или группу, основанную на первом месяце, в котором он совершил покупку.
Затем мы рассчитываем, сколько из них совершали покупки в последующие месяцы, и сравниваем это с поведением людей в других когортах.
В нашем случае мы ничего не продаем, поэтому нашим аналогом будет человек, посещающий встречу. Мы поместим людей в когорты, основываясь на месяце их первой встречи.
Это может действовать как прокси для того, когда люди начинают интересоваться технологиями, и, возможно, может позволить нам увидеть, как поведение новаторов, ранних последователей и раннего большинства отличается, если вообще отличается.
Первое, что нам нужно сделать, это получить данные, показывающие события, с которыми люди RSVP ответили «да». Я уже получил данные в Neo4j, поэтому мы напишем запрос, чтобы извлечь его как фрейм данных:
library(RNeo4j)
graph = startGraph("http://127.0.0.1:7474/db/data/")
query = "MATCH (g:Group {name: \"Neo4j - London User Group\"})-[:HOSTED_EVENT]->(e),
(e)<-[:TO]-(rsvp {response: \"yes\"})<-[:RSVPD]-(person)
RETURN rsvp.time, person.id"
timestampToDate <- function(x) as.POSIXct(x / 1000, origin="1970-01-01", tz = "GMT")
df = cypher(graph, query)
df$time = timestampToDate(df$rsvp.time)
df$date = format(as.Date(df$time), "%Y-%m")
> df %>% head() ## rsvp.time person.id time date ## 612 1.404857e+12 23362191 2014-07-08 22:00:29 2014-07 ## 1765 1.380049e+12 112623332 2013-09-24 18:58:00 2013-09 ## 1248 1.390563e+12 9746061 2014-01-24 11:24:35 2014-01 ## 1541 1.390920e+12 7881615 2014-01-28 14:40:35 2014-01 ## 3056 1.420670e+12 12810159 2015-01-07 22:31:04 2015-01 ## 607 1.406025e+12 14329387 2014-07-22 10:34:51 2014-07 ## 1634 1.391445e+12 91330472 2014-02-03 16:33:58 2014-02 ## 2137 1.371453e+12 68874702 2013-06-17 07:17:10 2013-06 ## 430 1.407835e+12 150265192 2014-08-12 09:15:31 2014-08 ## 2957 1.417190e+12 182752269 2014-11-28 15:45:18 2014-11
Затем нам нужно найти первое собрание, которое посетил человек — это определит когорту, на которую человек назначен:
firstMeetup = df %>% group_by(person.id) %>% summarise(firstEvent = min(time), count = n()) %>% arrange(desc(count)) > firstMeetup ## Source: local data frame [10 x 3] ## ## person.id firstEvent count ## 1 13526622 2013-01-24 20:25:19 2 ## 2 119400912 2014-10-03 13:09:09 2 ## 3 122524352 2014-08-14 14:09:44 1 ## 4 37201052 2012-05-21 10:26:24 3 ## 5 137112712 2014-07-31 09:32:12 1 ## 6 152448642 2014-06-20 08:32:50 17 ## 7 98563682 2014-11-05 17:27:57 1 ## 8 146976492 2014-05-17 00:04:42 4 ## 9 12318409 2014-11-03 05:25:26 2 ## 10 41280492 2014-10-16 19:02:03 5
Давайте назначим каждого человека в группу (месяц / год) и посмотрим, сколько людей принадлежит каждому:
firstMeetup$date = format(as.Date(firstMeetup$firstEvent), "%Y-%m") byMonthYear = firstMeetup %>% count(date) %>% arrange(date) ggplot(aes(x=date, y = n), data = byMonthYear) + geom_bar(stat="identity", fill = "dark blue") + theme(axis.text.x = element_text(angle = 45, hjust = 1))
Затем нам нужно отследить когорту, чтобы узнать, продолжают ли люди приходить на события. Я написал следующую функцию, чтобы решить это:
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 = TRUE)
cohortAttendance[is.na(cohortAttendance) & cohortAttendance$date > cohort] = 0
cohortAttendance %>% mutate(cohort = cohort, retention = n / length(members))
}
В первой строке мы получаем идентификаторы всех людей в группе, чтобы мы могли отфильтровать фрейм данных, чтобы включить только RSVP этих людей. Первый звонок ‘count’ гарантирует, что у нас есть только одна запись на человека в месяц, а второй звонок подсчитывает, сколько людей посетило мероприятие в конкретном месяце.
Затем мы делаем эквивалент левого объединения, используя функцию слияния, чтобы гарантировать, что у нас будет строка, представляющая каждый месяц, даже если никто из группы не присутствовал. Это приведет к появлению записей NA, если в кадре данных «посещаемость» нет подходящей строки — мы заменим их на 0, если группа будет в будущем. Если нет, мы оставим все как есть.
Наконец, мы рассчитываем коэффициент удержания для каждого месяца для этой когорты. Например, вот некоторые из строк для группы «2011-06»:
> countsForCohort(df, firstMeetup, "2011-06") %>% sample_n(10)
date n cohort retention
16 2013-01 1 2011-06 0.25
5 2011-10 1 2011-06 0.25
30 2014-03 0 2011-06 0.00
29 2014-02 0 2011-06 0.00
40 2015-01 0 2011-06 0.00
31 2014-04 0 2011-06 0.00
8 2012-04 2 2011-06 0.50
39 2014-12 0 2011-06 0.00
2 2011-07 1 2011-06 0.25
19 2013-04 1 2011-06 0.25
Затем мы могли бы построить график этой когорты:
ggplot(aes(x=date, y = retention, colour = cohort), data = countsForCohort(df, firstMeetup, "2011-06")) + geom_line(aes(group = cohort)) + theme(axis.text.x = element_text(angle = 45, hjust = 1))
Из этого графика видно, что никто из людей, впервые посетивших встречу Neo4j в июне 2011 года, не участвовал в каких-либо мероприятиях за последние два года.
Далее мы хотим иметь возможность построить несколько когорт на одном графике, что мы можем легко сделать, построив один большой фрейм данных и передав его в ggplot:
cohorts = collect(df %>% select(date) %>% unique())[,1]
cohortAttendance = data.frame()
for(cohort in cohorts) {
cohortAttendance = rbind(cohortAttendance,countsForCohort(df, firstMeetup, cohort))
}
ggplot(aes(x=date, y = retention, colour = cohort), data = cohortAttendance) +
geom_line(aes(group = cohort)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Все это выглядит немного беспорядочно, и в настоящее время мы не можем легко сравнить когорты, поскольку они начинаются в разных местах на оси x. Мы можем исправить это, добавив столбец monthNumber во фрейм данных, который мы вычисляем с помощью следующей функции:
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(monthNumber != "0") %>% mutate(monthNumber = as.numeric(monthNumber)) %>% arrange(monthNumber)
Мы также отфильтровываем любые столбцы «NA», которые представляют записи строк за месяцы до начала когорты. Мы не хотим строить такие сюжеты.
наконец, построим график, содержащий все когорты, нормализованные по номеру месяца
ggplot(aes(x=monthNumber, y = retention, colour = cohort), data = cohortAttendanceWithMonthNumber) + geom_line(aes(group = cohort)) + theme(axis.text.x = element_text(angle = 45, hjust = 1), panel.background = element_blank())
Это все еще что-то вроде беспорядка, но что выделяется тем, что когда количество людей в когорте невелико, колебания в величине удержания могут быть довольно заметными.
Следующий шаг — сделать когорты более крупнозернистыми, чтобы увидеть, раскрывают ли они некоторые идеи. Я думаю, что я начну с группы, охватывающей 3-месячный период, и посмотрю, как это работает.