R語言聚類—混合型數據集聚類

01-29

利用聚類分析，我們可以很容易地看清數據集中樣本的分布情況。以往介紹聚類分析的文章中通常只介紹如何處理連續型變數，這些文字並沒有過多地介紹如何處理混合型數據（如同時包含連續型變數、名義型變數和順序型變數的數據）。本文將利用 Gower 距離、PAM（partitioning around medoids）演算法和輪廓係數來介紹如何對混合型數據做聚類分析。

本文主要分為三個部分：

距離計算
聚類演算法的選擇
聚類個數的選擇

為了介紹方便，本文直接使用 ISLR 包中的 College 數據集。該數據集包含了自 1995 年以來美國大學的 777 條數據，其中主要有以下幾個變數：

連續型變數

錄取率
學費
新生數量

分類型變數

公立或私立院校
是否為高水平院校，即所有新生中畢業於排名前 10% 高中的新生數量佔比是否大於 50%

本文中涉及到的R包有：

In [3]:

set.seed(1680) # 設置隨機種子，使得本文結果具有可重現性nnlibrary(dplyr)nlibrary(ISLR)nlibrary(cluster)nlibrary(Rtsne)nlibrary(ggplot2)nnAttaching package: 『dplyr』nnThe following objects are masked from 『package:stats』:nn filter, lagnnThe following objects are masked from 『package:base』:nn intersect, setdiff, setequal, unionn

構建聚類模型之前，我們需要做一些數據清洗工作：

錄取率等於錄取人數除以總申請人數
判斷某個學校是否為高水平院校，需要根據該學校的所有新生中畢業於排名前 10% 高中的新生數量佔比是否大於 50% 來決定

In [5]:

college_clean <- College %>%n mutate(name = row.names(.),n accept_rate = Accept/Apps,n isElite = cut(Top10perc,n breaks = c(0, 50, 100),n labels = c("Not Elite", "Elite"),n include.lowest = TRUE)) %>%n mutate(isElite = factor(isElite)) %>%n select(name, accept_rate, Outstate, Enroll,n Grad.Rate, Private, isElite)nnglimpse(college_clean)nnObservations: 777nVariables: 7n$ name (chr) "Abilene Christian University", "Adelphi University", "...n$ accept_rate (dbl) 0.7421687, 0.8801464, 0.7682073, 0.8369305, 0.7564767, ...n$ Outstate (dbl) 7440, 12280, 11250, 12960, 7560, 13500, 13290, 13868, 1...n$ Enroll (dbl) 721, 512, 336, 137, 55, 158, 103, 489, 227, 172, 472, 4...n$ Grad.Rate (dbl) 60, 56, 54, 59, 15, 55, 63, 73, 80, 52, 73, 76, 74, 68,...n$ Private (fctr) Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes,...n$ isElite (fctr) Not Elite, Not Elite, Not Elite, Elite, Not Elite, Not...n

距離計算

聚類分析的第一步是定義樣本之間距離的度量方法，最常用的距離度量方法是歐式距離。然而歐氏距離只適用於連續型變數，所以本文將採用另外一種距離度量方法—— Gower 距離。

Gower 距離

Gower 距離的定義非常簡單。首先每個類型的變數都有特殊的距離度量方法，而且該方法會將變數標準化到[0,1]之間。接下來，利用加權線性組合的方法來計算最終的距離矩陣。不同類型變數的計算方法如下所示：

連續型變數：利用歸一化的曼哈頓距離
順序型變數：首先將變數按順序排列，然後利用經過特殊調整的曼哈頓距離
名義型變數：首先將包含 k 個類別的變數轉換成 k 個 0-1 變數，然後利用 Dice 係數做進一步的計算

優點：通俗易懂且計算方便
缺點：非常容易受無標準化的連續型變數異常值影響，所以數據轉換過程必不可少；該方法需要耗費較大的內存

利用 daisy 函數，我們只需要一行代碼就可以計算出 Gower 距離。需要注意的是，由於新生入學人數是右偏變數，我們需要對其做對數轉換。daisy 函數內置了對數轉換的功能，你可以調用幫助文檔來獲取更多的參數說明。

In [6]:

# Remove college name before clusteringnngower_dist <- daisy(college_clean[, -1],n metric = "gower",n type = list(logratio = 3))nn# Check attributes to ensure the correct methods are being usedn# (I = interval, N = nominal)n# Note that despite logratio being called, n# the type remains coded as "I"nnsummary(gower_dist)n

Out[6]:

301476 dissimilarities, summarized :n Min. 1st Qu. Median Mean 3rd Qu. Max. n0.0018601 0.1034400 0.2358700 0.2314500 0.3271400 0.7773500 nMetric : mixed ; Types = I, I, I, I, N, N nNumber of objects : 777n

此外，我們可以通過觀察最相似和最不相似的樣本來判斷該度量方法的合理性。本案例中，聖托馬斯大學和約翰卡羅爾大學最相似，而俄克拉荷馬科技和藝術大學和哈佛大學差異最大。

In [7]:

gower_mat <- as.matrix(gower_dist)nn# Output most similar pairnncollege_clean[n which(gower_mat == min(gower_mat[gower_mat != min(gower_mat)]),n arr.ind = TRUE)[1, ], ]n

Out[7]:

nameaccept_rateOutstateEnrollGrad.RatePrivateisElite682University of St. Thomas MN0.87846381171282889YesNot Elite284John Carroll University0.87112761170082089YesNot Elite

In [8]:

# Output most dissimilar pairnncollege_clean[n which(gower_mat == max(gower_mat[gower_mat != max(gower_mat)]),n arr.ind = TRUE)[1, ], ]n

Out[8]:

nameaccept_rateOutstateEnrollGrad.RatePrivateisElite673University of Sci. and Arts of Oklahoma0.9824561368720843NoNot Elite251Harvard University0.1561486184851606100YesElite

聚類演算法的選擇

現在我們已經計算好樣本間的距離矩陣，接下來需要選擇一個合適的聚類演算法，本文採用 PAM（partioniong around medoids）演算法來構建模型：

PAM 演算法的主要步驟：

隨機選擇 k 個數據點，並將其設為簇中心點
遍歷所有樣本點，並將樣本點歸入最近的簇中
對每個簇而言，找出與簇內其他點距離之和最小的點，並將其設為新的簇中心點
重複第2步，直到收斂

該演算法和 K-means 演算法非常相似。事實上，除了中心點的計算方法不同外，其他步驟都完全一致。

優點：簡單易懂且不易受異常值所影響
缺點：演算法時間複雜度為 O(n2)O(n2)

聚類個數的選擇

我們將利用輪廓係數來確定最佳的聚類個數，輪廓係數是一個用于衡量聚類離散度的內部指標，該指標的取值範圍是[-1,1]，其數值越大越好。通過比較不同聚類個數下輪廓係數的大小，我們可以看出當聚類個數為 3 時，聚類效果最好。

In [9]:

# Calculate silhouette width for many k using PAMnnsil_width <- c(NA)nnfor(i in 2:10){nn pam_fit <- pam(gower_dist,n diss = TRUE,n k = i)nn sil_width[i] <- pam_fit$silinfo$avg.widthnn}nn# Plot sihouette width (higher is better)nnplot(1:10, sil_width,n xlab = "Number of clusters",n ylab = "Silhouette Width")nlines(1:10, sil_width)n

聚類結果解釋

描述統計量

聚類完畢後，我們可以調用 summary 函數來查看每個簇的匯總信息。從這些匯總信息中我們可以看出：簇1主要是中等學費且學生規模較小的私立非頂尖院校，簇2主要是高收費、低錄取率且高畢業率的私立頂尖院校，而簇3則是低學費、低畢業率且學生規模較大的公立非頂尖院校。

In [18]:

pam_fit <- pam(gower_dist, diss = TRUE, k = 3)nnpam_results <- college_clean %>%n dplyr::select(-name) %>%n mutate(cluster = pam_fit$clustering) %>%n group_by(cluster) %>%n do(the_summary = summary(.))nnprint(pam_results$the_summary)nn[[1]]n accept_rate Outstate Enroll Grad.Rate Private n Min. :0.3283 Min. : 2340 Min. : 35.0 Min. : 15.00 No : 0 n 1st Qu.:0.7225 1st Qu.: 8842 1st Qu.: 194.8 1st Qu.: 56.00 Yes:500 n Median :0.8004 Median :10905 Median : 308.0 Median : 67.50 n Mean :0.7820 Mean :11200 Mean : 418.6 Mean : 66.97 n 3rd Qu.:0.8581 3rd Qu.:13240 3rd Qu.: 484.8 3rd Qu.: 78.25 n Max. :1.0000 Max. :21700 Max. :4615.0 Max. :118.00 n isElite cluster n Not Elite:500 Min. :1 n Elite : 0 1st Qu.:1 n Median :1 n Mean :1 n 3rd Qu.:1 n Max. :1 nn[[2]]n accept_rate Outstate Enroll Grad.Rate Private n Min. :0.1545 Min. : 5224 Min. : 137.0 Min. : 54.00 No : 4 n 1st Qu.:0.4135 1st Qu.:13850 1st Qu.: 391.0 1st Qu.: 77.00 Yes:65 n Median :0.5329 Median :17238 Median : 601.0 Median : 89.00 n Mean :0.5392 Mean :16225 Mean : 882.5 Mean : 84.78 n 3rd Qu.:0.6988 3rd Qu.:18590 3rd Qu.:1191.0 3rd Qu.: 94.00 n Max. :0.9605 Max. :20100 Max. :4893.0 Max. :100.00 n isElite cluster n Not Elite: 0 Min. :2 n Elite :69 1st Qu.:2 n Median :2 n Mean :2 n 3rd Qu.:2 n Max. :2 nn[[3]]n accept_rate Outstate Enroll Grad.Rate Private n Min. :0.3746 Min. : 2580 Min. : 153 Min. : 10.00 No :208 n 1st Qu.:0.6423 1st Qu.: 5295 1st Qu.: 694 1st Qu.: 46.00 Yes: 0 n Median :0.7458 Median : 6598 Median :1302 Median : 54.50 n Mean :0.7315 Mean : 6698 Mean :1615 Mean : 55.42 n 3rd Qu.:0.8368 3rd Qu.: 7748 3rd Qu.:2184 3rd Qu.: 65.00 n Max. :1.0000 Max. :15516 Max. :6392 Max. :100.00 n isElite cluster n Not Elite:199 Min. :3 n Elite : 9 1st Qu.:3 n Median :3 n Mean :3 n 3rd Qu.:3 n Max. :3 n

PAM 演算法的另一個優點是各個簇的中心點是實際的樣本點。從聚類結果中我們可以看出，聖弗朗西斯大學是簇1 的中心點，巴朗德學院是簇2 的中心點，而密歇根州州立大學河谷大學是簇3 的中心點。

In [19]:

college_clean[pam_fit$medoids, ]n

Out[19]:

nameaccept_rateOutstateEnrollGrad.RatePrivateisElite492Saint Francis College0.78776291088028469YesNot Elite38Barnard College0.56169871792653191YesElite234Grand Valley State University0.75256536108156157NoNot Elite

可視化方法

t-SNE 是一種降維方法，它可以在保留聚類結構的前提下，將多維信息壓縮到二維或三維空間中。藉助t-SNE我們可以將 PAM 演算法的聚類結果繪製出來，有趣的是私立頂尖院校和公立非頂尖院校這兩個簇中間存在一個小聚類簇。

In [22]:

tsne_obj <- Rtsne(gower_dist, is_distance = TRUE)nntsne_data <- tsne_obj$Y %>%n data.frame() %>%n setNames(c("X", "Y")) %>%n mutate(cluster = factor(pam_fit$clustering),n name = college_clean$name)nnggplot(aes(x = X, y = Y), data = tsne_data) +n geom_point(aes(color = cluster))n

進一步探究可以發現，這一小簇主要包含一些競爭力較強的公立院校，比如弗吉尼亞大學和加州大學伯克利分校。雖然無法通過輪廓係數指標來證明多分一類是合理的，但是這 13 所院校的確顯著不同於其他三個簇的院校。

In [25]:

tsne_data %>%n filter(X > 15 & X < 25,n Y > -15 & Y < -10) %>%n left_join(college_clean, by = "name") %>%n collect %>%n .[["name"]]n

[1] "Bentley College" "College Misericordia"

[3] "Fairfield University" "Fordham University"

[5] "Kings College" "La Salle University"

[7] "Lindenwood College" "Loyola Marymount University"

[9] "Manhattan College" "Marietta College"

[11] "Mercer University" "Otterbein College"

[13] "Providence College" "Quinnipiac College"

[15] "Rider University" "Saint Anselm College"

[17] "Saint Michaels College" "Saint Olaf College"

[19] "Santa Clara University" "Seattle University"

[21] "Siena College" "St. Marys College of California"

[23] "Stonehill College" "Taylor University"

[25] "University of Richmond" "University of San Diego"

[27] "University of Scranton"

最後的注意事項：處理較大的樣本和一次熱編碼

因為使用自定義距離度量值需要在內存中保持NxN矩陣，所以對於較大的樣本大小（在我的機器上大於10,000等），它開始變得明顯。對於聚類較大的樣本，我發現了兩個選項：

SPSS中的兩步聚類：基於模型的聚類方法可以處理分類和連續變數，並利用輪廓寬度（使用經驗法則截止值）來找到最佳聚類數。
使用歐幾里德距離對已經進行了一次熱編碼的數據：雖然計算速度更快，但是注意到，由於所有分類被重新編碼成稀疏矩陣，因此，這並不是最佳的，因為您遇到相當快速的維度詛咒。請注意，這種方法實際上與計算Gower距離中的骰子係數非常相似，只是將0-0不正確地標記為匹配。更多關於本中可以看到這個討論

原文鏈接：https://www.r-bloggers.com/clustering-mixed-data-types-in-r/

原文作者：Daniel P.Martin

譯者：斑馬