Análise de Conglomerados - Exemplo cluster mixed data type

#library(devtools)
#session_info()

#?daisy()
#artigo base para criar cluster com variáveis quali e quanti - Gower, J. C. (1971) A general coefficient of similarity and some of its properties, Biometrics 27, 857–874.

# dados qualificação
#dados<- read_excel("dados_tab.xlsx")
# dados defesa
dados<- read_excel("dados.xlsx")
row.names(dados) <- (c(
                     "Produtor 1",                     "Produtor 2",
                     "Produtor 3",                     "Produtor 4",
                     "Produtor 5",                     "Produtor 6",
                     "Produtor 7",                     "Produtor 8",
                     "Produtor 9",                     "PrOdutor 10"))

Setting row names on a tibble is deprecated.

#View(dados6)
str(dados)

Classes ‘tbl_df’, ‘tbl’ and 'data.frame':   10 obs. of  3 variables:
 $ a: num  1 1 1 1 1 2 2 2 2 2
 $ b: num  20 22 23 20 21 40 42 45 44 48
 $ c: num  1 1 2 2 2 3 3 3 3 3

dados$`a`<-factor(dados$`a`, levels = c("1","2"), labels = c("Proprietário","Arrendada"))
dados$`c`<-factor(dados$`c`, levels = c("1","2","3"), labels = c("Leiteira","Leiteira e cria","Leiteira,  cria, recria e engorda"))
#somente qualitativos
dados_quali <- dados[,c('a','c')]
#somente quantitativos
dados_quanti <-  dados[,c('b')]
#str(dados)
#  escolher o que vai empregar
#dados=dados_quanti
#dados = dados_quali
dados=dados

Descrição

glimpse(dados)

Observations: 10
Variables: 3
$ a <fct> Proprietário, Proprietário, Proprietário, Proprietário, Proprietário, Arrendada, Arrendada, Arrendada, Arrendada, Ar...
$ b <dbl> 20, 22, 23, 20, 21, 40, 42, 45, 44, 48
$ c <fct> Leiteira, Leiteira, Leiteira e cria, Leiteira e cria, Leiteira e cria, Leiteira,  cria, recria e engorda, Leiteira, ...

dados 

#stats4::summary(dados)

gower_dist <- daisy(dados, metric = "gower")
# Check attributes to ensure the correct methods are being used
# (I = interval',' N = nominal)
gower_dist

Dissimilarities :
            Produtor 1 Produtor 2 Produtor 3 Produtor 4 Produtor 5 Produtor 6 Produtor 7 Produtor 8 Produtor 9
Produtor 2  0.02380952                                                                                        
Produtor 3  0.36904762 0.34523810                                                                             
Produtor 4  0.33333333 0.35714286 0.03571429                                                                  
Produtor 5  0.34523810 0.34523810 0.02380952 0.01190476                                                       
Produtor 6  0.90476190 0.88095238 0.86904762 0.90476190 0.89285714                                            
Produtor 7  0.92857143 0.90476190 0.89285714 0.92857143 0.91666667 0.02380952                                 
Produtor 8  0.96428571 0.94047619 0.92857143 0.96428571 0.95238095 0.05952381 0.03571429                      
Produtor 9  0.95238095 0.92857143 0.91666667 0.95238095 0.94047619 0.04761905 0.02380952 0.01190476           
PrOdutor 10 1.00000000 0.97619048 0.96428571 1.00000000 0.98809524 0.09523810 0.07142857 0.03571429 0.04761905

Metric :  mixed ;  Types = N, I, N 
Number of objects : 10

summary(gower_dist)

45 dissimilarities, summarized :
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
0.01191 0.05952 0.89286 0.57857 0.94048 1.00000 
Metric :  mixed ;  Types = N, I, N 
Number of objects : 10

verificar a mais similar e mais dissimilar

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

dados[
  which(gower_mat == max(gower_mat[gower_mat != max(gower_mat)]),
        arr.ind = TRUE)[1, ], ]

ASSESSING CLUSTERING TENDENCY

fviz_dist(gower_dist, show_labels = FALSE)+ labs(title = "")

#The algorithm of the visual assessment of cluster tendency (VAT) approach (Bezdek and Hathaway, 2002) is as follow:
#The algorithm of VAT is as follow: 
# 1. Compute the dissimilarity (DM) matrix between the objects in the data set using the Euclidean distance measure (3)
# 2. Reorder the DM so that similar objects are close to one another. This process create an ordered dissimilarity matrix (ODM)
# 3. The ODM is displayed as an ordered dissimilarity image (ODI), which is the visual output of VAT
#The color level is proportional to the value of the dissimilarity between observations: pure red if dist(xi, xj) = 0 and pure blue if dist(xi, xj) = 1. Objects belonging to the same cluster are displayed in consecutive order.

algoritmo não hierárquico PAM

# Calculate silhouette width for many k using PAM
#gower_dist - matriz com as distâncias
sil_width <- c(NA)
for(i in 2:3){
  pam_fit <- pam(gower_dist,
                 diss = TRUE,
                 k = i)
  sil_width[i] <- pam_fit$silinfo$avg.width
}
# Plot sihouette width (higher is better)
plot(1:3, sil_width,
     xlab = "Number of clusters",
     ylab = "Silhouette Width")
lines(1:3, sil_width)

library(fpc)
pamk(gower_dist, diss=T,krange=2:3,criterion="asw", usepam=TRUE)

$`pamobject`
Medoids:
     ID              
[1,] "2" "Produtor 2"
[2,] "5" "Produtor 5"
[3,] "9" "Produtor 9"
Clustering vector:
 Produtor 1  Produtor 2  Produtor 3  Produtor 4  Produtor 5  Produtor 6  Produtor 7  Produtor 8  Produtor 9 PrOdutor 10 
          1           1           2           2           2           3           3           3           3           3 
Objective function:
     build       swap 
0.02857143 0.01904762 

Available components:
[1] "medoids"    "id.med"     "clustering" "objective"  "isolation"  "clusinfo"   "silinfo"    "diss"       "call"      

$nc
[1] 3

$crit
[1] 0.0000000 0.8587771 0.9417483

k=3
pam_fit <- pam(gower_dist, diss = TRUE, k)
dados[pam_fit$medoids, ]

print(pam_fit)

Medoids:
     ID              
[1,] "2" "Produtor 2"
[2,] "5" "Produtor 5"
[3,] "9" "Produtor 9"
Clustering vector:
 Produtor 1  Produtor 2  Produtor 3  Produtor 4  Produtor 5  Produtor 6  Produtor 7  Produtor 8  Produtor 9 PrOdutor 10 
          1           1           2           2           2           3           3           3           3           3 
Objective function:
     build       swap 
0.02857143 0.01904762 

Available components:
[1] "medoids"    "id.med"     "clustering" "objective"  "isolation"  "clusinfo"   "silinfo"    "diss"       "call"      

grp = pam_fit$clustering
#  como fazer com as dist?  só lançar data como matriz de distâncias
fviz_cluster(list(data = gower_dist, cluster = grp),
#palette = c("orange", "green","red","brown", "blue"),
ellipse.type = "convex", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = FALSE, ggtheme = theme_minimal())

Descrição dos grupos pelo PAM

pam_results <- dados %>%
  dplyr::mutate(cluster = pam_fit$clustering) %>%
  group_by(cluster) %>%
  do(the_summary = summary(.))
pam_results$the_summary

[[1]]
            a           b                                        c        cluster 
 Proprietário:2   Min.   :20.0   Leiteira                         :2   Min.   :1  
 Arrendada   :0   1st Qu.:20.5   Leiteira e cria                  :0   1st Qu.:1  
                  Median :21.0   Leiteira,  cria, recria e engorda:0   Median :1  
                  Mean   :21.0                                         Mean   :1  
                  3rd Qu.:21.5                                         3rd Qu.:1  
                  Max.   :22.0                                         Max.   :1  

[[2]]
            a           b                                         c        cluster 
 Proprietário:3   Min.   :20.00   Leiteira                         :0   Min.   :2  
 Arrendada   :0   1st Qu.:20.50   Leiteira e cria                  :3   1st Qu.:2  
                  Median :21.00   Leiteira,  cria, recria e engorda:0   Median :2  
                  Mean   :21.33                                         Mean   :2  
                  3rd Qu.:22.00                                         3rd Qu.:2  
                  Max.   :23.00                                         Max.   :2  

[[3]]
            a           b                                        c        cluster 
 Proprietário:0   Min.   :40.0   Leiteira                         :0   Min.   :3  
 Arrendada   :5   1st Qu.:42.0   Leiteira e cria                  :0   1st Qu.:3  
                  Median :44.0   Leiteira,  cria, recria e engorda:5   Median :3  
                  Mean   :43.8                                         Mean   :3  
                  3rd Qu.:45.0                                         3rd Qu.:3  
                  Max.   :48.0                                         Max.   :3  

Algoritmo Hierárquico

res.hc <- hclust(d = gower_dist, method = "ward.D2")
#Ward’s minimum variance method: It minimizes the total within-cluster variance. At each step the pair of clusters with minimum between-cluster distance are merged.
fviz_dist(gower_dist)

fviz_dend(res.hc, cex = 0.5)

# Compute cophentic distance
res.coph <- cophenetic(res.hc)
# Correlation between cophenetic distance and
# the original distance
cor(gower_dist, res.coph)

[1] 0.9950055

res.hc2 <- hclust(gower_dist, method = "average")
cor(gower_dist, cophenetic(res.hc2))

[1] 0.9977315

# Cut tree into k groups
#k=4
grp <- cutree(res.hc, k )
grp

 Produtor 1  Produtor 2  Produtor 3  Produtor 4  Produtor 5  Produtor 6  Produtor 7  Produtor 8  Produtor 9 PrOdutor 10 
          1           1           2           2           2           3           3           3           3           3 

table(grp)

grp
1 2 3 
2 3 5 

# Cut in 3 groups and color by groups
fviz_dend(res.hc, k , # Cut in k groups
cex = 0.5, # label size
k_colors = c("#2E9FDF", "#00AFBB", "#FC4E07", "#E7B800"),
color_labels_by_k = TRUE, # color labels by groups
rect = TRUE # Add rectangle around groups
)

Length of color vector was longer than the number of clusters - first k elements are used

#  como fazer com as dist?  só lançar data como matriz de distâncias
fviz_cluster(list(data = gower_dist, cluster = grp),
palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07", "red"),
ellipse.type = "convex", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = FALSE, ggtheme = theme_minimal())