आर के लिए देश द्वारा शराब वरीयताओं के एक क्लस्टर विश्लेषण का एक सरल उदाहरण

नमस्कार, हेब्र! आज मैं क्लस्टर विश्लेषण करने के तरीके का एक छोटा सा उदाहरण साझा करना चाहता हूं। इस उदाहरण में, पाठक को तंत्रिका नेटवर्क और अन्य फैशनेबल दिशाएं नहीं मिलेंगी। यह उदाहरण अन्य डेटा के लिए एक छोटा और पूर्ण क्लस्टर विश्लेषण करने के लिए एक संदर्भ बिंदु के रूप में काम कर सकता है। कोई भी दिलचस्पी - बिल्ली में आपका स्वागत है।

तुरंत एक आरक्षण करें, यह लेख किसी भी तरह से पूरी तरह से अकादमिक होने का दावा नहीं करता है, प्राप्त परिणामों की विशिष्टता या मुद्दे की कवरेज की पूर्णता। लेख का उद्देश्य शास्त्रीय क्लस्टर विश्लेषण के बुनियादी चरणों का प्रदर्शन करना है, जिसका उपयोग सरल और सार्थक (संभवतः अधिक विस्तृत अध्ययन से पहले) किया जा सकता है। योग्यता पर किसी भी सुधार, टिप्पणी और परिवर्धन का स्वागत है।

डेटा प्रति व्यक्ति शराब की खपत के प्रतिशत के रूप में 2010 के लिए मादक पेय (बीयर, शराब, आत्माओं, आदि) द्वारा प्रति व्यक्ति देश द्वारा शराब की खपत का एक नमूना है। डेटा में यह भी शामिल है: शुद्ध शराब के ग्राम में प्रति व्यक्ति औसत दैनिक शराब की खपत और प्रति व्यक्ति (सभी रिकॉर्ड किए गए + बेहिसाब) शराब की खपत (केवल शुद्ध शराब के लीटर में पीने वाले)।

इसी समय, प्रत्येक देश सशर्त रूप से भौगोलिक समूहों में से एक से संबंधित है: पूर्व, केंद्र और पश्चिम। विभाजन विभिन्न कारणों से बहुत ही मनमाना और बहुत विवादास्पद है, लेकिन हमारे पास जो है, उससे आगे बढ़ेंगे। डेटा स्रोत - शराब और स्वास्थ्य पर वैश्विक स्थिति रिपोर्ट 2014, एस 289-364

(हाथ से पेंट किया हुआ, त्रुटियां हो सकती हैं, लेकिन सामान्य विचार, मुझे लगता है, समझ में आता है)

प्रारंभिक विश्लेषण

उपयोग किए गए पुस्तकालयों को कनेक्ट करें।

library(rgl)
library(heplots)
library(MVN)
library(klaR)
library('Morpho')
library(caret)
library(mclust)
library(ggplot2)
library(GGally)
library(plyr)
library(psych)
library(GPArotation)
library(ggpubr)

, .

#    
data <- read.table("alcohol_data.csv", header=TRUE,  sep=",")
#      
rownames(data) <- make.names(data[,1], unique = TRUE)
#     ,   
data <- data[,-1]
data <- na.omit(data)
#    
head(data)

summary(data)

, . , Other , , , , . , , , , . , . - .

, , , .

options(rgl.useNULL=TRUE)
open3d()
mfrow3d(2,2)
levelColors <- c('west'='blue', 'east'='red', 'center'='yellow')
plot3d(data$Beer, data$Wine, data$Spirit, xlab="Beer", ylab="Wine", zlab="Spirit", col = levelColors[data$Group], size=3)

widget <- rglwidget()
widget

, . , .

ggpairs(
  data,
  mapping = ggplot2::aes(color = data$Group),
  upper = list(continuous = wrap("cor", alpha = 0.5), combo = "box"),
  lower = list(continuous = wrap("points", alpha = 0.3), combo = wrap("dot", alpha = 0.4)),
  diag = list(continuous = wrap("densityDiag",alpha = 0.5)),
  title = "Alcohol"
)

Average Total , Average.

data <- data[, -6]

, , , , . .

data[data$Wine>60,]

, , , , - , , .

data[data$Spirit>70,]
data[data$Spirit<10,]

, , .

,

split(data[,1:5],data$Group)

$center

$east

$west

ggpairs(
  data,
  mapping = ggplot2::aes(color = data$Group),
  diag=list(continuous="bar", alpha=0.4)
)

, , . Other, : , , , ( 10-12 , 45, , ). . , , , (). , , . Other .

, , — , — . , — , .
Total Other, . .

, Beer, Spirit Wine . , , , . , , , , , .

Total. , — .

data.group = data[,5]
data <- data[,-5]
data<- data[,-4]

Elbow method (“ ”, “ ”). , k, – W(K), .

library(factoextra)
fviz_nbclust(data, kmeans, method = "wss") +
  labs(subtitle = "Elbow method") +
  geom_vline(xintercept = 4, linetype = 2)

data.dist <- dist((data))
hc <- hclust(data.dist, method = "ward.D2")
plot(hc, cex = 0.7)

. .

colors=c('green', 'red', 'blue')
hcd = as.dendrogram(hc)
clusMember = cutree(hc, 4)
colLab <- function(n) {
    if (is.leaf(n)) {
        a <- attributes(n)
        labCol <- colors[data.group[n]]
        attr(n, "nodePar") <- c(a$nodePar, lab.col = labCol)
    }
    n
}
clusDendro = dendrapply(hcd, colLab)
plot(clusDendro, main = "Cool Dendrogram", type = "triangle")

rect.hclust(hc, k = 4)

. , .
, , , 4 .

plot(clusDendro, main = "Cool Dendrogram", type = "triangle")
data.hclas_group <- factor(cutree(hc, k = 3))

rect.hclust(hc, k = 3)

, , .

library(FactoMineR)
res.pca <- PCA(data,scale.unit=T, graph = F)
fviz_pca_biplot(res.pca, 
                col = colors[data.hclas_group], palette = "jco", 
                label = "var",
                ellipse.level = 0.8,
                 addEllipses = T,
                col.var = "black",
                legend.title = "groups4")

, , . , , , , . , , , k-++.

library(flexclust)
data.kk <- kcca(data, k=3, family=kccaFamily("kmeans"),
control=list(initcent="kmeanspp"))

fviz_pca_biplot(res.pca, 
                col.ind =as.factor(data.kk@cluster), palette = "jco", 
                label = "var",
                ellipse.level = 0.8,
                 addEllipses = T,
                col.var = "black", repel = TRUE,
                legend.title = "clusters")

, k- . , , .

, , hclust. .

, , . . , .

. . , , , . , , . , .

सूचना मानदंड ( यहां वर्णन ) का उपयोग करके क्लस्टर मॉडल की धारणा के आधार पर क्लस्टरिंग करना संभव होगा , साथ ही इस डेटा सेट के लिए शास्त्रीय भेदभावपूर्ण विश्लेषण का प्रयास करें। यदि यह लेख उपयोगी था, तो मैं अगली कड़ी प्रकाशित करने की योजना बना रहा हूं।