1. 程式人生 > 其它 >《資料分析實戰》--用R做聚類分析《資料分析實戰》–用R做聚類分析

《資料分析實戰》--用R做聚類分析《資料分析實戰》–用R做聚類分析

《資料分析實戰》–用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)