Statistical Methods in Customer Relationship Management

Chapter 5. Balancing Acquisition and Retention

Мы продолжаем рассматриваем в R примеры SAS на наборах данных из книги Kumar V., Petersen Andrew J. “Statistical Methods in Customer Relationship Management”.

Глава 5. Балансирование между привлечением и удержанием

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

И, в конце концов, все клиенты будут отказываться от фирмы в определенный момент времени в будущем. В идеале фирма хочет управлять этим процессом, так что новые клиенты заменяют тех текущих клиентов, которые уходят от фирмы. При этом будет очень хорошо, если уровень привлечения окажется выше уровня оттока. Таким образом, размер клиентской базы фирмы продолжает расти (или, по крайней мере, не сокращается). Кроме того, после подключения клиента фирма хочет построить отношения с клиентом, чтобы продлить жизнь и рентабельность клиента в фирме. Поэтому фирме необходимо «сбалансировать» маркетинговые усилия между приобретением и удержанием, чтобы максимизировать прибыльность клиентской базы с течением времени.

Issues addressed in balancing acquisition and retention modeling

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

• Что является драйверами приобретения клиента?

• Сколько необходимо потратить, чтобы приобрести клиента?

• Как только клиент будет получен, как долго можно ожидать, что лн будет оставаться клиентом?

• Сколько следует инвестировать в поддержание отношения, чтобы сохранять клиента дольше в будущем?

• Учитывая ограничения ресурсов, сколько требуется потратить усилий на привлечение по сравнению с усилиями по удержанию, чтобы максимизировать долгосрочную рентабельность?

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

Данные для эмпирических примеров

Для всех эмпирических примеров в этой главе авторы предлагают набор данных под названием “acquisitionRetention”. Этот набор данных включает репрезентативную выборку из 500 клиентов из типичной фирмы B2B, где все клиенты одной и той же когорты. В этом случае когорта состоит из случайной выборки из 500 клиентов, которые одновременно совершили первую покупку в фирме. Набор данных предоставляет транзакционную и фирменную информацию для каждого клиента. Таким образом, таблица данных состоит из 500 клиентов * 14 переменных (15 полных столбцов):

Переменные	Описание
Customer	Номер потребителя (от 1 до 500)
Acquisition	1, если клиент был приобретен, 0 в противном случае
Profit	CLV - Прогноз пожизненной ценности клиента. Это -(Acq_Expense), если клиента не привлекли (’000)
Duration	Время в днях, когда компании была или продолжает быть клиентом
Acq_Exp	Долларовые расходы на маркетинг по привлечению клиента
Ret_Exp	Долларовые расходы на маркетинг по удержание клиента
Acq_Exp_SQ	Квадрат расходов на привлечение
Ret_Exp_SQ	Квадрат расходов на удержание
Freq	Количество покупок клиента во время окна наблюдения
Freq_SQ	Квадрат количества покупок
Crossbuy	Количество категорий товаров / услуг, приобретенных клиентом
Share-of-Wallet (SOW)	Процент покупок клиента от данной фирмы, учитывая общий объем покупок по всем фирмам в этой категории
Industry	1, если клиент в секторе B2B, 0 в противном случае, т. е. B2C
Revenue	Годовой доход от продаж компании (млн долл.)
Employees	Количество сотрудников в компании

library('tidyverse')

## -- Attaching packages ----------------------------------------------------------------------------- tidyverse 1.2.1 --

## v ggplot2 2.2.1     v purrr   0.2.4
## v tibble  1.4.2     v dplyr   0.7.5
## v tidyr   0.8.1     v stringr 1.3.1
## v readr   1.1.1     v forcats 0.3.0

## -- Conflicts -------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library('caret')

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following object is masked from 'package:purrr':
## 
##     lift

library('car')

## Loading required package: carData

## 
## Attaching package: 'car'

## The following object is masked from 'package:dplyr':
## 
##     recode

## The following object is masked from 'package:purrr':
## 
##     some

utils::data('acquisitionRetention', package = 'SMCRM')

Следует отметить, что авторы решили избавиться от признака First_Purchase, которые зачастую оказавался незначимым в ряде моделей, рассмотренных в предыдущих главах. Также отсутствует признак Censor, который использовался в модели Времени Ускореннного Отказа (англ. “Accelerated Failure Time (AFT) Model”) из третьей главы. При этом надо понимать, что данные в этой главе совершенно иные, чем в наборе данных в третьей главы.

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

Четырех этапная структура моделирования балансирования между привлечением и удержанием клиентов

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

• модель привлечения,

• модель продолжительности и

• модель кумулятивной рентабельности

Рейнартц, Томас и Кумар [3] моделировали приобретение, удержание и рентабельность клиентов в совокупности в системе уравнений. Первый этап модели привлечения - пробит-модель оценивает процесс привлечения, а ее второй этап - линейная регрессия методом наименьших квадратов, а две стандартные модели с правом цензуры Tobit оценивают продолжительность взаимоотношений с клиентами и рентабельность клиентов.

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

\[ \displaystyle \begin{array}{ll} y_{Li} = \begin{cases} = \beta'_L x_{Li} + \gamma ' y_{Di} + \varepsilon _{Li} & {\text{if}}\ z_i = 1 \\ & & & {\text{(уравнение кумулятивной рентабельности)}} \\ = 0 & {\text{в противном случае}} \\ \end{cases} \end{array} \]

\[ \displaystyle \begin{array}{ll} & y_{Di} = \begin{cases} = \beta'_D x_{Di} + \varepsilon _{Di} & {\text{if}}\ z_i = 1 \\ & & & {\text{(уравнение продолжительности)}} \\ = 0 & {\text{в противном случае}} \\ \end{cases} \end{array} \]

\[ \displaystyle \begin{array}{ll} z^* _i = \alpha ' v_i + \mu _i & & & & & {\text{(уравнение привлечения)}} \\ \end{array} \]

\[ \displaystyle \begin{array}{ll} z_{i} = \begin{cases} 1 \enspace {\text{if}}\ z ^* _i > 0 \\ 0 \enspace {\text{if}}\ z ^* _i \leq 0 \\ \end{cases} \end{array} \]

где \(z^* _i\) - скрытая переменная, указывающая на полезность клиента i для установления связи с фирмой,

\(z_{i}\) - индикаторная переменная, показывающая, привлечен ли клиент i (\(z_{i} = 1\)) или нет (\(z_{i} = 0\)),

\(v_{i}\) - вектор ковариатов, влияющих на приобретение клиента i,

\(y_{Di}\) - длительность взаимоотношений клиента i с фирмой,

\(x_{Di}\) - вектор ковариатов, влияющий на продолжительность отношений клиента i с фирмой,

\(y_{Li}\) - совокупная доходность клиента i,

\(y_{Di}\) - вектор ковариатов, влияющих на стоимость жизни клиента i;

\(\alpha; \beta'_L; \beta'_D\) - вектор параметров и \(\mu_i; \enspace \varepsilon_{Di} \enspace и \enspace \varepsilon_{Li}\) - ошибки модели.

Учитывая, что структура моделирования носит рекурсивный характер, авторы рекомендуеют оценивать ее поэтапно (см. рисунок ниже).

Four-stage modeling framework

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

Первый этап эмпирического примера: модель привлечения клиента

Ключевой вопрос, который надо ответить в отношении приобретения клиентов, заключается в том, можем ли мы определить, какие будущие перспективы имеют наивысшую вероятность. Для этого сначала нужно знать, какие прошлые клиенты были привлечены, а какие нет. В наборе данных, предоставленном для этой главы, имеется бинарная переменная, которая идентифицирует, был ли перспективный потребитель привлечен фирмой (и, следовательно, стал клиентом), и набор драйверов, которые могут помочь объяснить решение клиента принять предложение фирмы. Случайная выборка из 500 потенциальных клиентов (некоторые из которых стали клиентами) была взята из фирмы B2B. Информация, необходимая для авторской модели приобретения, включает следующий список переменных: Информация, необходимая для этой модели, включает следующий список переменных:

Переменные	Описание
Зависимая переменная
Acquisition	1, если клиент был приобретен, 0 в противном случае
Предикторы
Acq_Exp	Долларовые расходы на маркетинг по привлечению клиента
Acq_Exp_SQ	Квадрат расходов на привлечение
Industry	1, если клиент в секторе B2B, 0 в противном случае, т. е. B2C
Revenue	Годовой доход от продаж компании (млн долл.)
Employees	Количество сотрудников в компании

Первый этап построения и верификации привлечения клиентов

Нужно смоделировать вероятность того, что предложение фирмы будет принято клиентом. Поскольку зависимая переменная (Acquisition) является бинарной, то нужна структура ошибок, которая похожа на модели продолжительности и прибыли (как нормально распределенные), поэтому авторы выбирают пробит-регрессию для этой модели. Выбор логистической регрессии потребовал бы преобразования вывода модели до объединения результатов с двумя другими уравнениями. В этом случае переменная y представляет собой Acquisition и предикторы x представляют пять независимых переменных в эмпирической базе данных. Когда авторы строят пробит-регрессию, то получают на этих данных следующий результат:

Probit

# Check for Class Imbalances
writeLines("Distribution Variable 'Acquisition' by Response Levels")

## Distribution Variable 'Acquisition' by Response Levels

acquisitionRetention$acquisition %>%
  factor() %>%
    table() # %>%

## .
##   0   1 
## 162 338

      # prop.test()
  
# Fit Probit Model for Customer Acquisition by Authors
Ch05.probit <- glm(acquisition ~ acq_exp + acq_exp_sq + industry + revenue + employees, 
             data = acquisitionRetention, family = binomial(link = 'probit'))
summary(Ch05.probit)

## 
## Call:
## glm(formula = acquisition ~ acq_exp + acq_exp_sq + industry + 
##     revenue + employees, family = binomial(link = "probit"), 
##     data = acquisitionRetention)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.4793  -0.4151   0.1690   0.5212   2.4548  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -8.256e+00  8.106e-01 -10.184  < 2e-16 ***
## acq_exp      1.730e-02  2.439e-03   7.092 1.32e-12 ***
## acq_exp_sq  -1.740e-05  2.425e-06  -7.178 7.08e-13 ***
## industry     1.217e+00  1.682e-01   7.235 4.65e-13 ***
## revenue      4.250e-02  8.169e-03   5.202 1.97e-07 ***
## employees    4.318e-03  4.339e-04   9.952  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 629.85  on 499  degrees of freedom
## Residual deviance: 351.28  on 494  degrees of freedom
## AIC: 363.28
## 
## Number of Fisher Scoring iterations: 7

writeLines(sprintf("-2 Log L of Intercept and Only Covariates: %.3f", -2 * logLik(Ch05.probit)[1]))

## -2 Log L of Intercept and Only Covariates: 351.277

writeLines(sprintf("                  AIC (smaller is better): %.3f", extractAIC(Ch05.probit)[2]))

##                   AIC (smaller is better): 363.277

writeLines("\n Wald test of predictors")

## 
##  Wald test of predictors

car::Anova(Ch05.probit, type="II", test="Wald")

## Analysis of Deviance Table (Type II tests)
## 
## Response: acquisition
##            Df  Chisq Pr(>Chisq)    
## acq_exp     1 50.293  1.324e-12 ***
## acq_exp_sq  1 51.523  7.077e-13 ***
## industry    1 52.349  4.646e-13 ***
## revenue     1 27.066  1.967e-07 ***
## employees   1 99.049  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

writeLines("\n Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others")

## 
##  Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others

car::vif(Ch05.probit) # Variance Inflation Factors - if vif() > 2 - feature has multicollinearity 

##    acq_exp acq_exp_sq   industry    revenue  employees 
##  28.740435  28.891710   1.165344   1.038135   1.166101

writeLines("\n Probit Model: Association of Predicted Probabilities and Observed Responses \n")

## 
##  Probit Model: Association of Predicted Probabilities and Observed Responses

prob <- predict(Ch05.probit, newdata = acquisitionRetention, type = "response") 
caret::confusionMatrix(data = ifelse(prob > 0.5, "1", "0") %>% factor,
                       reference = acquisitionRetention$acquisition %>% factor,
                       positive = "1", mode = "everything")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 105  38
##          1  57 300
##                                           
##                Accuracy : 0.81            
##                  95% CI : (0.7728, 0.8435)
##     No Information Rate : 0.676           
##     P-Value [Acc > NIR] : 1.431e-11       
##                                           
##                   Kappa : 0.5526          
##  Mcnemar's Test P-Value : 0.06478         
##                                           
##             Sensitivity : 0.8876          
##             Specificity : 0.6481          
##          Pos Pred Value : 0.8403          
##          Neg Pred Value : 0.7343          
##               Precision : 0.8403          
##                  Recall : 0.8876          
##                      F1 : 0.8633          
##              Prevalence : 0.6760          
##          Detection Rate : 0.6000          
##    Detection Prevalence : 0.7140          
##       Balanced Accuracy : 0.7679          
##                                           
##        'Positive' Class : 1               
## 

Все пять предиторов, включенные в эту модель, являются высокозначимыми. Обращает на себя внимание, что бинарный признак очень не равномерно распределен между “1” и “0”. Это проявление проблемы несбалансированности классов, которая может серьезно повлиять на качество модели, которая в итоге получили значение Cohen’s Kappa ниже среднего - 0.5526. Странно, но авторы упоминают о проблемах с точностью пробит-модели, но не поясняют ее причин и не предпринимают никаких реальных шагов по ее улучшения.

Probit (AR version)

Я построил бинарную модель с учетом весов этих двух классов? прибегая к бутстрепу на 25 “псевдовыборок”, что обеспечило создание устойчивой модели не допуская переобучения на этих данных.

# Fit Probit Regression Model for Customer Аcquisition (Improved)
uno = 'probit'

# Weights of cases to resolve Class Imbalances Problem
weight.cases <- acquisitionRetention$acquisition
for(val in unique(weight.cases)) {weight.cases[weight.cases==val]=
    1/sum(weight.cases==val)*length(weight.cases)/2} # normalized to sum to length(samples)

set.seed(2018)
(Ch05pr.AR <- train(factor(acquisition) ~ acq_exp + acq_exp_sq + industry + revenue + employees, 
                    metric = 'Kappa', weights = weight.cases, data = acquisitionRetention, 
                    method = "glm", family = binomial(link = uno)))#,

## Generalized Linear Model 
## 
## 500 samples
##   5 predictor
##   2 classes: '0', '1' 
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 500, 500, 500, 500, 500, 500, ... 
## Resampling results:
## 
##   Accuracy   Kappa    
##   0.8049093  0.5750277

                  # trControl = trainControl(method = "none", number = 1)))
summary(Ch05pr.AR)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.6817  -0.3216   0.2194   0.6199   2.4821  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -8.930e+00  8.103e-01 -11.020  < 2e-16 ***
## acq_exp      1.787e-02  2.407e-03   7.425 1.13e-13 ***
## acq_exp_sq  -1.797e-05  2.398e-06  -7.491 6.82e-14 ***
## industry     1.263e+00  1.613e-01   7.830 4.89e-15 ***
## revenue      4.222e-02  7.936e-03   5.320 1.04e-07 ***
## employees    4.513e-03  4.269e-04  10.571  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 693.15  on 499  degrees of freedom
## Residual deviance: 376.70  on 494  degrees of freedom
## AIC: 511.22
## 
## Number of Fisher Scoring iterations: 6

# Odds Ratio Estimates and 95% CI
writeLines("\n Odds Ratio Estimates and 95% CI")

## 
##  Odds Ratio Estimates and 95% CI

car::Confint(Ch05pr.AR$finalModel) %>%
  exp() %>%
    arm::pfround(digits = 3)

##             Estimate 2.5 % 97.5 %
## (Intercept) 0.000    0.000 0.001 
## acq_exp     1.018    1.013 1.023 
## acq_exp_sq  1.000    1.000 1.000 
## industry    3.537    2.583 4.911 
## revenue     1.043    1.027 1.060 
## employees   1.005    1.004 1.005

# Logistic regression diagnostics
writeLines("\n Wald test of predictors")

## 
##  Wald test of predictors

car::Anova(Ch05pr.AR$finalModel, type="II", test="Wald")

## Analysis of Deviance Table (Type II tests)
## 
## Response: .outcome
##            Df   Chisq Pr(>Chisq)    
## acq_exp     1  55.125  1.131e-13 ***
## acq_exp_sq  1  56.120  6.817e-14 ***
## industry    1  61.304  4.890e-15 ***
## revenue     1  28.299  1.040e-07 ***
## employees   1 111.755  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

writeLines("\n Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others")

## 
##  Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others

car::vif(Ch05pr.AR$finalModel) # Variance Inflation Factors - if vif() > 2  - feature has multicollinearity

##    acq_exp acq_exp_sq   industry    revenue  employees 
##  29.056887  29.088109   1.169996   1.043422   1.205157

writeLines("\n Variable Importance for Model \n")

## 
##  Variable Importance for Model

caret::varImp(Ch05pr.AR) %>% .$importance %>% print.AsIs()

##              Overall
## acq_exp     40.08159
## acq_exp_sq  41.35164
## industry    47.79463
## revenue      0.00000
## employees  100.00000

# Create the scatter plots Probit versus model predictors
set.seed(2018)
predictors <- Ch05pr.AR$coefnames
Ch05pr.AR$trainingData %>%
  dplyr::select(one_of(predictors)) %>%
    mutate(link = predict(Ch05pr.AR$finalModel, newdata = acquisitionRetention, type = "link")) %>%
      gather(key = "predictors", value = "predictor.value", -link) %>%
        ggplot(aes(predictor.value, link))+
          geom_point(size = 0.05, alpha = 0.05) +
          geom_smooth(method = "loess") +
          facet_wrap(~ predictors, scales = "free_x") +
          ylab(stringr::str_to_title(uno))

# Plot matrix of statistical model diagnostics
GGally::ggnostic(Ch05pr.AR$finalModel, title = paste(paste(formula(Ch05pr.AR)[c(2, 1, 3)], collapse = " ")))

## `geom_smooth()` using method = 'loess'
## `geom_smooth()` using method = 'loess'
## `geom_smooth()` using method = 'loess'
## `geom_smooth()` using method = 'loess'
## `geom_smooth()` using method = 'loess'

# wide variety of diagnostic plots for checking the quality of regression fit
# https://bookdown.org/jefftemplewebb/IS-6489/logistic-regression.html
car::influenceIndexPlot(Ch05pr.AR$finalModel)

writeLines("\n Improved Probit Model: Association of Predicted Probabilities and Observed Responses \n")

## 
##  Improved Probit Model: Association of Predicted Probabilities and Observed Responses

caret::confusionMatrix(data = predict(Ch05pr.AR, newdata = acquisitionRetention),
                       reference = acquisitionRetention$acquisition %>% factor,
                       positive = "1", mode = "everything")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 131  65
##          1  31 273
##                                           
##                Accuracy : 0.808           
##                  95% CI : (0.7707, 0.8416)
##     No Information Rate : 0.676           
##     P-Value [Acc > NIR] : 2.928e-11       
##                                           
##                   Kappa : 0.5844          
##  Mcnemar's Test P-Value : 0.000757        
##                                           
##             Sensitivity : 0.8077          
##             Specificity : 0.8086          
##          Pos Pred Value : 0.8980          
##          Neg Pred Value : 0.6684          
##               Precision : 0.8980          
##                  Recall : 0.8077          
##                      F1 : 0.8505          
##              Prevalence : 0.6760          
##          Detection Rate : 0.5460          
##    Detection Prevalence : 0.6080          
##       Balanced Accuracy : 0.8082          
##                                           
##        'Positive' Class : 1               
## 

qplot(`Observed Classes`, `Predicted Classes`, 
      data=bind_cols(`Observed Classes`= factor(acquisitionRetention$acquisition),
                     `Predicted Classes` = predict(Ch05pr.AR, newdata = acquisitionRetention)),  
      colour= `Observed Classes`, geom = c("boxplot", "jitter"),
      main = "Predicted Classes vs. Observed Classes", xlab = "Observed Classes", ylab = "Predicted Classes")

Улучшенная пробит-регрессия вероятности повторной покупки немного улучшила качество модели за счет корректных весов бинарного класса (“Kappa” = 0.5844). Именно по этой причине повысилась специфичность (англ. “Specificity”), которая описывает успешность распознавания случаев отказа от привлечения (\(z_{i} = 0\)), которых относительно мало в используемом наборе данных. Кроме того, модель построена бутстреп-методом, обеспечивающего устойчивость модели.

Как это использовать?

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

Второй этап эмпирического примера: модель продолжительности сотрудничества с клиентом

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

\[E(Duration) = P(Acquisition = 1) * E(Duration \enspace | \enspace Acquisition = 1)\]

Это уравнение показывает, что ожидаемая продолжительность зависит от вероятности приобретения перспективного клиента, умноженной на ожидаемое значение продолжительности, учитывая, что такой клиенты был привлечен. Если бы авторы просто строили регрессию с Duration как зависимую переменную и игнорировали вероятность того, что клиент совершит покупку, то авторы получили бы смещенные оценки из-за возможного смещения выборки.

Систематическое смещение при формировании выборки (англ. “Samples Selection Bias”) является проблемой, которая распространена во многих маркетинговых задачах и должна быть статистически учтена во многих структурах моделирования. В этом случае у клиента есть выбор в отношении того, следует принять сотрудничестов с фирмой до принятия решения о продолжительности отношений. Если бы авторы проигнорировали этот выбор, они бы получили смещение оценки в модели, и у них были бы менее точные предсказания для значения Duration. Чтобы учесть эту проблему, мы должны иметь возможность прогнозировать значение как для вероятности привлечения (что авторами сделано на первом этапе этого примера), так и ожидаемое значение Duration, учитывая, что будет ли принято сотрудничество с фирмой. Чтобы учесть эту проблему, авторы использовали двухэтапную модель моделирования, аналогичную описанной ранее в этой главе.

\[ Duration = \gamma'\alpha + \mu \lambda + \varepsilon, \] где Duration - является значением продолжительности,

\(\gamma\) - матрица переменных, используемой для объяснения значения Duration,

\(\alpha\) - коэффициенты для независимых переменных,

\(\mu\) - коэффициент обратного отношения Миллса (получен на первом этапе),

\(\lambda\) - обратное отношение Миллса,

а \(\varepsilon\) - случайные ошибки линейной регрессии.

Таким образом, для этого примера авторы использовали следующий список переменных:

Переменные	Описание
Зависимая переменная
Duration	Время в днях, когда компании была или продолжает быть клиентом, цензуированная до 730 дней
Предикторы
Ret_Exp	Долларовые расходы на маркетинг по удержание клиента
Ret_Exp_SQ	Квадрат расходов на удержание
Freq	Количество покупок клиента во время окна наблюдения
Freq_SQ	Квадрат количества покупок
Crossbuy	Количество категорий товаров / услуг, приобретенных клиентом
Share-of-Wallet (SOW)	Процент покупок клиента от данной фирмы, учитывая общий объем покупок по всем фирмам в этой категории
Lambda (\(\lambda\))	Рассчитанное обратное отношение Миллса из модели привлечения клиента

# Fit Linear Regression Model for Duration by Authors
# https://stats.idre.ucla.edu/sas/webbooks/reg/

# Acquisition Probability
# SAS Code: imr_acq = (pdf(’Normal’, xb_probit)) / (probnorm(xb_probit));
xbeta <- predict(Ch05.probit, newdata = acquisitionRetention, type = "link")
acquisitionRetention <- acquisitionRetention %>% 
  mutate(imr_acq = dnorm(xbeta) / pnorm(xbeta)) #  Cumulative normal pdf
    
(Ch05.linear <- lm(duration ~ ret_exp + ret_exp_sq + freq + freq_sq + crossbuy + sow + imr_acq,
                   data = filter(acquisitionRetention, acquisition == 1) )) %>%
  summary

## 
## Call:
## lm(formula = duration ~ ret_exp + ret_exp_sq + freq + freq_sq + 
##     crossbuy + sow + imr_acq, data = filter(acquisitionRetention, 
##     acquisition == 1))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -47.968 -11.644  -0.584  12.434  50.964 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  9.101e+01  9.756e+00   9.329  < 2e-16 ***
## ret_exp      2.528e+00  2.929e-02  86.311  < 2e-16 ***
## ret_exp_sq  -1.018e-03  2.424e-05 -42.019  < 2e-16 ***
## freq         7.072e+00  8.060e-01   8.775  < 2e-16 ***
## freq_sq     -8.419e-01  4.031e-02 -20.887  < 2e-16 ***
## crossbuy     3.196e+00  4.793e-01   6.668 1.09e-10 ***
## sow          3.529e-01  4.545e-02   7.764 1.05e-13 ***
## imr_acq      2.952e+01  2.557e+00  11.546  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 17.11 on 330 degrees of freedom
## Multiple R-squared:  0.9939, Adjusted R-squared:  0.9938 
## F-statistic:  7674 on 7 and 330 DF,  p-value: < 2.2e-16

writeLines("Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others")

## Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others

car::vif(Ch05.linear) # Variance Inflation Factors - if vif() > 2 - feature has multicollinearity 

##    ret_exp ret_exp_sq       freq    freq_sq   crossbuy        sow    imr_acq 
##  24.516242  24.566033  13.332178  13.414255   1.027828   1.005437   1.027490

Видно, что в авторской модели коэффициент \(\lambda\) является положительным и значительным. Это можно интерпретировать так, что существует потенциальная проблема смещения выбора, поскольку коэффициент ошибки авторского уравнения выбора положительно коррелирует с погрешностью нашего уравнения регрессии. Мы также видим, что многие предикторы модели продолжительности положительны и все значимы, что означает, что авторы, вероятно, включили в модель важные драйверов продолжительности сотрудничества с фирмой.

Правда, тут проявляется еще одно смещение. Ведь чем дольше продолжительность, тем и больше собирается покупок и значит растет частота Freq. Думаю, что надо подвести этут частоту и другие показатели к одному знаменателю, т.е в среднем на 1 месяц сотрудничества.

# Computing the Mean Absolute Deviation (MAD)

with(acquisitionRetention, {
  # Inverse Mills Ratio (lambda)
  pred_dr <- predict(Ch05.probit, newdata = acquisitionRetention, type = "link") %>% pnorm() *
               predict(Ch05.linear, newdata = acquisitionRetention)
  
  # mean_duration
  writeLines(sprintf("Mean of Duration: %.2f дней", mean(duration)))
  
  # mad = abs(duration - pred_dur);
  writeLines(sprintf("Mean Absolute Deviation (MAD): %.2f дней", mean(abs(duration - pred_dr))))
  
  # mad1 = mean(abs(duration - mean(duration));
  mad1 <- mean(abs(duration - mean(duration)))
  writeLines(sprintf("Naive Mean Absolute Deviation (MAD1): %.2f дней", mad1))
  })

## Mean of Duration: 742.45 дней
## Mean Absolute Deviation (MAD): 143.86 дней
## Naive Mean Absolute Deviation (MAD1): 484.09 дней

Средняя абсолютная ошибка для всех клиентов MAD составляет по авторской модели 143.86. Это означает, что в среднем каждый из прогнозов Duration отклоняется от фактического значения примерно на это число дней. Если бы вместо этой модели применяли среднее значение Duration для всех клиентов (742 дней) в качестве наивного прогноза для всех потенциальных клиентов, то MAD1 = 484дней. Очевидно, что авторская модель значительно улучшает работу по прогнозированию продолжительности взаимоотношений с клиентами, чем к наивная.

Как это использовать?

Коэффициент в модели по предиктору Ret_Exp связан с уменьшающейся доходностью, что отмечено положительным коэффициентом на Ret_Exp и отрицательным коэффициентом на Ret_Exp_SQ. Это означает, что маркетинговые усилия по сохранению и построению отношений с клиентом заставляют клиента оставаться дольше в отношениях до какого-то момента. Затем, после достижения порога, маркетинговые усилия фактически уменьшают продолжительность продолжительности отношений в среднем. Вероятно, это связано с тем, что чрезмерное общение с клиентами может часто напрягать отношения между клиентом и фирмой. Авторы находим, что Freq также положителен с уменьшающийся доходностью, что отмечено положительным коэффициентом на Freq и отрицательным коэффициентом на Freq_SQ. Это означает, что клиенты, которые покупают умеренное количество раз, вероятно, будут иметь самые длительные отношения с фирмой. И клиенты, которые приобретают реже (или очень часто), с большей вероятностью покинут отношения раньше. Авторы считали, что коэффициент на Crossbuy положительный, предполагая, что клиенты, которые приобретают различные категории, с большей вероятностью останутся в отношениях с фирмой дольше. Наконец, авторы нашли коэффициент на SOW положительным, предполагая, что клиенты, которые покупают больший процент своего бюджета для определенного набора предметов в фокальном магазине, чаще имеют более длительные отношения.

Третий этап эмпирического этапа: модель кумулятивной рентабельности

Третий этап этого процесса - оценить модель кумулятивной рентабельности. Цель этой модели - понять драйверы, описывающие ожидаемое значение CLV (англ. “Customer Lifetime Value”) или Пожизненная финансовая ценность клиента. Таким образом, уравнение принимает следующий формат:

\[E(Profit) = P(Acquisition = 1) * E(Profit \enspace | \enspace Acquisition = 1, \enspace E(Duration) )\]

Это уравнение показывает нам, что ожидаемая продолжительность зависит от вероятности приобретения перспективного клиента, умноженной на ожидаемую величину прибыли, с учетом того, что был привлечен клиент, и предполагаемой продолжительности отношений клиента с фирмой. Опять же, если авторы просто создавали регрессионную модель кумулятивной рентабельность как зависимую переменную и игнорировали вероятность того, что клиент совершит покупку и расчетную продолжительность, то можно получить смещенные оценки из-за возможного смещения выборки.

Наконец, авторы хотят оценить модель регрессии для Profit и включить переменные \(\lambda\) и E(Duration) в качестве дополнительных независимых переменных. Это делается простым способом, используя следующее уравнение:

\[ Profit = \gamma ' \alpha + \mu \lambda + \rho \textit{Durâtion} + \varepsilon \] В этом случае Profit - это значение прибыли,

\(\gamma\) - матрица переменных, используемая для объяснения значений Profit,

\(\alpha\) - коэффициенты для независимых переменных,

\(\mu\) - коэффициент обратного отношения Миллса,

\(\lambda\) - обратные Mills отношение,

\(\rho\) - коэффициент ожидаемой продолжительности,

\(\textit{Durâtion}\) - ожидаемая продолжительность,

\(\varepsilon\) - коэффициент ошибки.

Таким образом, для этого примера мы будем использовать следующий список переменных:

Переменные	Описание
Зависимая переменная
Profit	CLV - Прогноз пожизненной ценности клиента. Это -(Acq_Expense), если клиента не привлекли (’000)
Предикторы
Acq_Exp	Долларовые расходы на маркетинг по привлечению клиента
Acq_Exp_SQ	Квадрат расходов на привлечение
Ret_Exp	Долларовые расходы на маркетинг по удержание клиента
Ret_Exp_SQ	Квадрат расходов на удержание
Freq	Количество покупок клиента во время окна наблюдения
Freq_SQ	Квадрат количества покупок
Crossbuy	Количество категорий товаров / услуг, приобретенных клиентом
SOW	Процент покупок клиента от данной фирмы, учитывая общий объем покупок по всем фирмам в этой категории
Lambda (\(\lambda\))	Рассчитанное обратное отношение Миллса из модели повторного заказа клиента
Duration	Время в днях, когда компании была или продолжает быть клиентом, 0 если (Acquisition = 1)

Когда авторы оценивали третий этап модели, получаем следующие оценки параметров (оценки параметров для модели привлечения подробно описаны в первой части этого примера, а оценки параметров модели длительности подробно изложены во второй части):

# Fit Linear Regression Model for Profit by Authors
# https://stats.idre.ucla.edu/sas/webbooks/reg/

# Duration Probability
# SAS Code: pred_dur = probnorm(xb_probit)*(xbeta_duration);
xbeta <- predict(Ch05.probit, newdata = acquisitionRetention, type = "link")
acquisitionRetention <- acquisitionRetention %>% 
  mutate(pred_dur = pnorm(xbeta) * predict(Ch05.probit, newdata = acquisitionRetention, type = "link") %>%
           pnorm() * predict(Ch05.linear, newdata = acquisitionRetention)) #  Prediction of Duration

(Ch05.profit <- lm(profit ~ acq_exp + acq_exp_sq + ret_exp + ret_exp_sq + freq + freq_sq + crossbuy +
                     sow + imr_acq + pred_dur,
                   data = filter(acquisitionRetention, acquisition == 1) )) %>%
  summary

## 
## Call:
## lm(formula = profit ~ acq_exp + acq_exp_sq + ret_exp + ret_exp_sq + 
##     freq + freq_sq + crossbuy + sow + imr_acq + pred_dur, data = filter(acquisitionRetention, 
##     acquisition == 1))
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -166.796  -34.040   -0.259   41.213  137.194 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.633e+01  4.425e+01   0.369  0.71228    
## acq_exp      3.361e+00  1.233e-01  27.270  < 2e-16 ***
## acq_exp_sq  -1.264e-03  1.226e-04 -10.305  < 2e-16 ***
## ret_exp      4.213e+00  1.199e-01  35.143  < 2e-16 ***
## ret_exp_sq  -8.269e-04  8.496e-05  -9.732  < 2e-16 ***
## freq         2.028e+01  2.552e+00   7.948 3.11e-14 ***
## freq_sq     -1.533e+00  1.284e-01 -11.942  < 2e-16 ***
## crossbuy     1.885e+01  1.520e+00  12.402  < 2e-16 ***
## sow          2.002e+00  1.473e-01  13.590  < 2e-16 ***
## imr_acq      9.673e+01  3.118e+01   3.102  0.00209 ** 
## pred_dur     3.640e-01  3.417e-02  10.653  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 54.06 on 327 degrees of freedom
## Multiple R-squared:  0.9934, Adjusted R-squared:  0.9932 
## F-statistic:  4958 on 10 and 327 DF,  p-value: < 2.2e-16

writeLines("Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others")

## Variance Inflation Factors - if vif() > 2  - feature has multicollinearity with others

car::vif(Ch05.profit) # Variance Inflation Factors - if vif() > 2 - feature has multicollinearity 

##    acq_exp acq_exp_sq    ret_exp ret_exp_sq       freq    freq_sq   crossbuy        sow    imr_acq   pred_dur 
##  33.014197  33.006941  41.151601  30.247898  13.392512  13.639288   1.035596   1.058833  15.319432  17.051179

Полученная авторами линейная модель, показала, что коэфициент \(\lambda\) является положительным и значимым. Авторы интерпретировали это как сигнал о потенциальной проблеме смещения выборки, поскольку коэффициент ошибки нашего уравнения выбора положительно коррелирует с погрешностью данного уравнения регрессии. Также видно, что все другие переменные модели прибыли являются значительными, что означает, что, вероятно, обнаружили многие из драйверов CLV.

Как это использовать?

Авторы нашли, что коэффициент Acq_Exp положительно связан с убывающей доходностью, что отмечено положительным коэффициентом на Acq_Exp и отрицательным коэффициентом на Acq_Exp_SQ. Это означает, что маркетинговые усилия по приобретению потенциальных клиентов способны сделать клиента более прибыльным, но до определенного порога. Затем, после достижения порога, маркетинговые усилия по приобретению фактически снижают прибыльность клиента в среднем. Это связано с тем, что после определенной суммы расходов на приобретение нет никакой дополнительной выгоды. Также Ret_Exp положительно связан с убывающей доходностью, как проявляется положительным коэффициентом на Ret_Exp и отрицательным коэффициентом на Ret_Exp_SQ. Это означает, что маркетинговые усилия, направленные на сохранение и построение отношений с клиентом, также способны сделать клиента более прибыльным. Затем, после достижения порога, маркетинговые усилия по удержанию фактически снижают рентабельность в среднем. То же самое можно сказать о Freq.

Авторы посчитали, что положительный коэффициент Crossbuy говорит о том, что клиенты, которые приобретают разнобразные категории, с большей вероятностью будут прибыльными. Также положительный коэффициент на SOW положительным, предполагая, что клиенты, которые покупают больший процент своего бюджета для определенного набора предметов в фирменном магазине, с большей вероятностью будут прибыльными. Наконец, коэффициент ожидаемой продолжительности (Duration) оказался положительным, поэтому клиенты, которые находятся в отношениях с фирмой дольше, более склонны к прибыльности.

Оценка качества модели

Наш следующий шаг - предсказать значение Profit, чтобы увидеть, насколько наша модель согласуется с фактическими значениями. Авторы делали это, начиная с уравнения ожидаемой прибыли в начале этого примера:

\[ Profit = E(Profit) = P(Acquisition = 1) * E(Profit \enspace | \enspace Acquisition = 1, \enspace E(Duration) )\] \[ = \Phi(X' \beta) * ( \gamma ' \alpha + \mu \lambda + \rho \textit{Durâtion} + \varepsilon ). \]

В этом случае \(\Phi\) является функция кумулятивная вероятности нормального распределения (CDF),

\(X'\) является матрицей независимых значений переменных из модели привлечения,

\(\beta\) - вектор оценок параметров из модели привлечения,

\(\gamma\) - матрица переменных, используемая для объяснения значений Profit,

\(\alpha\) - коэффициенты для независимых переменных,

\(\mu\) - коэффициент обратного отношения Миллса,

\(\lambda\) - обратные Mills отношение,

\(\rho\) - коэффициент ожидаемой продолжительности,

\(\textit{Durâtion}\) - ожидаемая продолжительность,

\(\varepsilon\) - коэффициент ошибки.

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

# Computing the Mean Absolute Deviation (MAD)

with(acquisitionRetention, {
  # Inverse Mills Ratio (lambda)
  pred_profit <- predict(Ch05.probit, newdata = acquisitionRetention, type = "link") %>% pnorm() *
               predict(Ch05.profit, newdata = acquisitionRetention)
  
  # mean_profit
  writeLines(sprintf("Mean of Profit: %.2f долл.", mean(profit)))
  
  # mad = mean(abs(profit - pred_profit));
  writeLines(sprintf("Mean Absolute Deviation (MAD): %.2f долл.", mean(abs(profit - pred_profit))))

  # mad1 = mean(abs(profit - mean(profit));
  mad1 <- mean(abs(profit - mean(profit)))
  writeLines(sprintf("Naive Mean Absolute Deviation (MAD1): %.2f долл.", mad1))
  })

## Mean of Profit: 2403.84 долл.
## Mean Absolute Deviation (MAD): 750.19 долл.
## Naive Mean Absolute Deviation (MAD1): 1881.40 долл.

Если бы мы вместо этого использовали среднее значение Profit (2403.84 долл.) для всех клиентов в качестве нашего прогноза (это было бы примерной наивной моделью), мы бы обнаружили, что MAD = 1881.40, или 1881.40 долл. Как мы видим, построенная линейная модель (MAD = 750.19 долл.) значительно лучше прогнозирует ожидаемую рентабельность клиентов, чем к наивная средняя.

Оптимальное распределение ресурсов

Конечная задача авторов - посмотреть, какова будет потенциальная рентабельность, если мы хотим, чтобы ресурсы, потраченные на приобретение (acq_exp) и сохранение (ret_exp) менялась. Для этого нам нужно взять результаты первых трех шагов этого примера и смоделировать различные потенциальные результаты на основе набора ограничений. Для начала авторы задают целевую функцию, которую хотят максимизировать. Для этого примера будет применено четыре сценария. Авторы изменяют среднюю сумму, которую потратя на приобретение и удержание на основе этих желаемых результатов:

1. Максимизация уровня привлечения для всех клиентов, учитывая текущий маркетинговый бюджет.

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

3. Максимизация общей прибыли для всех клиентов, учитывая текущий маркетинговый бюджет.

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

Для простоты в каждом случае авторы сохраняют средние значения других переменных (вне затрат на приобретение и затраты на удержание) едиными во время упражнения. Затем сравниваем результаты упражнений по оптимизации с текущим сценарием, чтобы увидеть, где сделаны улучшения и как изменились распределения, чтобы получить эти улучшения. Текущий уровень потенциальных переменных результатов и затраты на приобретение и удержание по мнению авторов следующие:

	E(Profit)	E(Duration)	E(Acq. %)	Acq_Exp	Ret_Exp	Total expense
Current	$1.166 млн	1098 дней	67.60%	$493.35	$497.43	$415 000

В этом случае E(Profit) представляет собой ожидаемую общую прибыль по всем потенциальным и реальным клиентам, E (Duration) представляет собой среднюю ожидаемую продолжительность, учитывая, что потенциальный клиент становится реальным клиентом, E (Acq.%) - ожидаемая скорость привлечения, или E ( Число привлеченных клиентов ) / 500, Acq_Exp - это средний расход на приобретение всех потенциальных клиентов, Ret_Exp - это ожидаемые затраты на удержание всех приобретенных клиентов, а суммарные расходы - общая сумма, потраченная на потенциальных клиентов и клиентов.

# Parametrs for Optimization Models by MS Excel file from Authors
# see Data Files - http://b-ok.org/book/3242926/c35c9a
Params <- list(
  Freq = mean(acquisitionRetention[acquisitionRetention$acquisition == 1, "freq"]),          # W12
  Freq_SQ = mean(acquisitionRetention[acquisitionRetention$acquisition == 1, "freq"])^2,     # X12
  Crossbuy = mean(acquisitionRetention[acquisitionRetention$acquisition == 1, "crossbuy"]),  # Y12
  SOW = mean(acquisitionRetention[acquisitionRetention$acquisition == 1, "sow"]),            # Z12
  Industry = mean(acquisitionRetention$industry),                                            # AA12
  Revenue = mean(acquisitionRetention$revenue),                                              # AB12
  Employees = mean(acquisitionRetention$employees)                                           # AC12
)

# f_xb_acq0 <- function(x) { # AB15 - by SAS
#   -8.2554 + 0.0173 * x - 0.00002 * (x^2) +
#             1.2167 * Params$Industry + 0.0425 * Params$Revenue + 0.00432 * Params$Employees
# }

f_xb_acq <- function(x) { # by R
    coef(Ch05.probit)[1] + coef(Ch05.probit)["acq_exp"] * x +
  # coef(Ch05.probit)["acq_exp_sq"] only 5 digits after a decimal point as at modeling of Authors of the book
    round(coef(Ch05.probit)["acq_exp_sq"], digits = 5) * (x^2) + coef(Ch05.probit)["industry"] * Params$Industry +
      coef(Ch05.probit)["revenue"] * Params$Revenue + coef(Ch05.probit)["employees"] * Params$Employees
  }

f_Lambda <- function(x) { # AA15
  ((1 / sqrt(2 * pi) * exp(-1 * (x^2) / 2))) / pnorm(x)
}

f_Pred_Acq_Procent <- function(x) { # X21
    pnorm(x)
}

f_Pred_Acq_Procent1 <- function(x) { # X21
    pnorm( f_xb_acq(x) )
}

# f_Pred_Duration0 <- function(x, y) { # Y21 - by SAS
#   pnorm(f_xb_acq(x)) * (91.00828 + 2.52829 * y - 0.00102 * y^2 + 
#       7.07247 * Params$Freq - 0.84187 * Params$Freq_SQ + 3.19638 * Params$Crossbuy + 0.35287 * Params$SOW +
#         29.51954 * f_Lambda(f_xb_acq(x)))
# }

f_Pred_Duration <- function(x, y) { # by R
  pnorm(f_xb_acq(x)) * (coef(Ch05.linear)[1] + coef(Ch05.linear)[2] * y + coef(Ch05.linear)[3] * y^2 + 
      coef(Ch05.linear)[4] * Params$Freq + coef(Ch05.linear)[5] * Params$Freq_SQ + 
        coef(Ch05.linear)[6] * Params$Crossbuy + coef(Ch05.linear)[7] * Params$SOW + 
          coef(Ch05.linear)[8] * f_Lambda(f_xb_acq(x)))
}

f_Pred_Duration1 <- function(x) { # by R
  y = (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - x * nrow(acquisitionRetention)) /
    ((x %>% f_xb_acq %>% pnorm) * nrow(acquisitionRetention))
  pnorm(f_xb_acq(x)) * (coef(Ch05.linear)[1] + coef(Ch05.linear)[2] * y + coef(Ch05.linear)[3] * y^2 + 
      coef(Ch05.linear)[4] * Params$Freq + coef(Ch05.linear)[5] * Params$Freq_SQ + 
        coef(Ch05.linear)[6] * Params$Crossbuy + coef(Ch05.linear)[7] * Params$SOW + 
          coef(Ch05.linear)[8] * f_Lambda(f_xb_acq(x)))
}

# f_Pred_Profit0 <- function(x, y) { # W21 - by SAS
#   pnorm( f_xb_acq(x) ) *(7.03798 + 3.34409 * x - 0.00126 * x^2 + 3.84649 * y - 0.00066891 * y^2 +
#     17.81953 * Params$Freq - 1.34911 * Params$Freq_SQ + 18.18908 * Params$Crossbuy + 2.07463 * Params$SOW +
#       107.5857 * f_Lambda(f_xb_acq(x)) + 0.49555 * f_Pred_Duration(x, y)) * 500
# }

f_Pred_Profit <- function(x, y) { # W21
  pnorm( f_xb_acq(x) ) *(coef(Ch05.profit)[1] + coef(Ch05.profit)["acq_exp"] * x + 
    coef(Ch05.profit)["acq_exp_sq"] * x^2 + coef(Ch05.profit)["ret_exp"] * y + 
      coef(Ch05.profit)["ret_exp_sq"] * y^2 + coef(Ch05.profit)["freq"] * Params$Freq +
        coef(Ch05.profit)["freq_sq"] * Params$Freq_SQ + coef(Ch05.profit)["crossbuy"] * Params$Crossbuy +
          coef(Ch05.profit)["sow"] * Params$SOW + coef(Ch05.profit)["imr_acq"] * f_Lambda(f_xb_acq(x)) + 
            coef(Ch05.profit)["pred_dur"] * f_Pred_Duration(x, y)) * nrow(acquisitionRetention)
}

f_Pred_Profit1 <- function(x) { # W21
  y = (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - x * nrow(acquisitionRetention)) /
    ((x %>% f_xb_acq %>% pnorm) * nrow(acquisitionRetention))

  pnorm( f_xb_acq(x) ) *(coef(Ch05.profit)[1] + coef(Ch05.profit)["acq_exp"] * x + 
    coef(Ch05.profit)["acq_exp_sq"] * x^2 + coef(Ch05.profit)["ret_exp"] * y + 
      coef(Ch05.profit)["ret_exp_sq"] * y^2 + coef(Ch05.profit)["freq"] * Params$Freq +
        coef(Ch05.profit)["freq_sq"] * Params$Freq_SQ + coef(Ch05.profit)["crossbuy"] * Params$Crossbuy +
          coef(Ch05.profit)["sow"] * Params$SOW + coef(Ch05.profit)["imr_acq"] * f_Lambda(f_xb_acq(x)) + 
            coef(Ch05.profit)["pred_dur"] * f_Pred_Duration(x, y)) * nrow(acquisitionRetention)
}

# Optimization of Acquisition Probability (to maximize) with the Limit on the Marketing Budget
Pred_Acq_Opt <- optim(par = 1, fn = f_Pred_Acq_Procent1, # method = "L-BFGS-B", 
                      control = list(fnscale = -1))
writeLines(sprintf("Max Acquisition Probability (%.2f%%) at the Acquisition Expense per Client = $ %.2f so Profit = $ %.0f",               Pred_Acq_Opt$value * 100,               Pred_Acq_Opt$par,
f_Pred_Profit(Pred_Acq_Opt$par, (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - Pred_Acq_Opt$par * nrow(acquisitionRetention)) / (Pred_Acq_Opt$value * nrow(acquisitionRetention)))))

## Max Acquisition Probability (77.14%) at the Acquisition Expense per Client = $ 432.50 so Profit = $ 1478844

# Optimization of Duration (to maximize) with the Limit on the Marketing Budget
Pred_Dur_Opt <- optim(par = 1, fn = f_Pred_Duration1, method = "L-BFGS-B", 
                      control = list(fnscale = -1))
writeLines(sprintf("Max Duration (%.2f days) at the Acquisition Expense per Client = $ %.2f so Profit = $ %.0f",
                                          Pred_Dur_Opt$value,               Pred_Dur_Opt$par,
f_Pred_Profit(Pred_Dur_Opt$par, (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - Pred_Dur_Opt$par * nrow(acquisitionRetention)) / (f_Pred_Acq_Procent(f_xb_acq(Pred_Dur_Opt$par)) * nrow(acquisitionRetention)))))

## Max Duration (1000.01 days) at the Acquisition Expense per Client = $ 321.73 so Profit = $ 1490679

# Optimization of Profit (to maximize) with the Limit on the Marketing Budget
Pred_Prf_Opt <- optim(par = 493.351, fn = f_Pred_Profit1, method = "L-BFGS-B",
                      control = list(fnscale = -1))
writeLines(sprintf("Max Profit ($ %.0f) at the Acquisition Expense per Client = $ %.2f",
                                          Pred_Prf_Opt$value,               Pred_Prf_Opt$par))

## Max Profit ($ 1512018) at the Acquisition Expense per Client = $ 368.74

# Check it The Maximal Profit
# f_Pred_Profit(Pred_Prf_Opt$par, (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - Pred_Prf_Opt$par * nrow(acquisitionRetention)) / ((Pred_Prf_Opt$par %>% f_xb_acq %>% pnorm) * nrow(acquisitionRetention)))

##############################################################
# The Maximal Profit w/o Marketing Limit's Function
##############################################################
# define the function
f_Pred_Profit_wo_Limit <- function(x) {
# make x a matrix so this function works for plotting and for optimizing
  x <- matrix(x, ncol=2)
# calculate the function value for each row of x
  pnorm( f_xb_acq(x[,1]) ) *(coef(Ch05.profit)[1] + coef(Ch05.profit)["acq_exp"] * x[,1] +
    coef(Ch05.profit)["acq_exp_sq"] * x[,1]^2 + coef(Ch05.profit)["ret_exp"] * x[,2] +
      coef(Ch05.profit)["ret_exp_sq"] * x[,2]^2 + coef(Ch05.profit)["freq"] * Params$Freq +
        coef(Ch05.profit)["freq_sq"] * Params$Freq_SQ + coef(Ch05.profit)["crossbuy"] * Params$Crossbuy +
          coef(Ch05.profit)["sow"] * Params$SOW + coef(Ch05.profit)["imr_acq"] * f_Lambda(f_xb_acq(x[,1])) +
            coef(Ch05.profit)["pred_dur"] * f_Pred_Duration(x[,1], x[,2])) * nrow(acquisitionRetention)
}

# optimize (maximize) the function using Nelder-Mead (1965)
out.booth <- optim(c(1, 1), f_Pred_Profit_wo_Limit, method = "Nelder-Mead", control = list(fnscale = -1))

# # optimize (maximize) the function using Limited-memory quasi-Newton method by Broyden, Fletcher, Goldfarb & Shanno (1995)
# out.booth <- optim(c(1, 1), f_Pred_Profit_wo_Limit, method = "L-BFGS-B", control = list(fnscale = -1))

writeLines(sprintf("Max Profit w/o Limit ($ %.0f) at Acq_Exp per Client = $ %.2f & Ret_Exp per Client = $ %.2f",
                                          out.booth$value,         out.booth$par[1],         out.booth$par[2]))

## Max Profit w/o Limit ($ 2723667) at Acq_Exp per Client = $ 452.04 & Ret_Exp per Client = $ 2212.56

Для первых трех сценариев, которые авторы моделировали макисмальные значения, мы также попытаемся максимизировать три зависимые переменные (Profit, Duration, and Acquisition) для всех потенциальных и реальных клиентов, учитывая следующие ограничения. Во-первых, объем расходов на привлечение и удержание должен быть положительным (т. е. нельзя тратить отрицательную сумму денег на любую деятельность). Во-вторых, общая сумма, затраченная на приобретение и удержание, не может превышать текущий бюджет в размере 414 806 долл. В-третьих, продолжительность любых отношений с клиентами не может быть отрицательной (это концептуально важно, поскольку мы используем ожидаемую продолжительность, то предсказание продолжительности может стать отрицательный, если переменные привлечения и удержания изменяются слишком резко). Кроме того, для первого сценария, когда требуется максимизировать коэффициент привлечения клиентов, поскольку эта ставка напрямую не влияет на длительность продолжительности сотрудничества клиента с фирмой, предполагается, что фирма распределяет все оставшиеся ресурсы, которые не желательны для усилий по привлечению, для усилий по удержанию (так что сумма всех расходов по-прежнему 414 806 долл.). Для последнего сценария единственное изменение наших ограничений состоит в том, чтобы ослабить бюджетные ограничения и позволить фирме тратить неограниченное количество денег на привлечение и удержанию.

Обращаем внимание, что авторы книги производили все моделирования все SAS, так как это им показалось сделать легче и понятнее в MS Excel. Однако я воспользовался встроенными в R возможностями по оптимизации (функция optim). И только в случае пробит-модели привлечения я оставил у коэффициента Acq_ext_sq только пять значащих цифр после десятичной точки, поскольку именно так делали при моделировании авторы книги. В итоге моделирования были получены следующие результаты, которые отличаются от приведенные в книге:

# Dataset with the Limit on the Marketing Budget
acqRet.df <- data.frame(Acq_Exp_Share = seq(from = 0.204, to = 0.99, by = 0.001),
                        Spend = sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp)) %>% 
    mutate(Acq_Exp = Spend * Acq_Exp_Share / nrow(acquisitionRetention)) %>%
      mutate(Acq_Rate = Acq_Exp %>% f_xb_acq %>% pnorm) %>% 
        mutate(Ret_Exp = Spend * (1 - Acq_Exp_Share) / (Acq_Rate * nrow(acquisitionRetention))) %>%
          mutate(Duration = f_Pred_Duration(Acq_Exp, Ret_Exp)) %>% 
            mutate(Profit = f_Pred_Profit(Acq_Exp, Ret_Exp)) # %>% 
              # dplyr::select(Profit, Duration, Acq_Exp_Share, Acq_Rate, Acq_Exp, Ret_Exp, Spend)

y_0 <- sum(acquisitionRetention$ret_exp) / sum(acquisitionRetention$acquisition)
y_1 <- (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - Pred_Acq_Opt$par *
          nrow(acquisitionRetention)) / ((Pred_Acq_Opt$par %>% f_xb_acq %>% pnorm) * nrow(acquisitionRetention)) 
y_2 <- (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - Pred_Prf_Opt$par *
          nrow(acquisitionRetention)) / ((Pred_Prf_Opt$par %>% f_xb_acq %>% pnorm) * nrow(acquisitionRetention))
y_3 <- (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) - Pred_Dur_Opt$par *
          nrow(acquisitionRetention)) / ((Pred_Dur_Opt$par %>% f_xb_acq %>% pnorm) * nrow(acquisitionRetention))

# Data set of Real data and model optimization results
acqRetExt.df <- bind_rows(
    data.frame(Acq_Exp = mean(acquisitionRetention$acq_exp), Ret_Exp = y_0,
               Spend = sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp),
               Acq_Rate = (sum(acquisitionRetention$acq_exp, acquisitionRetention$ret_exp) -
        mean(acquisitionRetention$acq_exp) * nrow(acquisitionRetention)) / (y_0 * nrow(acquisitionRetention)),
               Profit = sum(acquisitionRetention$profit), 
               Duration = mean(acquisitionRetention[acquisitionRetention$acquisition == 1, "duration"])),
    data.frame(Acq_Exp = c(Pred_Acq_Opt$par, Pred_Dur_Opt$par, Pred_Prf_Opt$par, out.booth$par[1]),
               Ret_Exp = c(y_1, y_3, y_2, out.booth$par[2])) %>% 
        mutate(Acq_Rate = (Acq_Exp %>% f_xb_acq %>% pnorm),
               Spend = Acq_Exp * nrow(acquisitionRetention) + Ret_Exp * nrow(acquisitionRetention) * Acq_Rate,
               Duration = f_Pred_Duration(Acq_Exp, Ret_Exp),
               Profit = f_Pred_Profit(Acq_Exp, Ret_Exp))) %>%
    dplyr::select(Profit, Duration, Acq_Rate, Acq_Exp, Ret_Exp, Spend) 
row.names(acqRetExt.df) <- c("The Current Profit by the Real Data", "The Profit by the Maximal Acquisition Rate", 
                             "The Profit by the Maximal Duration", "The Maximal Profit with the Limit",
                             "The Maximal Profit without the Limit")

knitr::kable(acqRetExt.df, format = "html", digits = c(0,0,4,2,2,0), longtable = TRUE, booktabs = TRUE, escape = F,
             col.names = c("Total Profit, $", "Duration, Days", "Acquisition Rate, %",
                       "Acquisition Expense per Client, $", "Retention Expense per Client, $", "Total Expense, $"),
             caption="Real data and Optimization Model Results") %>% 
kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive", full_width = FALSE))

Real data and Optimization Model Results

	Total Profit, $	Duration, Days	Acquisition Rate, %	Acquisition Expense per Client, $	Retention Expense per Client, $	Total Expense, $
The Current Profit by the Real Data	1201921	1098	0.6760	493.35	497.43	414806
The Profit by the Maximal Acquisition Rate	1478844	901	0.7714	432.50	514.79	414806
The Profit by the Maximal Duration	1490679	1000	0.6908	321.73	735.21	414806
The Maximal Profit with the Limit	1512018	977	0.7461	368.74	617.72	414806
The Maximal Profit without the Limit	2723667	572	0.7691	452.04	2212.56	1076855

labels <- c(Profit = "Total Profit, $", Duration = "Duration, Days", Acq_Rate = "Acquisition Rate, %",
            Acq_Exp = "Acquisition Expense per Client, $", Ret_Exp = "Retention Expense per Client, $",
            Spend = "Total Expense, $")
acqRet.df %>%
  gather(key = "items", value = "values", -Acq_Exp_Share) %>%
    mutate(items = factor(items, levels=c('Profit', 'Duration', 'Acq_Rate', 'Acq_Exp', 'Ret_Exp', 'Spend'))) %>% 
      ggplot(aes(Acq_Exp_Share, values))+
        geom_point(size = 0.5, alpha = 0.5) +
        facet_wrap(~ items, scales = "free_y", labeller=labeller(items = labels)) +
        aes(col = items) +
        scale_color_manual(values = c("green", "brown", "chartreuse", "magenta", "cyan", "red")) +
        theme(legend.position="none")

Мы также привели авторские результаты, которые не совпадают с нашими, но довольно близки им.

Scenarios	E(Profit)	E(Duration)	E(Acq. %)	Acq_Exp	Ret_Exp	Total expense
Current	$1 166 344	1098 дней	67.60%	$493.35	$497.43	$414 806
Max Acq	$1 438 033	900 дней	77.18%	$432.50	$514.52	$414 806
Max Dur	$1 446 867	999 дней	69.13%	$321.75	$734.65	$414 806
Max Profit	$1 469 636	976 дней	74.78%	$370.38	$614.11	$414 806
Unlimited Spend	$2 709 741	470 дней	76.95%	$452.04	$2 273.73	$1 100 830

Особенно удивляет, что у авторов сумма по прибыли получилась отчего то 1 166 344 долл., хотя в базе данных acquisitionRetention совсем другая сумма по полю profit = 1201921 долл.

# # plot the function
# library(lattice) # use the lattice package
# wireframe(Profit ~ Acq_Exp * Ret_Exp # y, x1, and x2 axes to plot
# , data = data.frame(X, Profit) # data.frame with X and y values in a data.frame for plotting
# , main = f_name # name the plot
# , shade = TRUE # make it pretty
# , scales = list(arrows = FALSE) # include axis ticks
# , screen = list(z = -50, x = -70) # view position
# )

# Plot of The Maximal Profit without the Limit on the Marketing Budget
# define ranges of x to plot over and put into matrix
Acq_Exp <- seq(0, 850, by = 5)
Ret_Exp <- seq(0, 3650, by = 5)
X <- as.matrix(expand.grid(Acq_Exp, Ret_Exp))
colnames(X) <- c("Acq_Exp", "Ret_Exp")
# evaluate function
Profit <- f_Pred_Profit_wo_Limit(X)
kd <- list(Acq_Exp = Acq_Exp, Ret_Exp = Ret_Exp,
           Profit = matrix(Profit, nrow = length(Ret_Exp), byrow = TRUE))

library('plotly')

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

plot_ly(x = kd$Acq_Exp, y = kd$Ret_Exp, z = kd$Profit) %>%
    add_surface() %>% 
    add_trace(name = "The Maximal Profit without the Limit", 
              x = c(out.booth$par[1], out.booth$par[1]), y = c(out.booth$par[2], out.booth$par[2]),
              z = c(0, out.booth$value), type="scatter3d", mode = "lines+markers",
              marker = list(size = 7, opacity = 0.8), line = list(width = 5, color = "orange")) %>% 
    add_trace(name = "The Maximal Profit with the Limit", 
              x = c(Pred_Prf_Opt$par, Pred_Prf_Opt$par), y = c(y_2, y_2),
              z = c(0, Pred_Prf_Opt$value), type="scatter3d", mode = "lines+markers",
              marker = list(size = 7, opacity = 0.8), line = list(width = 5, color = "green")) %>% 
    add_trace(name = "The Profit by the Maximal Acquisition Rate", 
              x = c(Pred_Acq_Opt$par, Pred_Acq_Opt$par), y = c(y_1, y_1),
              z = c(0, f_Pred_Profit(Pred_Acq_Opt$par, y_1)), type="scatter3d", mode = "lines+markers",
              marker = list(size = 7, opacity = 0.8), line = list(width = 5, color = "chartreuse")) %>% 
    add_trace(name = "The Profit by the Maximal Duration", 
              x = c(Pred_Dur_Opt$par, Pred_Dur_Opt$par), y = c(y_3, y_3),
              z = c(0, f_Pred_Profit(Pred_Dur_Opt$par, y_3)), type="scatter3d", mode = "lines+markers",
              marker = list(size = 7, opacity = 0.8), line = list(width = 5, color = "brown")) %>% 
    add_trace(name = "The Current Profit by the Real Data", 
              x = c(mean(acquisitionRetention$acq_exp), mean(acquisitionRetention$acq_exp)), y = c(y_0, y_0),
              z = c(0,  sum(acquisitionRetention$profit)), type="scatter3d",
      mode = "lines+markers", marker = list(size = 7, opacity = 0.8), line = list(width = 5, color = "coral")) %>% 
    add_trace(name = 'Limits (Acquisition & Retention)',
              x = c(0, acqRet.df$Acq_Exp, acqRet.df$Acq_Exp[nrow(acqRet.df)], 0, 0), 
              y = c(acqRet.df$Ret_Exp[1], acqRet.df$Ret_Exp, 0, 0, acqRet.df$Ret_Exp[1]),
              z = 1, type="scatter3d", mode = "lines", line = list(width = 4, color = "red")) %>% 
    layout(title = "The Maximal Profit w/o Marketing Limit's Function",
           scene = list(xaxis = list(title = "Acquisition Expense per Client, $"),
                        yaxis = list(title = "Retantion Expense per Client, $"),
                        zaxis = list(title = "Total Profit, $"),
                        camera = list(eye = list(x = 1, y = 2, z = -1),
                                      center = list(x = 0, y = 0, z = 0)))
    )

Real data and model optimization Results

Как это использовать?

Разберем результаты для каждого из сценариев:

• Максимизация по привлечению E(Acq. %). Для сценария, в котором максимизируется коэффициент привлечения, ожидаемая общая прибыль выше на 276923 долл., но ожидаемая продолжительность короче на 198 дней, коэффициент привлечения выше на 9.54%, средний расход на привлечение ниже на 60.85 долл., средний расход на удержание выше на 17.36 долл., при том же общем маркетинговом бюджете. Это показывает, что максимизация ставки привлечения рентательнее, чем текущий сценарий, поскольку общая прибыль выше, когда мы пытаемся приобрести большее количество клиентов. Это происходит потому, что, хотя средние расходы на привлечение ниже, расходы на приобретение ориентированы на потенциальных клиентов, которые с большей вероятностью присоединятся и не нацелены на тех, которые вряд ли будут присоединятся. Вот почему ожидаемая ставка привлечения намного выше, чем в текущем сценарии. Теперь в этом случае продолжительность сотрудничества клиентов с фирмой более коротка из-за того, что средние расходы на каждого клиента должны были уменьшиться, учитывая, что в этом сценарии было приобретено так много клиентов, а бюджет был ограничен таким же, как и раньше уровнем.

• Максимизация по продолжительности E(Duration). Для сценария, в котором максимизируется средняя продолжительность привлекаемых клиентов, ожидаемая прибыль выше на 288758 долл., ожидаемая продолжительность короче на 98 дней, ставка привлечения выше на 1.48%, средняя стоимость привлечения ниже на 171.62 долл. средние затраты на удержание выше на 237.78 долл., а общий маркетинговый бюджет равен сумме текущего сценария. Это показывает, что максимизация продолжительности сотрудничества с приобретенными клиентами лучше, чем текущий сценарий или даже сценарий, когда максимизируется ставка привлечения, поскольку общая прибыль в этом случае выше. Однако авторы отметили, что ожидаемая продолжительность меньше текущего сценария, даже когда мы пытаемся её максимизировать. Это происходит из-за того, что максимизируется привлечение клиента средним покупателем. Поскольку мы не привлекаем «лучших» клиентов, можно максимизировать срок действия клиентов, которых действительно смогли привлечь. Это означает, что фирма уже приобрела лучших, чем «средние» клиенты в своем текущем сценарии.

• Максимизация по рентабельности E(Profit). Для сценария, в котором максимизируется ожидаемая прибыль по всем потенциальным и реальным клиентам, ожидаемая прибыль выше на 310096 долл., ожидаемая продолжительность короче на 121 дня, ставка приобретения выше на 7.01%, средняя стоимость приобретения ниже на 124.61 долл., средние расходы на удержание выше на 120.29 долл., а общий маркетинговый бюджет - один и тот же. Это показывает, что максимизация прибыли приводит к значительному повышению уровня прибыли по сравнению с текущим сценарием, а также немного выше по сравнению с обоими двумя предыдущими сценариями, где максимизировали коэффициент привлечения клиентов и продолжительность сотрудничества клиента с фирмой. Эти результаты также показывают, что лимит маркетинговых затрат имеет решающее значение для максимизации прибыли, поскольку увеличение ожидаемой ставки привлечения и ожидаемой продолжительности способна принести больше прибыли. Снова мы видим, что весь бюджет используется, предполагая, что наше моделирование потенциально может оказаться более прибыльным, но требует тратить еще больше денег на усилия по привлечению и удержанию.

• Максимизация E(Profit) по рентабельности с неограниченным бюджетом. Для сценария, в котором максимизируется ожидаемая прибыль по всем потенциальным клиентам и реальным клиентам независимо от уровня маркетингового бюджета, ожидаемая прибыль выше на 1521745 долл., ожидаемая продолжительность короче на 526 дней, коэффициент привлечения выше на 9.31%, средняя расходы на приобретение ниже на 41.31 долл. США, средние расходы на удержание выше на 1715.13 долл., а общий маркетинговый бюджет выше на 662048.44 долл. по сравнению с текущим сценарием. Видно, что когда снимаются бюджетные ограничения, желаемый уровень расходов значительно выше текущего. Хотя может быть и не так, ведь если фирма может позволить себе потратить много больше на маркетинговые усилия для этой группы потенциальных клиентов / реальных клиентов, то куда надежнее если фирма сдерживается на текущем уровне бюджета, хотя и есть некоторые основания тратить больше, особенно в отношении усилий по удержанию клиентов.

Конечным результатом этого оптимального распределения ресурсов является то, что фирма может быть более прибыльной, если она уравновешивает усилия по ее привлечению и удержанию. Сосредоточив внимание либо на приобретении или сохранении (продолжительности сотрудничества с клиентами), фирма не максимизирует свою прибыль. Она начинает максимизировать прибыль, когда уравновешивает свои расходы на оба вида деятельности. Кроме того, очевидно, что фирма резко снижает свои маркетинговые усилия на привлечение, если она хочет максимизировать долгосрочную рентабельность.

devtools::session_info()

## Session info ----------------------------------------------------------------------------------------------------------

##  setting  value                       
##  version  R version 3.5.0 (2018-04-23)
##  system   x86_64, mingw32             
##  ui       RTerm                       
##  language (EN)                        
##  collate  Russian_Russia.1251         
##  tz       Asia/Dhaka                  
##  date     2018-07-20

## Packages --------------------------------------------------------------------------------------------------------------

##  package      * version    date       source        
##  abind          1.4-5      2016-07-21 CRAN (R 3.5.0)
##  arm            1.10-1     2018-04-13 CRAN (R 3.5.0)
##  assertthat     0.2.0      2017-04-11 CRAN (R 3.5.0)
##  backports      1.1.2      2017-12-13 CRAN (R 3.5.0)
##  base         * 3.5.0      2018-04-23 local         
##  bindr          0.1.1      2018-03-13 CRAN (R 3.5.0)
##  bindrcpp     * 0.2.2      2018-03-29 CRAN (R 3.5.0)
##  broom          0.4.4      2018-03-29 CRAN (R 3.5.0)
##  car          * 3.0-0      2018-04-02 CRAN (R 3.5.0)
##  carData      * 3.0-1      2018-03-28 CRAN (R 3.5.0)
##  caret        * 6.0-79     2018-03-29 CRAN (R 3.5.0)
##  cellranger     1.1.0      2016-07-27 CRAN (R 3.5.0)
##  class          7.3-14     2015-08-30 CRAN (R 3.5.0)
##  cli            1.0.0      2017-11-05 CRAN (R 3.5.0)
##  coda           0.19-1     2016-12-08 CRAN (R 3.5.0)
##  codetools      0.2-15     2016-10-05 CRAN (R 3.5.0)
##  colorspace     1.3-2      2016-12-14 CRAN (R 3.5.0)
##  compiler       3.5.0      2018-04-23 local         
##  crayon         1.3.4      2017-09-16 CRAN (R 3.5.0)
##  crosstalk      1.0.0      2016-12-21 CRAN (R 3.5.0)
##  curl           3.2        2018-03-28 CRAN (R 3.5.0)
##  CVST           0.2-1      2013-12-10 CRAN (R 3.5.0)
##  data.table     1.11.2     2018-05-08 CRAN (R 3.5.0)
##  datasets     * 3.5.0      2018-04-23 local         
##  ddalpha        1.3.3      2018-04-30 CRAN (R 3.5.0)
##  DEoptimR       1.0-8      2016-11-19 CRAN (R 3.5.0)
##  devtools       1.13.5     2018-02-18 CRAN (R 3.5.0)
##  digest         0.6.15     2018-01-28 CRAN (R 3.5.0)
##  dimRed         0.1.0      2017-05-04 CRAN (R 3.5.0)
##  dplyr        * 0.7.5      2018-05-19 CRAN (R 3.5.0)
##  DRR            0.0.3      2018-01-06 CRAN (R 3.5.0)
##  e1071          1.6-8      2017-02-02 CRAN (R 3.5.0)
##  evaluate       0.10.1     2017-06-24 CRAN (R 3.5.0)
##  forcats      * 0.3.0      2018-02-19 CRAN (R 3.5.0)
##  foreach        1.4.4      2017-12-12 CRAN (R 3.5.0)
##  foreign        0.8-70     2017-11-28 CRAN (R 3.5.0)
##  geometry       0.3-6      2015-09-09 CRAN (R 3.5.0)
##  GGally         1.4.0      2018-05-17 CRAN (R 3.5.0)
##  ggplot2      * 2.2.1      2016-12-30 CRAN (R 3.5.0)
##  glue           1.2.0      2017-10-29 CRAN (R 3.5.0)
##  gower          0.1.2      2017-02-23 CRAN (R 3.5.0)
##  graphics     * 3.5.0      2018-04-23 local         
##  grDevices    * 3.5.0      2018-04-23 local         
##  grid           3.5.0      2018-04-23 local         
##  gtable         0.2.0      2016-02-26 CRAN (R 3.5.0)
##  haven          1.1.1      2018-01-18 CRAN (R 3.5.0)
##  highr          0.6        2016-05-09 CRAN (R 3.5.0)
##  hms            0.4.2      2018-03-10 CRAN (R 3.5.0)
##  htmltools      0.3.6      2017-04-28 CRAN (R 3.5.0)
##  htmlwidgets    1.2        2018-04-19 CRAN (R 3.5.0)
##  httpuv         1.4.3      2018-05-10 CRAN (R 3.5.0)
##  httr           1.3.1      2017-08-20 CRAN (R 3.5.0)
##  ipred          0.9-6      2017-03-01 CRAN (R 3.5.0)
##  iterators      1.0.9      2017-12-12 CRAN (R 3.5.0)
##  jsonlite       1.5        2017-06-01 CRAN (R 3.5.0)
##  kableExtra     0.9.0      2018-05-21 CRAN (R 3.5.0)
##  kernlab        0.9-26     2018-04-30 CRAN (R 3.5.0)
##  knitr          1.20       2018-02-20 CRAN (R 3.5.0)
##  labeling       0.3        2014-08-23 CRAN (R 3.5.0)
##  later          0.7.2      2018-05-01 CRAN (R 3.5.0)
##  lattice      * 0.20-35    2017-03-25 CRAN (R 3.5.0)
##  lava           1.6.1      2018-03-28 CRAN (R 3.5.0)
##  lazyeval       0.2.1      2017-10-29 CRAN (R 3.5.0)
##  lme4           1.1-17     2018-04-03 CRAN (R 3.5.0)
##  lubridate      1.7.4      2018-04-11 CRAN (R 3.5.0)
##  magic          1.5-8      2018-01-26 CRAN (R 3.5.0)
##  magrittr       1.5        2014-11-22 CRAN (R 3.5.0)
##  MASS           7.3-49     2018-02-23 CRAN (R 3.5.0)
##  Matrix         1.2-14     2018-04-13 CRAN (R 3.5.0)
##  memoise        1.1.0      2017-04-21 CRAN (R 3.5.0)
##  methods      * 3.5.0      2018-04-23 local         
##  mime           0.5        2016-07-07 CRAN (R 3.5.0)
##  minqa          1.2.4      2014-10-09 CRAN (R 3.5.0)
##  mnormt         1.5-5      2016-10-15 CRAN (R 3.5.0)
##  ModelMetrics   1.1.0      2016-08-26 CRAN (R 3.5.0)
##  modelr         0.1.2      2018-05-11 CRAN (R 3.5.0)
##  munsell        0.4.3      2016-02-13 CRAN (R 3.5.0)
##  nlme           3.1-137    2018-04-07 CRAN (R 3.5.0)
##  nloptr         1.0.4      2017-08-22 CRAN (R 3.5.0)
##  nnet           7.3-12     2016-02-02 CRAN (R 3.5.0)
##  openxlsx       4.0.17     2017-03-23 CRAN (R 3.5.0)
##  parallel       3.5.0      2018-04-23 local         
##  pillar         1.2.2      2018-04-26 CRAN (R 3.5.0)
##  pkgconfig      2.0.1      2017-03-21 CRAN (R 3.5.0)
##  plotly       * 4.7.1      2017-07-29 CRAN (R 3.5.0)
##  plyr           1.8.4      2016-06-08 CRAN (R 3.5.0)
##  prodlim        2018.04.18 2018-04-18 CRAN (R 3.5.0)
##  promises       1.0.1      2018-04-13 CRAN (R 3.5.0)
##  psych          1.8.4      2018-05-06 CRAN (R 3.5.0)
##  purrr        * 0.2.4      2017-10-18 CRAN (R 3.5.0)
##  R6             2.2.2      2017-06-17 CRAN (R 3.5.0)
##  RColorBrewer   1.1-2      2014-12-07 CRAN (R 3.5.0)
##  Rcpp           0.12.17    2018-05-18 CRAN (R 3.5.0)
##  RcppRoll       0.2.2      2015-04-05 CRAN (R 3.5.0)
##  readr        * 1.1.1      2017-05-16 CRAN (R 3.5.0)
##  readxl         1.1.0      2018-04-20 CRAN (R 3.5.0)
##  recipes        0.1.2      2018-01-11 CRAN (R 3.5.0)
##  reshape        0.8.7      2017-08-06 CRAN (R 3.5.0)
##  reshape2       1.4.3      2017-12-11 CRAN (R 3.5.0)
##  rio            0.5.10     2018-03-29 CRAN (R 3.5.0)
##  rlang          0.2.0      2018-02-20 CRAN (R 3.5.0)
##  rmarkdown      1.9        2018-03-01 CRAN (R 3.5.0)
##  robustbase     0.93-0     2018-04-24 CRAN (R 3.5.0)
##  rpart          4.1-13     2018-02-23 CRAN (R 3.5.0)
##  rprojroot      1.3-2      2018-01-03 CRAN (R 3.5.0)
##  rstudioapi     0.7        2017-09-07 CRAN (R 3.5.0)
##  rvest          0.3.2      2016-06-17 CRAN (R 3.5.0)
##  scales         0.5.0      2017-08-24 CRAN (R 3.5.0)
##  sfsmisc        1.1-2      2018-03-05 CRAN (R 3.5.0)
##  shiny          1.1.0      2018-05-17 CRAN (R 3.5.0)
##  splines        3.5.0      2018-04-23 local         
##  stats        * 3.5.0      2018-04-23 local         
##  stats4         3.5.0      2018-04-23 local         
##  stringi        1.1.7      2018-03-12 CRAN (R 3.5.0)
##  stringr      * 1.3.1      2018-05-10 CRAN (R 3.5.0)
##  survival       2.41-3     2017-04-04 CRAN (R 3.5.0)
##  tibble       * 1.4.2      2018-01-22 CRAN (R 3.5.0)
##  tidyr        * 0.8.1      2018-05-18 CRAN (R 3.5.0)
##  tidyselect     0.2.4      2018-02-26 CRAN (R 3.5.0)
##  tidyverse    * 1.2.1      2017-11-14 CRAN (R 3.5.0)
##  timeDate       3043.102   2018-02-21 CRAN (R 3.5.0)
##  tools          3.5.0      2018-04-23 local         
##  utils        * 3.5.0      2018-04-23 local         
##  viridisLite    0.3.0      2018-02-01 CRAN (R 3.5.0)
##  withr          2.1.2      2018-03-15 CRAN (R 3.5.0)
##  xml2           1.2.0      2018-01-24 CRAN (R 3.5.0)
##  xtable         1.8-2      2016-02-05 CRAN (R 3.5.0)
##  yaml           2.1.19     2018-05-01 CRAN (R 3.5.0)

Выводы по главе 5

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