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多指标,比如环比,同比,占比等等。数据量纲不同引起的问题,数据标准化(归一化)都是要尝试处理的”
哎,路途遥远,继续努力。
网友评论