Прогнозирование активности пользователей с использованием Machine Learning и языка R

Во время активного развития технологий все более известными становятся такие термины как Artificial Intelligence, Machine Learning, Data Mining и Data Science. Основная задача данных технологий в бизнесе - научиться понимать поведение клиента в постоянно меняющихся условиях. Ведь если мы знаем как поведёт себя клиент в будущем, мы можем наилучшим образом спланировать и провести маркетинговые активности.

Математические алгоритмы машинного обучения работают с большими объёмами данных и находят даже скрытые закономерности поведения клиентов. Эти закономерности не видны менеджерам и, более того, иногда даже сами клиенты о них не подозревают (уже классический пример: случай с компанией Target).

В этой статье мы рассмотрим один из подходов, который используется в системе искусственного интеллекта eSputnik Intelligence.

Данный подход основывается на нескольких идеях:

Вы узнаете как увеличить результативность писем и при этом сократить общее количество отправляемых писем более чем на 30%.

1. Формальная постановка задачи

Алгоритмы распознавания шаблонов с обучением предполагают наличие исторической информации (т.н. "учителя"), позволяющей построить модели статистической связи x → y, где

Большинство моделей с учителем устроены таким образом, что их можно записать в виде

y = f(x, β) + ε, где:

В ходе построения модели по фиксированным выборочным значениям y минимизируется некоторая функция остатков Q(y, β). В результате, находят β̂ - вектор с оптимальными оценками параметров модели.

Варьируя вид функций f и Q, можно получать разные модели, из которых предпочтение отдается наиболее эффективным - т.е. моделям, которые дают несмещенные, точные и надежные прогнозы отклика y.

2. Подготовка данных

Следует помнить о том, что любой статистический метод будет хорош настолько, насколько качественными являются входные данные для обучения модели (англ. "garbage in - garbage out!" или "хлам на входе - хлам на выходе"). Без затраты усилий на подготовку обучающей выборки (фильтрация, трансформация, удаление пропущенных значений, создание производных переменных и т.д.) и понимания моделируемого процесса чудес не случается.

2.1. Моделирование исходных данных

На практике, перед построением модели, необходимо собрать и проанализировать любую доступную информацию. Например, тип рассылки, активность на сайте, транзакции, пол, возраст, семейное положение, индивидуальные предпочтения и т.д.

Но, для простоты изложения, рассмотрим общий случай, и смоделируем простой набор данных, который включает:

Причем данные должны быть наиболее приближенные к поведению реальных пользователей. В наших данных, будут пользователи, которые: совершенно не читают письма, читают редко, читают почти всё. Учтём также, что некоторые из пользователей читаю письма с определённой периодичностью, а некоторые - от случая к случаю.

Сперва подключим необходимые пакеты, и зададим функции:

Подключение пакетов
library(data.table)
library(dplyr)
library(lubridate)

repeat_last <- function(x, forward = TRUE, maxgap = Inf, na.rm = FALSE) {
if (!forward) x = rev(x)
  ind = which(!is.na(x))
  if (is.na(x[1]) && !na.rm)
  ind = c(1,ind)
  rep_times = diff(
  c(ind, length(x) + 1))
  if (maxgap < Inf) {
  exceed = rep_times - 1 > maxgap
  if (any(exceed)) {
  ind = sort(c(ind[exceed] + 1, ind))
  rep_times = diff(c(ind, length(x) + 1))
  }
  }
  x = rep(x[ind], times = rep_times)
  if (!forward) x = rev(x)
  x
}

shiftUp <- function(x, n){
  as.integer(c(rep(0, n), x[-((length(x)-n+1) : length(x))]))
}

Смоделируем данные:

Моделирование
n <- 1000000
initialDate <- ymd_hms("2015-01-01 00:00:00")

set.seed(9)
Activ <- data.table(ContactID = base::sample(1:5000, replace = T),
  Date = initialDate +
  as.difftime(runif(n, min = 0, max = 5*365/2*24*60),
  units = "mins"))
set.seed(9)
Activ[, Response := rnorm(.N, mean = sample(1:200, 1),
  sd = sample(1:50, 1)), by = ContactID]

q <- quantile(Activ$Response, .85)
Activ[Response < q, Response := 0][Response > q, Response := 1]

Вот так выглядят данные, которые мы сформировали:

  ContactID Date Response
1: 45 2017-05-30 22:22:49 0
2: 5 2017-02-14 18:35:40 0
3: 42 2017-03-10 17:31:10 0
4: 44 2017-06-04 14:49:50 0
5: 89 2017-05-17 03:59:05 0
6: 27 2017-04-18 08:30:45 0
7: 79 2017-01-24 07:39:52 0
8: 74 2017-03-14 01:20:03 0
9: 134 2017-05-15 00:25:07 1
10: 199 2017-05-01 16:14:43 0
... ... ... ...
100000: 151 2017-01-07 04:08:03 0

Исключим информацию о пользователях, которые совершенно не активны. На практике с такими пользователями необходимо работать персонализированно. К примеру, разрабатывать методы их реактивации.

Исключаем неактивных пользователей
Activ <- Activ[order(ContactID, Date), ]
ActivUsers <- Activ %>% group_by(ContactID) %>%
  summarise(IsActive = ifelse(sum(Response) == 0,
  yes = 0, no = 1)) %>%
  filter(IsActive == 1)

setDT(ActivUsers)
Activ <- merge(Activ, ActivUsers, by = "ContactID", all.x = F, all.y = F)
Activ[, IsActive := NULL]

Эффективный email-маркетинг с eSputnik

Регистрация

2.2. Агрегирование информации по каждому пользователю

Важно понимать, что до того как мы узнаём реакцию пользователя на очередное письмо, мы знаем лишь предыдущую историю его поведения. Утверждение очевидное, но на это можно не обратить внимание при формировании переменных для обучения.

Сформируем множество переменных X - посчитаем для каждого пользователя, на момент получения очередного письма в истории, следующие показатели:

Агрегирование информации
Activ[, Day := wday(Date, label = T)]
Activ[, DayType := ifelse(Day %in% c("Sat", "Sun"),
  yes = "Weekend", no = "Weekday")]
Activ[, Day := NULL]

Activ[, Delivered := .N, by = list(ContactID, Date)]
Activ[, Delivered := cumsum(Delivered), by = list(ContactID)]
Activ[Response == 1, Opened := .N, by = list(ContactID, Response, Date)]
Activ[is.na(Opened), Opened := 0]
Activ[, Opened := cumsum(Opened), by = list(ContactID)]
Activ[, Opened := shiftUp(Opened, 1), by = list(ContactID)]
Activ[, Delivered := shiftUp(Delivered, 1), by = list(ContactID)]

Activ[, DeliveredByDayType := .N,
  by = list(ContactID, DayType, Date)]
Activ[, DeliveredByDayType := cumsum(DeliveredByDayType),
  by = list(ContactID, DayType)]

Activ[Response == 1, OpenedByDayType := .N,
  by = list(ContactID, Response, Date)]
Activ[is.na(OpenedByDayType), OpenedByDayType := 0]
Activ[, OpenedByDayType := cumsum(OpenedByDayType),
  by = list(ContactID, DayType)]
Activ[, OpenedByDayType := shiftUp(OpenedByDayType, 1),
  by = list(ContactID, DayType)]
Activ[, DeliveredByDayType := shiftUp(DeliveredByDayType, 1),
  by = list(ContactID)]

Activ[, OpenRate := Opened / Delivered]
Activ[, OpenRateByDayType := OpenedByDayType / DeliveredByDayType]
Code
Activ[, OpenRate := Opened / Delivered]
Activ[, OpenRateByDayType := OpenedByDayType / DeliveredByDayType]
Code
Activ <- Activ[order(ContactID, Date), ]
Activ[, CreatedDate := min(Date), by = ContactID]
Activ[, LifeTime := difftime(Date, CreatedDate, units = "weeks"),
  by = ContactID]
Activ[, LifeTime := as.numeric(LifeTime)]
Code
Activ[, LastDelivered := data.table::shift(Date, type = "lag"),
  by = ContactID]
Activ[Response == 1, LastOpened := data.table::shift(Date, type = "lag"),
  by = list(ContactID, Response)]
Activ[, temp := LastOpened]
Activ[, temp := repeat_last(temp), by = list(ContactID)]
Activ <- Activ[order(desc(ContactID), desc(Date)), ]
Activ[!is.na(temp), LastOpened := repeat_last(LastOpened), by = list(ContactID)]
Activ <- Activ[order(ContactID, Date), ]
Activ[, temp := NULL]
Activ <- Activ[!is.na(LastOpened), ]
Code
Activ[, RecentlyDelivery := difftime(Date, LastDelivered,
  units = "days"),
  by = ContactID]
Activ[, RecentlyOpened := difftime(Date, LastOpened,
  units = "days"),
  by = ContactID]
Activ[, RecentlyDelivery := as.numeric(RecentlyDelivery)]
Activ[, RecentlyOpened := as.numeric(RecentlyOpened)]
Code
Activ[, DeliveryNormed := Delivered / LifeTime]
Activ[, OpenedNormed := Opened / LifeTime]
Activ[, RecentlyDeliveryNormed := RecentlyDelivery / LifeTime]
Activ[, RecentlyOpenedNormed := RecentlyOpened / LifeTime]
Code
Activ[RecentlyOpened <= 5, ActiveLast5 := 1]
Activ[is.na(ActiveLast5), ActiveLast5 := 0]
Activ[RecentlyOpened <= 10, ActiveLast10 := 1]
Activ[is.na(ActiveLast10), ActiveLast10 := 0]
Activ[RecentlyOpened <= 15, ActiveLast15 := 1]
Activ[is.na(ActiveLast15), ActiveLast15 := 0]
Activ[, ActiveLast5 := as.factor(ActiveLast5)]
Activ[, ActiveLast10 := as.factor(ActiveLast10)]
Activ[, ActiveLast15 := as.factor(ActiveLast15)]

Переменная отклика Y принимает два значения (уже задана в исходных данных):

Удалим вспомогательные данные:

Code
Activ[, CreatedDate := NULL]
Activ[, LastDelivered := NULL]
Activ[, LastOpened := NULL]
Activ[, Delivered := NULL]
Activ[, Opened := NULL]
Activ[, Date := NULL]
Activ[, DeliveredByDayType := NULL]
Activ[, OpenedByDayType := NULL]
Activ[, ContactID := NULL]
Activ[, RecentlyDelivery := NULL]
Activ[, RecentlyOpened := NULL]

Отлично, данные для обучения модели готовы. Построим модель предсказания значения переменной отклика y при заданном значении параметров xi ∈ X, i = {1,..,n}.

Другими словами, модель будет отвечать на такой вопрос: прочтет пользователь очередное письмо или нет? Если прочтет - отправляем письмо. Если нет - ожидаем от модели сигнала к отправке.

Соответственно, наша задача сводится к задаче бинарной классификации - классифицируем переменную y всего двумя значениям 0 либо 1 (где 0 - нет, не прочтет; 1 - да, прочтет).

Кстати, мы сформировали переменные только для примера. Возможно, некоторые из них неинформативные. В одной из последующих статей мы рассмотрим тему анализа значимости переменных.

3. Выбор и обучение модели

Один из ключевых моментов с которым исследователь сталкивается при разработке статистической модели изучаемого явления, заключается в выборе оптимального для конкретного случая алгоритма извлечения закономерностей.

Не вдаваясь в описание существующих алгоритмов машинного обучения, можно сказать, что многие из них довольно сложные. Естественно, сложные алгоритмы контринтуитивны и тяжело интерпретируемы. Но, исследования показывают, что простые методы (на примере классификаторов) при решении практических задач часто превосходят более сложные алгоритмы.

Для нашей задачи в качестве математической функции f возьмём функцию логистической регрессии, а в качестве функции остатков Q - логистическую функцию максимального правдоподобия (чисто интуитивно, функция Q помогает найти такие значения параметров β̂ при которых предсказанные вероятности отклика Ŷ наиболее близки к действительным значениям отклика Y).

Итеративное взаимодействие функций f и Q подберёт оптимальные параметры функции f для описания поведения откликов Y, через переменные X.

3.1. Разделение данных на обучающую и тестовую выборки

При построении модели, необходимо проверить её точность. Поэтому, разделим наши данные на две части: обучающую (80%) и проверочную (20%).

set.seed(9)
trainIndexes &lt;- sample(1:nrow(Activ), round(nrow(Activ) * .8))
Activ_train &lt;- Activ[trainIndexes,  ]
Activ_test  &lt;- Activ[-trainIndexes, ]

3.2. Обучение модели на выборке для обучения

Воспользуемся средствами пакета stats для обучения моделей.

formula &lt;- Response ~ .
fit &lt;- glm(formula, family = binomial(link=&#39;logit&#39;), data = Activ_train)

3.3. Предсказание результатов для тестовой выборки

При оценке параметра y модель вычисляет вероятность прочтения письма, а не конкретное значение 0 либо 1. То есть мы получаем значение из интервала [0, 1].

Имея вероятности прочтения письма, необходимо определиться при каком пороге вероятности (так называемый параметр Threshold) мы будем относить пользователя к группе 0 либо 1. Сейчас, в качестве порогового значения, возьмем параметр threshold равным 0.09.

Поступим следующим образом:

glmpred &lt;- predict(fit, newdata = Activ_test,  type = &#39;response&#39;)
threshold &lt;- 0.09
glmpredRound &lt;- ifelse(glmpred &gt; trashHold, yes = 1, no = 0)

Техология выбора порога вероятности описана в теме управления рисками при фильтрации email-рассылок.

4. Анализ точности модели

Сравним результаты прогноза модели с реальными данными.

(testResult &lt;- t(table(Факт = Activ_test$Response, Прогноз = glmpredRound)))

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

              Actual
              0     1
Predicted   0 13642   630
            1 34967 29054

Мы отправляем письмо тем пользователям, для которых имеем Прогноз = 1. Пользователям у которых Прогноз = 0, письмо не отправляем.

5. Анализ результатов

  1. Мы сократили количество отправленных писем на 14272 (18,24%)
    • 13642 + 630 = 14272
    • (13642+630) / (13642 + 630 +34967 + 29004) * 100 = 18,24%
  2. Точность прогноза отклика составляет 97,88%, т.е. мы потеряли всего 2,12% открытий
    • (1 - 630 / (630 + 29004)) * 100 = 97,88%

Существенно ли это?

Очевидно, что разумно пожертвовать этим количеством открытий и не отправить лишние 18,24% писем, которые не будут прочитаны.

Это позволит не беспокоить пользователей без необходимости и предотвратить выгорание контактной базы.

К тому же, если пользователь реже получает письма, ему интереснее их читать. Также он более вероятно совершит целевое действие при получении очередного письма.

Заметим, что этот результат получен с использованием минимума информации. При добавлении в модель дополнительной информации, о которой мы говорили выше, эфективность модели увеличивается в несколько раз.

Получить персонализированную консультацию

Даже если вы не нашли интересующие вас функции в списке возможностей eSputnik, мы открыты к предложениям и внедрим решения, способные повысить эффективность работы с системой.