数据科学家

航空公司客户价值和流失分析

2017-06-12  本文已影响910人  文质彬彬彬

1 引言

最近终于把机器学习的算法部分整完了，可以再玩一个例子。这次是抽取《R语言数据分析与挖掘实战》里面一个航空公司客户价值分析的例子。

前一部分在书中有代码，可以直接一步一步敲上去。后面拓展部分，作品也只是留了个思路，我就顺着思路做了下去，结果虽然有一定的准确度，但还是有点寒碜。还需要更加修正来提高精准度。学习还得继续。

航空公司客户价值分析

2 数据初探

给定了客户的一些数据信息，为了对不同的客户采取不同的营销措施，通过建立合理的客户价值评价模型，来对客户进行细分。对不同的客户进行价值比较，并制定相应的营销策略，从而对客户提供有效的个性化服务。

# 设置工作空间
setwd("/Users/zhangyi/Desktop/clientanalyze/data/")
# 数据读取
datafile <- read.csv('air_data.csv', header = TRUE)
head(datafile)
初始数据 
# 确定要探索分析的变量
col <- c(15:18, 20:29)  # 去掉日期型变量
# 输出变量最值、缺失情况
summary(datafile[, col])

这个案例选择的是客户的入会时长L、消费时间间隔R、消费频率F、飞行里程M和折扣系数的平均值C五个指标作为航空公司识别客户价值指标。

传统的RFM模型太少，而细分太多的话，营销成本也会相应提高。当然，这不是这个案例的重点哈。

# 丢弃票价为空的记录
delet_na <- datafile[-which(is.na(datafile$SUM_YR_1) |
                             is.na(datafile$SUM_YR_2)), ]

# 丢弃票价为0、平均折扣率不为0、总飞行公里数大于0的记录
index <- ((delet_na$SUM_YR_1 == 0 & delet_na$SUM_YR_2 == 0)
          * (delet_na$avg_discount != 0)
          * (delet_na$SEG_KM_SUM > 0))
deletdata <- delet_na[-which(index == 1), ]

# 保存清洗后的数据
cleanedfile <- deletdata

# 构造L、R、F、M、C指标
# 转换为时间格式
cleanedfile$FFP_DATE <- as.Date(cleanedfile$FFP_DATE)
cleanedfile$LOAD_TIME <- as.Date(cleanedfile$LOAD_TIME)

# 构造时间间隔格式
library(lubridate)  # 处理日期格式数据包
interval <- interval(cleanedfile$FFP_DATE, cleanedfile$LOAD_TIME)  

# 以月为单位计算时长，输入为时间间隔
L <- time_length(interval, 'month')
L <- round(L, 2)
R <- cleanedfile$LAST_TO_END
F <- cleanedfile$FLIGHT_COUNT
M <- cleanedfile$SEG_KM_SUM
C <- cleanedfile$avg_discount

# 数据整合
airdata <- data.frame(L, R, F, M, C)
write.csv(airdata, 'zscoredata.csv', row.names = FALSE)
LRFMC指标

但由于各个指标之间的取值范围差异较大，于是采取标准化处理来消除数量级的影响。

# 数据读取
datafile <- read.csv('zscoredata.csv', header = TRUE)

# 数据标准化
zscoredfile <- scale(datafile)
colnames(zscoredfile)=c("ZL","ZR","ZF","ZM","ZC")
# 数据写出
write.csv(zscoredfile, 'zscoreddata.csv')
标准化后的LRFMC

3 聚类分析

现在就可以对其进行聚类分析了，当然，在聚类分析的同时，要结合业务的理解。

inputfile <- read.csv('zscoreddata.csv', header = TRUE)
# 聚类分析
result <- kmeans(inputfile, 5)

# 结果输出
type <- result$cluster
table(type)  # 查看类别分布
centervec <- result$center

由于K-Means是随机选择类标号，每次的结果可能有所不同。

# 各簇中心的条形图

library(reshape)
library(ggplot2)
# 条形图
# 将数据格式转换为画图所需要的格式
data.bar <- as.data.frame(t(result$center))
colnames(data.bar) <- paste("class", 1:5, sep = "")
data.bar <- data.frame(index = c("L", "R", "F", "M", "C"), data.bar[2:6,])
data.bar <- melt(data.bar, c("index"))
colnames(data.bar) <- c("index", "class", "center")
head(data.bar)
ggplot(data.bar, aes(x = index, y = center, fill = class)) + 
  scale_y_continuous(limits = c(-1, 3)) + geom_bar(stat = "identity") + 
  facet_grid(class ~ .) + guides(fill = FALSE) + theme_bw()
类别条形图 
# 每一簇各指标的关系程度  --雷达图
# install.packages("fmsb")
library(fmsb)
max <- apply(result$centers[,2:6], 2, max)
min <- apply(result$centers[,2:6], 2, min)
data.radar <- data.frame(rbind(max, min, result$centers[,2:6]))
radarchart(data.radar, pty = 32, plty = 1, plwd = 2, vlcex = 0.7)
# 给雷达图加图例
L <- 1.2
for(i in 1:5){
  text(1.8, L, labels = paste("--class", i), col = i)
  L <- L - 0.2
}
雷达图

通过雷达图和条形图，我们可以简单分析出整个客户在分成五种之后，五种客户类型在LRFMZ各个属性上的特点就可以分辨清楚了。（至于各个属性结合起来代表的客户类型需要根据业务进行判断，感兴趣的看书咯）

# 查看各簇个数占比 --饼图
# install.packages("plotrix")
library(plotrix)
data.pie <- c(result$size)
prob <- paste(round(result$size / sum(result$size) * 100, 2), "%", sep = "")
lbls <- c(paste("class", 1:5, sep = "", ": ", prob))
pie3D(data.pie, labels = lbls, labelcex = 0.8, explode = 0.1,
      col = c("lightskyblue", "lightcyan", "turquoise",
                "lightskyblue3", "steelblue"))
      labels <- c("London", "New York", "Singapore", "Mumbai")
饼图

在客户类型分辨好之后，就可以根据客户的特点制定不同策论的营销策略。同时，每隔半年要对模型进行重新训练，以保持其稳定性。

4 构建模型

前面主要对客户的价值进行了分析，在后面会对客户的流失进行分析。通过对新老客户进行分类（飞行次数大于6次为老客户），客户类型定义（流失客户的定义为第二年的飞行次数与第一年飞行次数比例小于50%，准流失在[50,90)，未流失为大于90%）。

同时，选取部分关键属性（会员卡级别、客户类型等），随机选取80%数据作为训练样本，剩余20%作为测试样本建立流失模型，预测未来客户的类别归属。

### 拓展
datafile <- read.csv('拓展思考样本数据.csv', header = TRUE)
# 确定要探索分析的变量
col <- c(15:18, 20:29)  # 去掉日期型变量
# 输出变量最值、缺失情况
summary(datafile[, col])
# 丢弃票价为空的记录
delet_na <- datafile[-which(is.na(datafile$SUM_YR_1) |
                             is.na(datafile$SUM_YR_2)), ]

# 丢弃票价为0、平均折扣率不为0、总飞行公里数大于0的记录
index <- ((delet_na$SUM_YR_1 == 0 & delet_na$SUM_YR_2 == 0)
          * (delet_na$avg_discount != 0)
          * (delet_na$SEG_KM_SUM > 0))
deletdata <- delet_na[-which(index == 1), ]

# 保存清洗后的数据
cleanedfile <- deletdata

T指标为客户类型（流失、准流失和未流失），F指标为老客户和新客户，R为会员卡级别，I为平均乘机时间间隔，D为平均这折扣率

# 构造T(lost-1,lossing0,stay1)、R(FFP_TIER)、F、I、D指标
# 转换为时间格式
cleanedfile$FFP_DATE <- as.Date(cleanedfile$FFP_DATE)
cleanedfile$LOAD_TIME <- as.Date(cleanedfile$LOAD_TIME)

# 构造时间间隔格式
library(lubridate)  # 处理日期格式数据包
interval <- interval(cleanedfile$FFP_DATE, cleanedfile$LOAD_TIME)  

# 以月为单位计算时长，输入为时间间隔
L <- time_length(interval, 'month')
L <- round(L, 2)
R <- cleanedfile$FFP_TIER
I <- cleanedfile$AVG_INTERVAL
D <- cleanedfile$avg_discount

F <- c() # 老客户、新客户
for (i in 1: nrow(cleanedfile)){
    if (cleanedfile$FLIGHT_COUNT[i]>6){
    F[i] <- 1
    }
    else F[i] <- 0 
}       
        
T <- c()
T.rate <- cleanedfile$L1Y_Flight_Count/cleanedfile$P1Y_Flight_Count
for (i in 1: nrow(cleanedfile)){
    if (T.rate[i] >= 0.9){
    T[i] <- 1
    }
    if (T.rate[i] < 0.9 & T.rate[i] >= 0.5){
    T[i] <- 0}
    else T[i] <- -1 
}
# 数据整合
extscoredata<- data.frame(R, I, D, F, T)
write.csv(extscoredata, 'extscoredata.csv', row.names = FALSE)
# 数据标准化
extscoredata<- scale(extscoredata)
colnames(extscoredata)=c("ZR","ZI","ZD","ZF","ZT")
# 数据写出
write.csv(extscoredata, 'extscoreddata.csv')


# 数据划分
# 把数据分为两部分：训练数据、测试数据
# 读入数据
Data <- read.csv("extscoreddata.csv")
# 数据分割
set.seed(1234)  # 设置随机种子
# 定义序列ind，随机抽取1和2,1的个数占80%，2的个数占20%
ind <- sample(2, nrow(Data), replace = TRUE, prob = c(0.8, 0.2))
trainData <- Data[ind == 1,]  # 训练数据
testData <- Data[ind == 2,]  # 测试数据
# 数据存储
write.csv(trainData, "trainData.csv", row.names = FALSE)
write.csv(testData, "testData.csv", row.names = FALSE)

划分好数据，建立神经网络模型，将客户类型转化为因子。

# 神经网络模型构建
# 读取数据
trainData <- read.csv("trainData.csv")

# 将class列转换为factor类型
trainData <- transform(trainData, class = as.factor(ZT))



# 神经网络模型构建
library(nnet) # 加载nnet包
# 利用nnet建立神经网络
nnet.model <- nnet(ZT~ ZR + ZI+ ZD+ ZF, trainData, 
                   size = 10, decay = 1)
summary(nnet.model)

# 建立混淆矩阵
confusion <- table(trainData$ZT, predict(nnet.model, trainData, 
                                            ))
accuracy <- sum(diag(confusion)) * 10000 / sum(confusion)

# 保存输出结果
output_nnet.trainData <- cbind(trainData, predict(nnet.model, trainData))
colnames(output_nnet.trainData) <- c(colnames(trainData), "OUTPUT")
write.csv(output_nnet.trainData, "output_nnet.trainData.csv", 
          row.names = FALSE)

5 检验验证

通过ROC曲线来检验模型是否准确。

# 保存神经网络模型
save(nnet.model, file = "nnet.model.RData")

# ROC曲线
# 设置工作空间
# 读取数据
testData <- read.csv("testData.csv")
# 读取模型
load("nnet.model.RData")

# ROC曲线
library(ROCR)  # 加载ROCR包
# 画出神经网络模型的ROC曲线
nnet.pred <- prediction(predict(nnet.model, testData), testData$ZT)
nnet.perf <- performance(nnet.pred, "tpr", "fpr") 
plot(nnet.perf)
ROC

ROC曲线真心有不准，麻烦就在于，我已经尝试了调整算法里的各种参数，结果也基本没怎么变化。所以，最近看了寒小阳的博客，打算再试试模型融合深入挖掘一下。

6 问题与总结：

残留的问题在于：

也已经请教了迷途和vivian桑：

一把特征工程做好，选的predictor好能提高，很多predictor correlated的话有时候不好；
二把数据transformation做好，比如中心化啊～标准化啊，log一下你的predictor；
三加入一些interaction或者predictor的平方可以抓一些high order moment的信息；
四一般非线性关系多的时候可以试试决策树随机森林神经网络等等～

“针对同一批数据，改善预测准确性的方法，有几种，进去模型的数据，不同算法，算法的不同参数。以往的经验，效果比较明显的是尽量折腾进入模型的数据。对数据的处理层面，单一指标可以衍生n多指标，比如环比，同比，占比等等。数据量纲不同引起的问题，数据标准化（归一化）都是要尝试处理的”

哎，路途遥远，继续努力。

上一篇下一篇

猜你喜欢

热点阅读