使用 R 实现营销分析：第 1 部分

2020-02-15 08:00:00 · 飞浪

介绍营销和客户相关决策是每个企业的首要任务。借助统计建模和分析，可以为决策者提供支持，帮助他们根据数据（而不仅仅是直觉）做出战略决策。统计建模与营销策略的结合也可以称为营销分析。在这

介绍

营销和客户相关决策是每个企业的首要任务。借助统计建模和分析，可以为决策者提供支持，帮助他们根据数据（而不仅仅是直觉）做出战略决策。统计建模与营销策略的结合也可以称为营销分析。

在这一系列的两个指南中，您将学习在 R 中实现营销分析的重要技术。

本指南第 1 部分将涵盖：

客户流失预测
RFM 分析

下一篇指南第 2 部分将涵盖：

聚类
销售预测
其他地区

让我们首先加载所需的库。

      library(plyr)
library(readr)
library(dplyr)
library(caret)
library(ggplot2)
library(repr)
library(caret)
    

客户流失预测

获取客户的成本比留住客户的成本更高。这就是为什么留住客户，尤其是那些盈利能力强的客户，具有商业意义。机器学习模型可以模拟客户离开或流失的概率。然后，这可以用来锁定有价值的客户，并留住那些有风险的客户。我们将建立一个逻辑回归模型来预测客户流失。

数据

在本指南中，我们将使用一个虚构的零售银行客户数据集，其中包含 600 个观测值和 10 个变量，如下所示：

Marital_status：客户是否已婚（“是”）或未婚（“否”）。
Is_graduate：客户是否是毕业生（“是”）或不是（“否”）。
收入：客户的年收入（以美元计）。
Loan_pending：客户尚需支付的未偿还贷款金额（美元）。
Satisfaction_score：客户的满意度。
流失：客户是否流失（“是”）或未流失（“否”）。
年龄：申请人的年龄。
性别：申请人是男性（“M”）还是女性（“F”）。
投资：客户持有的股票和共同基金的总投资额（以美元计）。
目的：与Loan_pending变量相关的贷款目的。

让我们首先加载数据。

      df_churn = read_csv("data_churn.csv")
glimpse(df_churn)
    

输出：

      Observations: 600
Variables: 10
$ Marital_status     <chr> "No", "Yes", "Yes", "Yes", "No", "Yes", "No", "No",...
$ Is_graduate        <chr> "Yes", "Yes", "Yes", "Yes", "No", "Yes", "Yes", "Ye...
$ Income             <int> 7000, 8990, 13330, 13670, 19230, 23450, 24000, 2471...
$ Loan_pending       <dbl> 900.0, 809.1, 1199.7, 1230.3, 1730.7, 1876.0, 1920....
$ Satisfaction_score <chr> "Satisfactory", "Satisfactory", "Satisfactory", "Sa...
$ Churn              <chr> "Yes", "Yes", "No", "Yes", "No", "No", "Yes", "No",...
$ Age                <int> 29, 29, 25, 29, 25, 33, 37, 46, 28, 35, 35, 32, 27,...
$ Sex                <chr> "F", "M", "M", "M", "M", "M", "M", "M", "M", "M", "...
$ Investment         <dbl> 2100, 6293, 9331, 9569, 13461, 16415, 16800, 17297,...
$ Purpose            <chr> "Travel", "Travel", "Travel", "Travel", "Travel", "...
    

输出显示数据集有四个数值变量（标记为int或dbl）和六个字符变量（标记为chr）。我们将使用下面的代码行将它们转换为因子变量。

      names <- c(1,2,5,6,8,10)
df_churn[,names] <- lapply(df_churn[,names] , factor)
glimpse(df_churn)
    

输出：

      Observations: 600
Variables: 10
$ Marital_status     <fct> No, Yes, Yes, Yes, No, Yes, No, No, Yes, Yes, No, Y...
$ Is_graduate        <fct> Yes, Yes, Yes, Yes, No, Yes, Yes, Yes, No, No, No, ...
$ Income             <int> 7000, 8990, 13330, 13670, 19230, 23450, 24000, 2471...
$ Loan_pending       <dbl> 900.0, 809.1, 1199.7, 1230.3, 1730.7, 1876.0, 1920....
$ Satisfaction_score <fct> Satisfactory, Satisfactory, Satisfactory, Satisfact...
$ Churn              <fct> Yes, Yes, No, Yes, No, No, Yes, No, Yes, Yes, Yes, ...
$ Age                <int> 29, 29, 25, 29, 25, 33, 37, 46, 28, 35, 35, 32, 27,...
$ Sex                <fct> F, M, M, M, M, M, M, M, M, M, F, M, M, F, F, M, M, ...
$ Investment         <dbl> 2100, 6293, 9331, 9569, 13461, 16415, 16800, 17297,...
$ Purpose            <fct> Travel, Travel, Travel, Travel, Travel, Travel, Tra...
    

数据分区

我们将在训练集上构建模型，并在测试集上评估其性能。这称为用于评估模型性能的保留验证方法。

下面的第一行代码设置了随机种子，以确保结果的可重复性。第二行加载用于数据分区的caTools包，而第三至第五行创建训练集和测试集。训练集包含 70% 的数据（10 个变量的 420 个观测值），测试集包含剩余的 30%（10 个变量的 180 个观测值）。

      set.seed(100)
library(caTools)

spl = sample.split(df_churn$Churn, SplitRatio = 0.70)
train = subset(df_churn, spl==TRUE)
test = subset(df_churn, spl==FALSE)

print(dim(train)); print(dim(test))
    

输出：

      1] 420  10

[1] 180  10

基线准确度

下一步是估计基线准确率，这是初始模型评估技术之一。下面的代码为目标类创建比例表。由于目标变量的多数类的比例为 0.68，因此基线准确率为 68%。

      prop.table(table(train$Churn))

输出：

      No       Yes 
0.3166667 0.6833333
    

建立、预测和评估模型

为了拟合模型，第一步是使用glm()函数实例化算法。第二行打印训练模型的摘要。

      model_glm = glm(Churn ~ . , family="binomial", data = train)
summary(model_glm)
    

输出：

      Call:
glm(formula = Churn ~ ., family = "binomial", data = train)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-2.24561  -0.00004   0.00004   0.00007   2.23620  

Coefficients:
                                 Estimate Std. Error z value Pr(>|z|)    
(Intercept)                    -1.025e+00  8.100e+03   0.000   0.9999    
Marital_statusYes               4.330e-01  4.566e-01   0.948   0.3430    
Is_graduateYes                  9.686e-01  4.571e-01   2.119   0.0341 *  
Income                          8.054e-08  9.276e-06   0.009   0.9931    
Loan_pending                    1.486e-05  3.188e-05   0.466   0.6411    
Satisfaction_scoreSatisfactory  2.284e+01  7.841e+03   0.003   0.9977    
Age                            -6.213e-02  1.279e-02  -4.859 1.18e-06 ***
SexM                            1.857e-01  5.599e-01   0.332   0.7402    
Investment                     -1.604e-06  1.378e-05  -0.116   0.9073    
PurposeHome                     2.002e+00  8.100e+03   0.000   0.9998    
PurposeOthers                  -4.128e+01  3.081e+03  -0.013   0.9893    
PurposePersonal                 1.388e+00  2.568e+03   0.001   0.9996    
PurposeTravel                  -1.942e+01  2.030e+03  -0.010   0.9924    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 524.44  on 419  degrees of freedom
Residual deviance: 168.04  on 407  degrees of freedom
AIC: 194.04

Number of Fisher Scoring iterations: 19
    

上述输出中的重要性代码***显示了特征变量的相对重要性。

现在让我们评估模型性能，它应该高于基线准确度。我们从训练数据开始，其中第一行代码在训练集上生成预测。第二行创建阈值为 0.5 的混淆矩阵，这意味着对于大于或等于 0.5 的概率预测，算法将预测“Churn”变量的响应为“是”。第三行使用混淆矩阵打印模型在训练数据上的准确度，准确度为 90%。

我们对测试数据重复此过程，准确率达到了 89%。

      # Predictions on the training set
predictTrain = predict(model_glm, data = train, type = "response")

# Confusion matrix on training data
table(train$Churn, predictTrain >= 0.5)
(114+263)/nrow(train) #Accuracy - 90% 

#Predictions on the test set
predictTest = predict(model_glm, newdata = test, type = "response")

# Confusion matrix on test set
table(test$Churn, predictTest >= 0.5)
161/nrow(test) #Accuracy - 89%
    

输出：

      FALSE TRUE
  No    114   19
  Yes    24  263
  
[1] 0.897619
     
      FALSE TRUE
  No     46   11
  Yes     8  115
  
[1] 0.8944444
    

RFM 分析

RFM（最近度、频率和金额）分析是一种使用客户交易数据根据客户最近的购买情况、购买频率和消费金额来确定最佳客户的技术。

数据

对于 RFM 分析，我们将使用一个虚构的零售店顾客数据集，其中包含 92 个观测值和 3 个变量，如下所述：

CustId：唯一的客户编号。
Purchase_date：购买日期。
Purchase_value：购买价值（以美元计）。

让我们加载数据并查看其结构。

      df_rfm = read_csv("RFM.csv")
glimpse(df_rfm)
    

输出：

      Observations: 92
Variables: 3
$ CustId         <chr> "Id1", "Id2", "Id3", "Id4", "Id5", "Id6", "Id7", "Id8",...
$ Purchase_date  <chr> "01-Oct-19", "02-Oct-19", "03-Oct-19", "04-Oct-19", "05...
$ Purchase_value <dbl> 19.2, 19.8, 19.7, 21.3, 20.2, 18.6, 21.5, 21.3, 21.3, 2...
    

我们对客户级别的分析感兴趣，因此让我们使用下面的代码来查看客户的唯一编号。

      length(unique(df_rfm$CustId))

输出：

      1] 25

输出显示有 25 个唯一客户。我们将对这些数据执行 RFM 分析，但在此之前，我们必须将日期变量转换为正确的格式，这可以使用下面的第一行代码完成。

我们可以观察到Purchase_date变量涵盖了 2019 年 10 月 1 日至 2019 年 12 月 31 日之间的时间段。为了计算新近度，我们将创建一个新变量days_diff，用于衡量购买日期和参考日期之间的差异，参考日期设置为 2020 年 1 月 1 日。第二行代码创建此变量，而第三行打印数据结构。

      df_rfm$Purchase_date = as.Date(df_rfm$Purchase_date, "%d-%b-%y")

df_rfm$days_diff = round(as.numeric(difftime(time1 = "2020-01-01",
                                            time2 = df_rfm$Purchase_date,
                                            units = "days")),0)

glimpse(df_rfm)
    

输出：

      Observations: 92
Vari

_{免责声明：本内容来源于第三方作者授权、网友推荐或互联网整理，旨在为广大用户提供学习与参考之用。所有文本和图片版权归原创网站或作者本人所有，其观点并不代表本站立场。如有任何版权侵犯或转载不当之情况，请与我们取得联系，我们将尽快进行相关处理与修改。感谢您的理解与支持！}

_查看原文

技术指南

阅读全文

使用 R 实现营销分析：第 1 部分

杭州电子商务研究院

5年前 · 面向社会、服务行业、政产学研结合、整合资源、和谐发展

Observations: 600 Variables: 10 $ Marital_status <chr> "No", "Yes", "Yes", "Yes", "No", "Yes", "No", "No",... $ Is_graduate <chr> "Yes", "Yes", "Yes", "Yes", "No", "Yes", "Yes", "Ye... $ Income <int> 7000, 8990, 13330, 13670, 19230, 23450, 24000, 2471... $ Loan_pending <dbl> 900.0, 809.1, 1199.7, 1230.3, 1730.7, 1876.0, 1920.... $ Satisfaction_score <chr> "Satisfactory", "Satisfactory", "Satisfactory", "Sa... $ Churn <chr> "Yes", "Yes", "No", "Yes", "No", "No", "Yes", "No",... $ Age <int> 29, 29, 25, 29, 25, 33, 37, 46, 28, 35, 35, 32, 27,... $ Sex <chr> "F", "M", "M", "M", "M", "M", "M", "M", "M", "M", "... $ Investment <dbl> 2100, 6293, 9331, 9569, 13461, 16415, 16800, 17297,... $ Purpose <chr> "Travel", "Travel", "Travel", "Travel", "Travel", "...

Observations: 600 Variables: 10 $ Marital_status <fct> No, Yes, Yes, Yes, No, Yes, No, No, Yes, Yes, No, Y... $ Is_graduate <fct> Yes, Yes, Yes, Yes, No, Yes, Yes, Yes, No, No, No, ... $ Income <int> 7000, 8990, 13330, 13670, 19230, 23450, 24000, 2471... $ Loan_pending <dbl> 900.0, 809.1, 1199.7, 1230.3, 1730.7, 1876.0, 1920.... $ Satisfaction_score <fct> Satisfactory, Satisfactory, Satisfactory, Satisfact... $ Churn <fct> Yes, Yes, No, Yes, No, No, Yes, No, Yes, Yes, Yes, ... $ Age <int> 29, 29, 25, 29, 25, 33, 37, 46, 28, 35, 35, 32, 27,... $ Sex <fct> F, M, M, M, M, M, M, M, M, M, F, M, M, F, F, M, M, ... $ Investment <dbl> 2100, 6293, 9331, 9569, 13461, 16415, 16800, 17297,... $ Purpose <fct> Travel, Travel, Travel, Travel, Travel, Travel, Tra...

set.seed(100) library(caTools) spl = sample.split(df_churn$Churn, SplitRatio = 0.70) train = subset(df_churn, spl==TRUE) test = subset(df_churn, spl==FALSE) print(dim(train)); print(dim(test))

Call: glm(formula = Churn ~ ., family = "binomial", data = train) Deviance Residuals: Min 1Q Median 3Q Max -2.24561 -0.00004 0.00004 0.00007 2.23620 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) -1.025e+00 8.100e+03 0.000 0.9999 Marital_statusYes 4.330e-01 4.566e-01 0.948 0.3430 Is_graduateYes 9.686e-01 4.571e-01 2.119 0.0341 * Income 8.054e-08 9.276e-06 0.009 0.9931 Loan_pending 1.486e-05 3.188e-05 0.466 0.6411 Satisfaction_scoreSatisfactory 2.284e+01 7.841e+03 0.003 0.9977 Age -6.213e-02 1.279e-02 -4.859 1.18e-06 *** SexM 1.857e-01 5.599e-01 0.332 0.7402 Investment -1.604e-06 1.378e-05 -0.116 0.9073 PurposeHome 2.002e+00 8.100e+03 0.000 0.9998 PurposeOthers -4.128e+01 3.081e+03 -0.013 0.9893 PurposePersonal 1.388e+00 2.568e+03 0.001 0.9996 PurposeTravel -1.942e+01 2.030e+03 -0.010 0.9924 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 (Dispersion parameter for binomial family taken to be 1) Null deviance: 524.44 on 419 degrees of freedom Residual deviance: 168.04 on 407 degrees of freedom AIC: 194.04 Number of Fisher Scoring iterations: 19

# Predictions on the training set predictTrain = predict(model_glm, data = train, type = "response") # Confusion matrix on training data table(train$Churn, predictTrain >= 0.5) (114+263)/nrow(train) #Accuracy - 90% #Predictions on the test set predictTest = predict(model_glm, newdata = test, type = "response") # Confusion matrix on test set table(test$Churn, predictTest >= 0.5) 161/nrow(test) #Accuracy - 89%

Observations: 92 Variables: 3 $ CustId <chr> "Id1", "Id2", "Id3", "Id4", "Id5", "Id6", "Id7", "Id8",... $ Purchase_date <chr> "01-Oct-19", "02-Oct-19", "03-Oct-19", "04-Oct-19", "05... $ Purchase_value <dbl> 19.2, 19.8, 19.7, 21.3, 20.2, 18.6, 21.5, 21.3, 21.3, 2...

df_rfm$Purchase_date = as.Date(df_rfm$Purchase_date, "%d-%b-%y") df_rfm$days_diff = round(as.numeric(difftime(time1 = "2020-01-01", time2 = df_rfm$Purchase_date, units = "days")),0) glimpse(df_rfm)