航空公司客户价值分析

RFM模型是衡量客户价值和客户创利能力的重要工具和手段，它通过一个客户的近期购买行为、购买的总体频次以及购买的总体金额三个指标来描述客户的价值状况。

分别为：最近消费时间间隔(Recently)、消费频率(Frequency)、消费金额(Money)。

在RFM模型的基础上，结合具体的业务背景，来对航空公司进行客户价值分析。

我们选择在一定时间内累积的飞行里程数(M)和客户在一定时间内乘坐舱位对应的折扣系数的平均值C来代替消费金额指标。

此外，航空公司会员入会时间的长短在一定时间内会影响客户价值，模型中增加了客户关系长度指标L。

利用客户入会时长L、消费时间间隔R、消费频率F、飞行里程数M以及折扣系数的平均值C来作为航空公司识别客户价值指标，见表1，记为LRFMC模型。

采用聚类分析的方法识别客户价值。

通过对航空公司客户价值LRFMC五个指标进行K-Means聚类，识别最有价值客户。

1、数据抽取
以2014年3月31日为结束时间，选取宽度为两年的时间段作为分析观测窗口，抽取观测窗口内有乘机记录的所有客户的详细数据形成历史数据。

对于后续新增的客户详细信息，以后续新增数据中最新的时间点作为结束时间，采用上述同样的方法进行抽取，形成增量数据。

2、数据探索分析
主要是进行缺失值分析和异常值分析，通过对数据的观察，发现原始数据中存在票价为空值，票价最小值为0、折扣率最小值为0、总飞行公里数大于0的记录，这个都是属于缺失值和异常值的范畴。

# 设置工作空间
# 把“数据及程序”文件夹拷贝到F盘下，再用setwd设置工作空间
setwd("F:/数据及程序/chapter7/示例程序")
# 数据读取
datafile <- read.csv('./data/air_data.csv', header = TRUE)
# 确定要探索分析的变量
col <- c(15:18, 20:29) # 去掉日期型变量
# 输出变量最值、缺失情况
summary(datafile[, col])
#探索缺失数据的模式
md.pattern(datafile[,col])
#以图形方式描述缺失数据
aggr(datafile[,col],number=T)
3、数据预处理
由于原始数据量比较大，上述被定义为缺失值和异常值的样本量很小，对问题的分学习影响不大，因此选择的是剔除缺失值和异常值。

# 丢弃票价为空的记录
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
属性规约
基于航空公司客户价值的LRFMC模型，选择与LRFMC指标相关的6个属性，其中选取了LOAD_TIME(观测窗口的结束时间)，FFP_DATE(观测窗口的开始时间)，LAST_TO_END(最后一次乘机时间至观测窗口结束时长)，FLIGHT_COUNT(观测窗口的飞行次数)，SEG_KM_SUM(观测窗口的总飞行公里数)，avg_discount(平均折扣率)，删除其余不必要的属性。

数据变换
⑴属性构造
由于在原始数据并没有完整的给出LRFMC模型的5个指标，需要通过原始变量提炼相应指标，具体的计算公式如下：
会员入会时间=观测窗口的结束时间-观测窗口的开始时间(单位：月)
L=LOAD_TIME- FFP_DATE
客户最近一次乘坐飞机距离窗口结束的月数=最后一次乘机时间至观测窗口结束时长(单位：月)
R= LAST_TO_END
客户在观测窗口乘坐飞机的次数=观测窗口的飞行次数(单位：次)
F= FLIGHT_COUNT
客户在观测时间内的累计飞行里程=观测窗口的总飞行公里数(单位：公里)
M= SEG_KM_SUM
客户在观测时间内乘坐舱位所对应的的折扣系数的平均值=平均折扣率(单位：无)
C= avg_discount
⑴数据的标准化处理
通过R语言中的summary函数来查看每个指标数据的分布情况，其数据取值范围如表2所示，发现五个指标的数据差异较大，为了消除数据数量级较大带来的影响，对数据进行了标准化处理
<textarea readonly="readonly" name="code" class="python">
#属性规约，选择后期需要进行K-Means分类的属性
deleted_data <-delete_data[,c('FFP_DATE','LOAD_TIME','FLIGHT_COUNT','avg_discount','SEG_KM_SUM','LAST_T O_END')]
#数据变换，客户入会时长需要另外计算，入会时长按照月来进行计算
class(deleted_data$FFP_DATE)
class(deleted_data$LOAD_TIME)
#因为入会时间和观测窗口结束时间都是字符串，所以更改数据类型
deleted_data$FFP_DATE <- as.Date(deleted_data$FFP_DATE)
deleted_data$LOAD_TIME <- as.Date(deleted_data$LOAD_TIME)
#计算客户入会时间，并将最终结果转为月数
deleted_data$L <- as.numeric((deleted_data$LOAD_TIME-deleted_data$FFP_DATE)/30)
#只选择LRFMC模型需要的5个属性
deleted_data <-deleted_data[,c('L','LAST_TO_END','FLIGHT_COUNT','SEG_KM_SUM','avg_discount')]
#列名重命名
colnames(deleted_data) <- c('L','R','F','M','C')
#对数据分布进行查看，看是否需要标准化处理
summary(deleted_data)
#5个指标的数据范围差异太大，所以需要进行标准化处理
zscorefile <- scale(deleted_data)
#对列名再次重命名
colnames(zscorefile) <- c('ZL','ZR','ZF','ZM','ZC')
<textarea>
# 数据读取
datafile <- read.csv('./data/zscoredata.csv', header = TRUE)
# 数据标准化
zscoredfile <- scale(datafile)
# 数据写出
write.csv(zscoredfile, './tmp/zscoreddata.csv')
4、模型构建
LRFMC模型主要由两个部分组成，第一部分是根据航空公司业务指标，对客户进行聚类分群；第二部分是对每个业务群进行特征分析，分析客户价值，并采取特定的营销手段，来使得公司的利润最大化。

⑴客户聚类
# 数据读取
inputfile <- read.csv('./data/zscoreddata.csv', header = TRUE)
# 聚类分析
result <- kmeans(inputfile, 5)
# 结果输出
type <- result$cluster
table(type) # 查看类别分布
centervec <- result$center
（2）客户价值分析
重要保持客户(客户群1)：
这类客户的平均折扣率(C)较高(一般所乘航班的舱位的等级较高)，最近乘坐过本公司航班(R)低，乘坐的次数(F)或里程(M)较高。

他们是公司的高价值客户，是最理想的客户类型，对航空公司的贡献率大，但是所占的比例较小。

航空公司应当优先将资源投放在他们身上，对他们做到一对一精准营销，比如提供相应的优惠政策，提高这类客户的忠诚度和满意度，尽可能延长这类客户的高消费水平。

重要发展客户(客户群5)：
这类客户的平均折扣率(C)较高，最近乘坐过本公司航班(R)低，乘坐的次数(F)或里程(M)较低。

这类客户入会时长(L)短，他们是公司的潜在价值客户。

航空公司在运营过程中也要相应加大对这部分客户的投入，比如以短信和邮件的方式询问客户是否满意、提供适当的优惠服务等，加强这类客户的满意度，使他们逐渐成为公司的忠实客户。

重要挽留客户(客户群2)：
这类客户的平均折扣率(C)、乘坐的次数(F)或里程(M)较高，但是已经较长时间已经没有乘坐过本公司航班，即(R)较高或者乘坐的频率变小，他们是公司的重要挽留客户。

航空公司在运营过程中要积极推测这类客户的异常情况，进行竞争分析，观察其他航空公司有什么营销策略，然后采取有针对性的营销手段，延长客户的生命周期。

一般和低价值客户(客户群3、4)：
这类客户的平均折扣率(C)较低，最近乘坐过本公司航班(R)低，乘坐的次数(F)或里程(M)较低。

入会时长(L)也较短，因此可能只是在机票打折的时候才会乘坐本航班。

重要发展客户、重要保持客户、重要挽留客户可以称作为客户生命周期管理中的发展期、稳定期、衰退期三个阶段。

⑶模型应用
①会员的升级和保级
对那些接近但尚未达到的高消费客户采取一定的促销活动，刺激他们通过消费达到相应的升级标准。

②首次兑现
对那些接近但尚未达到首次兑现机票的会员，对他们进行提醒，使他们达到首次兑现标准。

5、
# 数据读取
datafile <- read.csv('./data/air_data.csv', header = TRUE)
# 丢弃票价为空的记录
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
#属性规约，选择后期需要进行K-Means分类的属性
deleted_data <- deletdata[,c('FFP_DATE','LOAD_TIME','FLIGHT_COUNT','avg_discount','SE G_KM_SUM','LAST_TO_END')]
#数据变换，客户入会时长需要另外计算，入会时长按照月来进行计算
class(deleted_data$FFP_DATE)
class(deleted_data$LOAD_TIME)
#因为入会时间和观测窗口结束时间都是字符串，所以更改数据类型
deleted_data$FFP_DATE <- as.Date(deleted_data$FFP_DATE)
deleted_data$LOAD_TIME <- as.Date(deleted_data$LOAD_TIME)
#计算客户入会时间，并将最终结果转为月数
deleted_data$L <- as.numeric((deleted_data$LOAD_TIME-deleted_data$FFP_DATE)/30)
#只选择LRFMC模型需要的5个属性
deleted_data <- deleted_data[,c('L','LAST_TO_END','FLIGHT_COUNT','SEG_KM_SUM','avg_di scount')]
#列名重命名
colnames(deleted_data) <- c('L','R','F','M','C')
#对数据分布进行查看，看是否需要标准化处理
summary(deleted_data)
#5个指标的数据范围差异太大，所以需要进行标准化处理
zscorefile <- scale(deleted_data)
#对列名再次重命名
colnames(zscorefile) <- c('ZL','ZR','ZF','ZM','ZC')
#利用K-Means构建LRFMC模型
result <- kmeans(zscorefile,5)
#查看各个类样本的数量
table(result$cluster)
#查看类中心
result$centers
#将各个聚类以柱形图展示
barplot(table(result$cluster),col=rainbow(5))
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) 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, max)
min <- apply(result$centers, 2, min)
data.radar <- data.frame(rbind(max, min, result$centers))
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
}
# 查看各簇个数占比 --饼图
# 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:k, sep = "", ": ", prob))
pie3D(data.pie, labels = lbls, labelcex = 0.8, explode = 0.1,
col = c("lightskyblue", "lightcyan", "turquoise", "lightskyblue3", "steelblue"))。