《資料分析實戰》--用R做聚類分析《資料分析實戰》–用R做聚類分析
阿新 • • 發佈:2021-06-29
《資料分析實戰》–用R做聚類分析
本文參考的是 《資料分析實戰》
的第八章。
背景: 針對某公司的產品,現目前需要服務好已有的使用者,針對不同的使用者群體設計並推廣不同的營銷策略。
現狀: 目標使用者不明確。
預期: 明確目標使用者群。
讀取資料
讀取Dau資料:
> dau <- read.csv('dau.csv',header = T,stringsAsFactors = F) > head(dau) log_date app_name user_id 1 2013-05-01 game-01 608801 2 2013-05-01 game-01 712453 3 2013-05-01 game-01 776853 4 2013-05-01 game-01 823486 5 2013-05-01 game-01 113600 6 2013-05-01 game-01 452478 [/code] 讀取Dpu資料: ```code > dpu <- read.csv('dpu.csv',header = T,stringsAsFactors = F) > head(dpu) log_date app_name user_id payment 1 2013-05-01 game-01 804005 571 2 2013-05-01 game-01 793537 81 3 2013-05-01 game-01 317717 81 4 2013-05-01 game-01 317717 81 5 2013-05-01 game-01 426525 324 6 2013-05-01 game-01 540544 243 [/code] 讀取使用者行為資料: ```code > user.action <- read.csv('action.csv',header = T,stringsAsFactors = F) > head(user.action) log_date app_name user_id A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 A11 A12 ... A54 1 2013-10-31 game-01 654133 0 0 0 0 0 0 0 0.00 0 0 0 0 ... 46 2 2013-10-31 game-01 425530 0 0 0 0 10 1 233 58.25 288 230 19 2 ... 71 3 2013-10-31 game-01 709596 0 0 0 0 0 0 0 0.00 0 0 0 0 ... 2 4 2013-10-31 game-01 525047 0 2 0 0 9 0 0 0.00 177 160 0 0 ... 109 5 2013-10-31 game-01 796908 0 0 0 0 0 0 0 0.00 5 30 0 0 ... 64 6 2013-10-31 game-01 776120 0 0 0 0 9 0 0 0.00 325 195 38 8 ... 312 [/code] 其中列A1 ~ A54 表示各種行為的編碼,這些行為的編碼和行為日誌名稱是通過另外一份資料表來管理的。 * * * ## 資料處理 1.將Dau和Dpu合併: ```code # 合併消費額資料 > dau2 <- merge(dau, dpu[, c("log_date", "user_id", "payment"), ], by = c("log_date", "user_id"), all.x = T) # 新增消費額標誌位 > dau2$is.payment <- ifelse(is.na(dau2$payment), 0, 1) # 將無消費記錄的消費額設為0 > dau2$payment <- ifelse(is.na(dau2$payment), 0, dau2$payment) > head(dau2) log_date user_id app_name payment is.payment 1 2013-05-01 1141 game-01 0 0 2 2013-05-01 1689 game-01 0 0 3 2013-05-01 2218 game-01 0 0 4 2013-05-01 3814 game-01 0 0 5 2013-05-01 3816 game-01 0 0 6 2013-05-01 4602 game-01 0 0 [/code] 2.按月統計: ```code # 增加一列表示月份 > dau2$log_month <- substr(dau2$log_date,1,7) # 按月統計 > mau <- ddply(dau2, + .(log_month,user_id), + summarize, + payment = sum(payment), + access_days=length(log_date)) > head(mau) log_month user_id payment access_days 1 2013-05 65 0 1 2 2013-05 115 0 1 3 2013-05 194 0 1 4 2013-05 426 0 4 5 2013-05 539 0 1 6 2013-05 654 0 1 [/code] * * * ## 資料分析 現狀我們通過聚類來對資料進行分析: 1.確定類的個數: 可以使用k-means 方法,將排行榜得分作為變數,把使用者分為3 個類。 k-means 方法可以通過kmeans 函式來執行,但該方法的缺點是結果不穩定。ykmeans 程式包中的ykmeans 函式,在內部將kmeans 函式執行了100 次,因此能夠獲得穩定的結果。 ```code > library(ykmeans) > library(ggplot2) > library(scales) # A47為排行榜得分 > user.action2 <- ykmeans(user.action,"A47", "A47", 3) # 每個類的人數 > table(user.action2$cluster) 1 2 3 2096 479 78 [/code] 對確定好的類進行畫圖: ```code # 排行榜得分的分佈 > ggplot(arrange(user.action2,desc(A47)), + aes(x=1:length(user_id),y=A47, + col=as.factor(cluster), + shape=as.factor(cluster)))+ + geom_line()+ + xlab("user")+ + ylab("Ranking point")+ + scale_y_continuous(labels = comma)+ + ggtitle("Ranking point")+ + theme(legend.position = "none") [/code] ![這裡寫圖片描述](https://img- blog.csdn.net/20180604160236934?watermark/2/text/aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L0NvY2FpbmVfYmFp/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70) 2.限定排名考前的使用者: ```code > user.action.h <- user.action2[user.action2$cluster >= 2,names(user.action)] [/code] 3.進行主成分分析: 行為日誌裡儲存著使用者所有行為的記錄,可能存在各個行為之間相互影響的情況。另外,由於使用者有的行為並沒有發生,因此值為0 的行為記錄有很多。所以我們實際上拿到的資料並不會像教科書中的資料那樣工整。在這種情況下,很有可能無法執行k-means 方法,因此我們要將數值大都為0 的變數和相關性較高的變數刪除掉,然後利用主成分分析進行正交變換。 ```code # 用於機器學習的庫 # 利用庫中包含的函式進行資料的前期處理 > library(caret) > user.action.f <- user.action.h[, -c(1:4)] > row.names(user.action.f) <- user.action.h$user_id > head(user.action.f) # 刪除那些資訊量小的變數 > nzv <- nearZeroVar(user.action.f) > user.action.f.filterd <- user.action.f[,-nzv] # 刪除那些相關性高的變數 > user.action.cor <- cor(user.action.f.filterd) > highly.cor.f <- findCorrelation(user.action.cor,cutoff=.7) > user.action.f.filterd <- user.action.f.filterd[,-highly.cor.f] # 進行主成分分析 # pca > user.action.pca.base <- prcomp(user.action.f.filterd, scale = T) [/code] 4.進行聚類: ```code > user.action.pca <- data.frame(user.action.pca.base$x) > keys <- names(user.action.pca) > user.action.km <- ykmeans(user.action.pca, keys, "PC1", 3:6) > table(user.action.km$cluster) 1 2 3 4 5 23 228 88 164 54 [/code] 結果如下圖: ```code > ggplot(user.action.km, + aes(x=PC1,y=PC2,col=as.factor(cluster), shape=as.factor(cluster))) + + geom_point() [/code] ![這裡寫圖片描述](https://img- blog.csdn.net/2018060417034743?watermark/2/text/aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L0NvY2FpbmVfYmFp/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70) 5.形成雷達圖: ```code df.filterd <- createRadarChartDataFrame(scale(df.filterd)) names(df.filterd) radarchart(df.filterd, seg = 5, plty = 1:5, plwd = 4, pcol = rainbow(5)) legend("topright", legend = 1:5, col = rainbow(5), lty = 1:5) [/code] ![這裡寫圖片描述](https://img- blog.csdn.net/20180604171147708?watermark/2/text/aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L0NvY2FpbmVfYmFp/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70) 具體結果如上圖,至此,資料分析結束~ * * * ![在這裡插入圖片描述](https://img-blog.csdnimg.cn/20210608151750993.gif)