library(dplyr)
library(cluster)
library(factoextra)
library(fpc)
library(NbClust)
data(iris)
dim(iris)
## [1] 150   5
head(iris,3)
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
table(iris$Species)
## 
##     setosa versicolor  virginica 
##         50         50         50
data_iris=iris[,-5]

data_iris=scale(data_iris)
head(data_iris)
##      Sepal.Length Sepal.Width Petal.Length Petal.Width
## [1,]   -0.8976739  1.01560199    -1.335752   -1.311052
## [2,]   -1.1392005 -0.13153881    -1.335752   -1.311052
## [3,]   -1.3807271  0.32731751    -1.392399   -1.311052
## [4,]   -1.5014904  0.09788935    -1.279104   -1.311052
## [5,]   -1.0184372  1.24503015    -1.335752   -1.311052
## [6,]   -0.5353840  1.93331463    -1.165809   -1.048667
summary(data_iris)
##   Sepal.Length       Sepal.Width       Petal.Length      Petal.Width     
##  Min.   :-1.86378   Min.   :-2.4258   Min.   :-1.5623   Min.   :-1.4422  
##  1st Qu.:-0.89767   1st Qu.:-0.5904   1st Qu.:-1.2225   1st Qu.:-1.1799  
##  Median :-0.05233   Median :-0.1315   Median : 0.3354   Median : 0.1321  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.67225   3rd Qu.: 0.5567   3rd Qu.: 0.7602   3rd Qu.: 0.7880  
##  Max.   : 2.48370   Max.   : 3.0805   Max.   : 1.7799   Max.   : 1.7064

K-medias:

Algoritmo de clustering que se caracteriza porque el centro de cada uno de los grupos corresponde al promedio de los individuos pertenecientes a dichos grupos.

set.seed(301020)
fit_k=kmeans(data_iris,centers = 3)
fviz_cluster(object = fit_k,data = data_iris)

res=data.frame(iris,grupo=fit_k$cluster)
table(res$Species,res$grupo)
##             
##               1  2  3
##   setosa      0 50  0
##   versicolor 11  0 39
##   virginica  36  0 14
res=res %>% mutate(grupo=recode(grupo,"1"="virginica","2"="setosa","3"="versicolor"))
res_fin=table(res$Species,res$grupo)
res_fin
##             
##              setosa versicolor virginica
##   setosa         50          0         0
##   versicolor      0         39        11
##   virginica       0         14        36
sum(diag(res_fin))/sum(res_fin)
## [1] 0.8333333

K-medoides:

Difiere del algoritmo K-medias en el sentido de que en este caso, el centro de los cluster será un objeto propio de estos cuya disimilaridad es la mínima. Es decir, en cada grupo habrá un lider, este será el que menos sea diferentes de todos los elementos del grupo.

fit=pam(data_iris,k = 3,metric = "euclidean")
fviz_cluster(fit,data = data_iris)

base=data.frame(iris,cluster=fit$clustering)
table(base$Species,base$cluster)
##             
##               1  2  3
##   setosa     50  0  0
##   versicolor  0  9 41
##   virginica   0 36 14
base2=base %>% mutate(cluster=recode(cluster, "1"="setosa","2"="virginica","3"="versicolor"))
res=table(base2$Species,base2$cluster)
res
##             
##              setosa versicolor virginica
##   setosa         50          0         0
##   versicolor      0         41         9
##   virginica       0         14        36
sum(diag(res))/sum(res)
## [1] 0.8466667

Clustering Large Aplication:

Este algoritmo de clustering está diseñado para datasets grades, con miles de observaciones. Ayuda a evitar costos, problemas de memoria y tiempo.

for (i in 1:20) {
  fit2=clara(x = data_iris,k = 3,samples = i)
  res_base=data.frame(iris,grupo=fit2$clustering)
  res3=table(res_base$Species,res_base$grupo)
  re=sum(diag(res3))/sum(res3)
  cat(paste("La precisión con ", i, "muestras", "es de ", round(re,4),"\n"))
}
## La precisión con  1 muestras es de  0.82 
## La precisión con  2 muestras es de  0.5133 
## La precisión con  3 muestras es de  0.5133 
## La precisión con  4 muestras es de  0.8333 
## La precisión con  5 muestras es de  0.88 
## La precisión con  6 muestras es de  0.88 
## La precisión con  7 muestras es de  0.88 
## La precisión con  8 muestras es de  0.88 
## La precisión con  9 muestras es de  0.88 
## La precisión con  10 muestras es de  0.88 
## La precisión con  11 muestras es de  0.88 
## La precisión con  12 muestras es de  0.88 
## La precisión con  13 muestras es de  0.88 
## La precisión con  14 muestras es de  0.4667 
## La precisión con  15 muestras es de  0.4667 
## La precisión con  16 muestras es de  0.4667 
## La precisión con  17 muestras es de  0.4667 
## La precisión con  18 muestras es de  0.4667 
## La precisión con  19 muestras es de  0.4667 
## La precisión con  20 muestras es de  0.4667
fit_clara=clara(x = data_iris,k = 3,samples = 5)

fviz_cluster(fit_clara)

res_base=data.frame(iris,grupo=fit_clara$clustering)
table(res_base$Species,res_base$grupo)
##             
##               1  2  3
##   setosa     49  1  0
##   versicolor  0 37 13
##   virginica   0  4 46
res_base=res_base %>% mutate(grupo=recode(grupo,"1"="setosa","2"="versicolor","3"="virginica"))
res3=table(res_base$Species,res_base$grupo)
res3
##             
##              setosa versicolor virginica
##   setosa         49          1         0
##   versicolor      0         37        13
##   virginica       0          4        46
sum(diag(res3))/sum(res3)
## [1] 0.88

Validación de algoritmos de Cluster

dist=dist(data_iris)

Análisis de Silueta:

sil.km=silhouette(x = fit_k$cluster,dist = dist)
fviz_silhouette(sil.km)
##   cluster size ave.sil.width
## 1       1   47          0.35
## 2       2   50          0.64
## 3       3   53          0.39

sil.kmedo=silhouette(fit$clustering,dist=dist)
fviz_silhouette(sil.kmedo)
##   cluster size ave.sil.width
## 1       1   50          0.63
## 2       2   45          0.35
## 3       3   55          0.38

sil.clara=silhouette(fit_clara$clustering,dist=dist)
fviz_silhouette(sil.clara)
##   cluster size ave.sil.width
## 1       1   49          0.64
## 2       2   42          0.39
## 3       3   59          0.32

Se observa que el coficiente de la silueta es muy similar para los 3 algoritmos de clustering, por lo que no se puede concluir el algoritmo con mejor calidad de agrupamiento.

Indice de Dunn:

El indice de Dunn nos ayuda a evaluar la calidad de agrupamiento, obtenida por un algoritmo de clustering. Un valor más alto de este indice indica un mejor rendimiento del algoritmo.

km_stat=cluster.stats(d = dist,clustering = fit_k$cluster)
km_stat$dunn
## [1] 0.02649665
kmedo_stat=cluster.stats(d=dist,clustering = fit$clustering)
kmedo_stat$dunn
## [1] 0.05711919
kclara_stat=cluster.stats(d = dist,clustering = fit_clara$clustering)
kclara_stat$dunn
## [1] 0.07787829

Comparación de clusters resultantes:

res.comp=cluster.stats(d = dist,clustering = fit_k$cluster,fit$clustering)
res.comp$corrected.rand
## [1] 0.9223377
res.comp2=cluster.stats(d = dist,clustering = fit$clustering,alt.clustering = fit_clara$clustering)
res.comp2$corrected.rand
## [1] 0.7394335
res.comp3=cluster.stats(d = dist,clustering = fit_k$cluster,alt.clustering = fit_clara$clustering)
res.comp3$corrected.rand
## [1] 0.7689905

Los algoritmos que más parecidos segun la forma en que clusterizaron son los correspondientes a K-Medias y K-Medoides.

Clustering Avanzado basado en modelos.

library(mclust)

mclust=Mclust(data = data_iris,G = 3)
fviz_cluster(mclust,data_iris)

resultado=data.frame(iris, grupo=mclust$classification)
table(resultado$Species,resultado$grupo)
##             
##               1  2  3
##   setosa     50  0  0
##   versicolor  0 45  5
##   virginica   0  0 50
resultado=resultado %>% mutate(grupo=recode(grupo,'1'='setosa','2'='versicolor','3'='virginica'))
resp=table(resultado$Species,resultado$grupo)
resp
##             
##              setosa versicolor virginica
##   setosa         50          0         0
##   versicolor      0         45         5
##   virginica       0          0        50
sum(diag(resp))/sum(resp)
## [1] 0.9666667

Se puede observar como el clustering basado en modelos logró acertar en el 97% (aproximadamente) de los casos, esto puede indicar que este algoritmo tiene buena capacidad de agrupamiento.