Как стать автором
Обновить

R в руках маркетолога. Когортный анализ своими руками

RВизуализация данныхАналитика мобильных приложенийУправление продажами

В маркетинге очень популярен когортный анализ. Его популярность вызвана, скорее всего, легкостью алгоритма и вычислений. Никаких серьезных математических концепций в основе нет, элементарная математика, выполняемая в excel. С точки зрения получения инсайтов гораздо интереснее анализ дожития.


Тем не менее, считаем, что есть такая задача и ее надо решить. Искать какие-либо пакеты и готовые функции неинтересно — математика проста, параметров настройки масса. Ниже возможный пример реализации (без особой фиксации на скорость исполнения), всего кода на пару десятков строк.


Является продолжением серии предыдущих публикаций.


Немного кода


При создании тестового набора мы можем особо не акцентироваться на временнЫх зонах, все равно данные случайные.


Создание тестового набора
# генерируем данные на 15 недель
set.seed(42)

events_dt <- tibble(user_id = 1000:9000) %>%
  mutate(birthday = Sys.Date() + as.integer(rexp(n(), 1/10))) %>%
  rowwise() %>%
  mutate(timestamp = list(as_datetime(birthday) + 24*60*60 * (
     rexp(10^3, rate = 1/runif(1, 2, 25))))) %>%
  ungroup() %>%
  unnest(timestamp) %>%
  # режем длинные хвосты в прошлом и в будущем
  filter(timestamp >= quantile(timestamp, probs = 0.1),
         timestamp <= quantile(timestamp, probs = 0.95)) %>%
  mutate(date = as_date(timestamp)) %>%
  select(user_id, date) %>%
  setDT(key = c("user_id", "date")) %>%
  # оставим только уникальные по датам события
  unique()

Посмотрим на получившееся интегральное распределение


ggplot(events_dt, aes(date)) +
  geom_histogram()


Шаг 1. Формируем справочник пользователей


В настоящем примере справочник будет тривиальным и содержит только "дату рождения", т.е. дату, когда мы первый раз встретились с ним. Установка ключей для data.table объекта приводит к физической сортировке данных в порядке появления ключей.


Формируем справочник пользователей
users_dict <- events_dt[, .(birthday = head(date, 1)), by = user_id] %>%
  # для последующей сортировки оставим дату начала недели
  .[, week_start := floor_date(.BY[[1]], unit = "week"), by = birthday] %>%
    # переведем даты рождения в номера когорт
  .[, cohort := stri_c(
        lubridate::isoyear(.BY[[1]]), 
        sprintf("%02d", lubridate::isoweek(.BY[[1]])), 
        sep = "/"), by = week_start]
# посмотрим на распределение дат, нам нужен разброс для красивой картинки
as_tibble(janitor::tabyl(users_dict, birthday))


Шаг 2. Подготовим разметку в терминах когортного анализа


Совсем за скоростью пока не гонимся.


Составим справочник когорт. Для сокращения преобразований и обеспечения последующей сортировки.


Строим когортное представление в data.frame
cohort_dict <- unique(users_dict[, .(cohort, week_start)])

cohort_tbl <- users_dict[events_dt, on = "user_id"] %>%
  # посчитаем удаленность событий от даты рождения в терминах недель
  .[, rel_week := floor(as.numeric(difftime(date, birthday, units = "week")))] %>%
  # оставим только 10 недель
  .[rel_week <= 9] %>%
  # редуцируем до уникальных пользователей
  unique(by = c("user_id", "cohort", "rel_week")) %>%
  # считаем агрегаты в терминах когорт и недель
  .[, .N, by = .(cohort, rel_week)] %>%
  .[, rate := N/max(N), by = cohort]

Шаг 3. Визуализируем


Вариант 1. ggplot


Визуализация ggplot
# вариант ggplot
data_tbl <- cohort_tbl %>%
  # вернем числовые показатели когорт для сортировки
  left_join(cohort_dict)

data_tbl %>%
  mutate(cohort_group = forcats::fct_reorder(cohort, week_start, .desc = TRUE)) %>%
  ggplot(mapping = aes(x = rel_week, y = cohort_group, fill = rate)) +
  geom_tile()  +
  geom_text(aes(label = N), colour = "darkgray") +
  labs(x = "Недели существования когорты",
       y = "Неделя появления когорты",
       fill = "Количество\nпользователей",
       title = "graph_title") +
  scale_fill_viridis_c(option = "inferno") +
  scale_x_continuous(breaks = scales::breaks_width(1)) +
  theme_minimal() +
  theme(panel.grid = element_blank())


Вариант 2. gt


Для оформления используем тот факт, что у нас всегда по две строки на когорту и они отсортированы в нужном порядке.


Визуализация gt
# подготовим табличку-подложку
data_tbl <- cohort_tbl %>%
  pivot_longer(cols = c(N, rate)) %>%
  pivot_wider(names_from = rel_week, values_from = value) %>%
  # вернем числовые показатели когорт для сортировки
  left_join(cohort_dict) %>%
  arrange(week_start, desc(name))

odd_rows <- seq(1, to = nrow(data_tbl), by = 2)
even_rows <- seq(2, to = nrow(data_tbl), by = 2)

tab <- data_tbl %>%
  mutate(cohort = if_else(rep(c(TRUE, FALSE), length.out = nrow(.)), 
                          cohort, "")) %>%
  select(-name, -week_start) %>%
  gt(rowname_col = "cohort") %>%
  fmt_percent(columns = matches("[0-9]+"), 
              rows = odd_rows, 
              decimals = 0, pattern = "<big>{x}</big>") %>%
  fmt_missing(columns = everything(), 
              missing_text = "---") %>%
  tab_stubhead(label = "Неделя появления когорты") %>%
  tab_spanner(label = "Неделя существования когорты",
              columns = everything()) %>%
  tab_header(title = "Развертка") %>%
  data_color(columns = everything(),
             colors = scales::col_numeric(palette = "inferno",
                                          domain = c(0, 1), 
                                          alpha = 0.6,
                                          na.color = "lightgray")) %>%
  tab_options(
    table.font.size = "smaller",
    data_row.padding = px(1),
    table.width = pct(75)
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "white"),
      cell_text(style = "italic"),
      cell_borders(sides = "bottom")
    ),
    locations = cells_body(
      columns = everything(),
      rows = even_rows)
  ) %>%
  tab_style(
    style = list(
      cell_borders(sides = "top")
    ),
    locations = cells_body(
      columns = everything(),
      rows = odd_rows)
  )

tab


Каркас приведен, прочее каждый может модифицировать под себя.


Предыдущая публикация — «R и работа со временем. Что за кулисами?».

Теги:маркетингdata scienceкогортный анализвизуализация данных
Хабы: R Визуализация данных Аналитика мобильных приложений Управление продажами
Всего голосов 3: ↑3 и ↓0 +3
Просмотры1.7K

Похожие публикации

Аналитик данных (Data analyst)
до 80 000 ₽KonnektUМосква
Data Engineer (Инженер данных)
от 200 000 до 300 000 ₽ГК МегаполисМоскваМожно удаленно
Data Engineer / Инженер данных
от 100 000 до 150 000 ₽AnyclassМоскваМожно удаленно
Руководитель/ница проекта с экспертизой в Data Science в Теплицу социальных техн
от 105 000 ₽Теплица социальных технологийМожно удаленно
Data Steward (Управление данными)
до 170 000 ₽Рекрутинговая компания КоломбоМожно удаленно

Лучшие публикации за сутки