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

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

  • 1
  • 2
  • 3
  • 4
  • 5
Всего голосов: 36 средняя оценка: 4.89 (рейтинг: 98%)
Во время активного развития технологий все более известными становятся такие термины как Artificial Intelligence, Machine Learning, Data Mining и Data Science. Основная задача данных технологий в бизнесе - научиться понимать поведение клиента в постоянно меняющихся условиях. Ведь если мы знаем как поведёт себя клиент в будущем, мы можем наилучшим образом спланировать и провести маркетинговые активности.
 
Математические алгоритмы машинного обучения работают с большими объёмами данных и находят даже скрытые закономерности поведения клиентов. Эти закономерности не видны менеджерам и, более того, иногда даже сами клиенты о них не подозревают (уже классический пример: случай с компанией Target). 
 
В этой статье мы рассмотрим один из подходов, который используется в системе искусственного интеллекта eSputnik Intelligence.
 
Данный подход основывается на нескольких идеях: 
  • понимание шаблонов поведения пользователей
  • уменьшение уровня беспокойства клиентов
  • увеличение продолжительности жизни клиентов
  • предотвращение выгорания базы клиентов
  • эффективное использование акционных предложений
Вы узнаете как увеличить результативность писем и при этом сократить общее количество отправляемых писем более чем на 30%.
 

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

Алгоритмы распознавания шаблонов с обучением предполагают наличие исторической информации (т.н. "учителя"), позволяющей построить модели статистической связи x → y, где
  • y ∈ Y, Y – наблюдаемые действия пользователя (responses) или моделируемой случайной величины
  • x ∈ X, X – множество переменных (predictors), с помощью которых предполагается объяснить изменчивость переменной y
Большинство моделей с учителем устроены таким образом, что их можно записать в виде
y = f(x, β) + ε, где:
  • f – математическая функция, выбранная из некоторого произвольного семейства
  • β – вектор параметров этой функции
  • ε – ошибки модели, которые обычно сгенерированы несмещенным, некоррелированным случайным процессом
В ходе построения модели по фиксированным выборочным значениям y минимизируется некоторая функция остатков Q(y, β). В результате, находят β̂ – вектор с оптимальными оценками параметров модели.
 
Варьируя вид функций f и Q, можно получать разные модели, из которых предпочтение отдается наиболее эффективным – т.е. моделям, которые дают несмещенные, точные и надежные прогнозы отклика y.
 

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

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

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

На практике, перед построением модели, необходимо собрать и проанализировать любую доступную информацию. Например, тип рассылки, активность на сайте, транзакции, пол, возраст, семейное положение, индивидуальные предпочтения и т.д. 
 
Но, для простоты изложения, рассмотрим общий случай, и смоделируем простой набор данных, который включает:
  • ContactID - id пользователя
  • Date - время получения письма
  • Response - метка конверсии (0 - нет, 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]

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]
  • процент открытия писем
  • процент открытия писем по будням/выходным
Activ[, OpenRate := Opened / Delivered]
Activ[, OpenRateByDayType := OpenedByDayType / DeliveredByDayType]
  • время существования пользователя в системе
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)]
  • дата последнего получения письма
  • дата последнего прочтения письма
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), ]
  • время от последнего полученного письма
  • время от последнего прочтения письма
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)]
  • нормированные показатели:
    • среднее количество писем получаемых пользователем в неделю
    • среднее количество писем открываемых пользователем в неделю
    • время до последнего полученного письма относительно времени существования пользователя в системе
    • время до последнего прочтения письма относительно времени существования пользователя в системе
Activ[, DeliveryNormed := Delivered / LifeTime]
Activ[, OpenedNormed := Opened / LifeTime]
Activ[, RecentlyDeliveryNormed := RecentlyDelivery / LifeTime]
Activ[, RecentlyOpenedNormed := RecentlyOpened / LifeTime]
  • бинарные показатели активности за выбранные периоды (0 - нет, 1 - да):
    • активен за последние 5 дней
    • активен за последние 10 дней
    • активен за последние 15 дней
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 принимает два значения (уже задана в исходных данных):
  • 0, если пользователь не прочитал письмо;
  • 1, если пользователь прочитал письмо.
Удалим вспомогательные данные:
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 <- sample(1:nrow(Activ), round(nrow(Activ) * .8))
Activ_train <- Activ[trainIndexes,  ]
Activ_test  <- Activ[-trainIndexes, ]

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

Воспользуемся средствами пакета stats для обучения моделей.
formula <- Response ~ .
fit <- glm(formula, family = binomial(link='logit'), data = Activ_train)

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

При оценке параметра y модель вычисляет вероятность прочтения письма, а не конкретное значение 0 либо 1. То есть мы получаем значение ŷ из интервала [0, 1]
 
Имея вероятности прочтения письма, необходимо определиться при каком пороге вероятности (так называемый параметр Threshold) мы будем относить пользователя к группе 0 либо 1. Сейчас, в качестве порогового значения, возьмем параметр threshold равным 0.09.
 
Поступим следующим образом:
  • если ŷ ≤ threshold, тогда Response = 0,
  • если ŷ > threshold, тогда Response = 1;
glmpred <- predict(fit, newdata = Activ_test,  type = 'response')
threshold <- 0.09
glmpredRound <- ifelse(glmpred > trashHold, yes = 1, no = 0)

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

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

Сравним результаты прогноза модели с реальными данными.
(testResult <- t(table(Факт = Activ_test$Response, Прогноз = glmpredRound)))
Получаем таблицу сопряженности действительных и предсказанных значений отклика на тестовой выборке.
           Факт
               0     1
Прогноз   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% писем, которые не будут прочитаны.

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

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

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

Только для подписчиков: 
НЕ Только для подписчиков

Добавить комментарий

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