1 引言
最近終于把機器學習的算法部分整完了，可以再玩一個例子义屏。這次是抽取《R語言數據分析與挖掘實戰(zhàn)》里面一個航空公司客戶價值分析的例子靠汁。
前一部分在書中有代碼蜂大，可以直接一步一步敲上去闽铐。后面拓展部分，作品也只是留了個思路奶浦，我就順著思路做了下去兄墅，結果雖然有一定的準確度，但還是有點寒磣澳叉。還需要更加修正來提高精準度隙咸。學習還得繼續(xù)沐悦。
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五個指標作為航空公司識別客戶價值指標本砰。
傳統(tǒng)的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)
但由于各個指標之間的取值范圍差異較大，于是采取標準化處理來消除數量級的影響凭豪。
# 數據讀取
datafile <- read.csv('zscoredata.csv', header = TRUE)
# 數據標準化
zscoredfile <- scale(datafile)
colnames(zscoredfile)=c("ZL","ZR","ZF","ZM","ZC")
# 數據寫出
write.csv(zscoredfile, 'zscoreddata.csv')
3 聚類分析
現在就可以對其進行聚類分析了焙蹭，當然，在聚類分析的同時嫂伞，要結合業(yè)務的理解孔厉。
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各個屬性上的特點就可以分辨清楚了拼余。（至于各個屬性結合起來代表的客戶類型需要根據業(yè)務進行判斷污桦，感興趣的看書咯）
# 查看各簇個數占比 --餅圖
# 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")
在客戶類型分辨好之后，就可以根據客戶的特點制定不同策論的營銷策略匙监。同時凡橱，每隔半年要對模型進行重新訓練小作，以保持其穩(wěn)定性。
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曲線真心有不準乞而，麻煩就在于送悔，我已經嘗試了調整算法里的各種參數，結果也基本沒怎么變化爪模。所以欠啤，最近看了寒小陽的博客，打算再試試模型融合深入挖掘一下屋灌。
6 問題與總結：
殘留的問題在于：
- 如何設計更好的算法洁段，讓模型的精準度更高
- 在算法特定的前提下，如何設計選取特征量共郭，使模型更準確
也已經請教了迷途和vivian桑：
一把特征工程做好哗戈，選的predictor好能提高征冷，很多predictor correlated的話有時候不好；
二把數據transformation做好，比如中心化啊～標準化啊瞎嬉，log一下你的predictor；
三加入一些interaction或者predictor的平方可以抓一些high order moment的信息莹弊；
四一般非線性關系多的時候可以試試決策樹隨機森林神經網絡等等～
“針對同一批數據毕匀，改善預測準確性的方法，有幾種年缎，進去模型的數據悔捶，不同算法，算法的不同參數单芜。以往的經驗蜕该，效果比較明顯的是盡量折騰進入模型的數據。對數據的處理層面洲鸠，單一指標可以衍生n多指標堂淡，比如環(huán)比，同比扒腕，占比等等淤齐。數據量綱不同引起的問題，數據標準化（歸一化）都是要嘗試處理的”
哎袜匿，路途遙遠更啄，繼續(xù)努力。
