El algoritmo de K-Means es una técnica popular de aprendizaje no supervisado para agrupar observaciones.
Uno de los retos en la aplicación de los métodos de aprendizaje de máquinas es el manejo de información redundante. Se considera que la información es redundante cuando a partir de unas variables se pueden inferir las otras.
Un ejemplo de redundancia es la correlación alta entre variables. Si dos variables están altamente correlacionadas, conocer lo que pasa con una permite saber lo que pasa con la otra. Este problema también se conoce como colinealidad.
Por otro lado, la estabilidad de un método de aprendizaje de máquina se puede entender de diferentes maneras. Cambios pequeños en el conjunto de entrenamiento no producen cambios significativos en: * a) en los parámetros estimados del modelo (estabilidad en los parámetros) o * b) en las salidas del modelo (cambio en las predicciones del modelo)
Uno de los retos de la redundancia es que puede afectar la estabilidad de los métodos de aprendizaje de máquina. En particular, en K-Medias la estabilidad se puede establecer como la variabilidad de los centroides finales cada vez que se cambian los centroides iniciales. Cuando cambiar los centroides iniciales no modifica los centroides finales, se puede considerar que el método tiene un comportamiento estable respecto a la inicialización.
Entender cómo la correlación entre las variables numéricas puede afectar la estabilidad de los centroides en el algoritmo de K-Medias utilizando escenarios de simulación.
Se deberá desarrollar un experimento de simulación para analizar la estabilidad del algoritmo de K-Means. Para ello se proponen los siguientes pasos.
M_cor<-matrix(c(1,0.6,0.6,1),ncol=2)
M_cov<-cor2cov(M_cor,sd=c(1,1))
M_cov_pd<-as.matrix(nearPD(M_cov)$mat)
n1<-50 # Tamaño de la muestra de la clase 1
n2<-80 # Tamaño de la muestra de la clase 2
n3<-40 # Tamaño de la muestra de la clase 2
mu1<-c(0.5,1.5) # Vector de medias de la clase 1
mu2<-c(-1,1.5) # Vector de medias de la clase 2
mu3<-c(-2,1.5) # Vector de medias de la clase 3
set.seed(1)
muestra1<-rmvnorm(n=n1,mean=mu1,sigma=M_cov_pd,method="eigen")
muestra2<-rmvnorm(n=n2,mean=mu2,sigma=M_cov_pd,method="eigen")
muestra3<-rmvnorm(n=n3,mean=mu3,sigma=M_cov_pd,method="eigen")
muestra_nosep<-rbind(muestra1,muestra2,muestra3)
clase<-c(rep(-1,n1),rep(1,n2),rep(2,n3))
muestra_nosep_df<-data.frame(muestra_nosep,clase)
plot(muestra_nosep,
col=(clase+2),
pch=(clase+2),
ylim=c(-2,6),xlim=c(-6,6),
xaxt="n",yaxt="n",
xlab=expression(x[1]),
ylab=expression(x[2]),
main="Tres grupos que se traslapan",
las=1,cex=1.5,lwd=2)
grid()
legend("topleft",legend=c("Grupo 1", "Grupo 2","Grupo 3"),
pch=c(1,3,4),col=c(1,3,4),pt.lwd=2,pt.cex=1.8,bty="n")
set.seed(1)
kmeans <- kmeans(muestra_nosep_df[,-3], 3)
muestra_nosep_df$clase <- kmeans$cluster
ggplot() + geom_point(aes(x = X1, y = X2, color = clase), data = muestra_nosep_df, size = 2) +
scale_colour_gradientn(colours=rainbow(4)) +
geom_point(aes(x = kmeans$centers[, 1], y = kmeans$centers[, 2]), color = 'black', size = 3) +
ggtitle('Clusters de Datos con k = 3 / K-Medios') +
xlab('X1') + ylab('X2')+theme_minimal()
M_cor<-matrix(c(1,0.6,0.6,1),ncol=2)
M_cov<-(cor2cov(M_cor,sd=c(1,1)))
M_cov_pd<-as.matrix(nearPD(M_cov)$mat)
n1<-50 # Tamaño de la muestra de la clase 1
n2<-80 # Tamaño de la muestra de la clase 2
mu1<-c(0.5,1.5) # Vector de medias de la clase 1
mu2<-c(-1,1.5) # Vector de medias de la clase 2
mu3<-0 # Vector de medias de la clase 3
set.seed(1)
ei=rnorm(n1, mean = 0, sd = 1)
muestra1<-rmvnorm(n=n1,mean=mu1,sigma=M_cov_pd,method="eigen")
muestra2<-rmvnorm(n=n2,mean=mu2,sigma=M_cov_pd,method="eigen")
muestra3<-muestra1 + ei
muestra_nosep1<-rbind(muestra1,muestra2,muestra3)
clase<-c(rep(-1,n1),rep(1,n2),rep(2,nrow(muestra3)))
muestra_nosep_df1<-data.frame(muestra_nosep1,clase)
#var(muestra_nosep_df1[muestra_nosep_df1$clase == 2, c(-3)])
var(muestra3)
## [,1] [,2]
## [1,] 1.4677841 0.9360953
## [2,] 0.9360953 1.1417175
paste("la varianza x3 es:",var(muestra3)[1,1]+var(muestra3)[2,2],sep = " ")
## [1] "la varianza x3 es: 2.60950162692468"
var(muestra3[,1])
## [1] 1.467784
var(muestra3[,2])
## [1] 1.141718
BD_muesta1_muestra3<-muestra_nosep_df1 %>%
subset(clase %in% c(-1,2))
BD_muesta1_muestra3<-BD_muesta1_muestra3[,1:2]
#####--- Cálculo del vector de medias y matriz de covarianzas
med=apply(BD_muesta1_muestra3,2,mean)
sc=cov(BD_muesta1_muestra3) ####### S
s=sc*(n1-1)/n1 ####### Sn=matriz de covarianzas
s
## X1 X2
## X1 1.1597309 0.7022751
## X2 0.7022751 0.9600855
paste("la covarianza entre x1 y x3 es:",round(s[1,2],3),sep = " ")
## [1] "la covarianza entre x1 y x3 es: 0.702"
paste("la correlación entre x1 y x3 es:",round(cor(BD_muesta1_muestra3[,1],BD_muesta1_muestra3[,2]),3),sep = " ")
## [1] "la correlación entre x1 y x3 es: 0.666"
set.seed(1)
kmeans1 <- kmeans(muestra_nosep_df1[,-3], 3)
muestra_nosep_df1$clase <- kmeans1$cluster
ggplot() + geom_point(aes(x = X1, y = X2, color = clase), data = muestra_nosep_df1, size = 2) +
scale_colour_gradientn(colours=rainbow(4)) +
geom_point(aes(x = kmeans1$centers[, 1], y = kmeans1$centers[, 2]), color = 'black', size = 3) +
ggtitle('') +
xlab('X1') + ylab('X2')+theme_minimal()
###Centroides punto 2
cetroid_pun2<- kmeans$centers
cetroid_pun2
## X1 X2
## 1 0.9173872 2.240028
## 2 -0.8540011 1.646614
## 3 -2.1873421 0.736740
###Centroides cambio en muestra 3
cetroid_pun3<- kmeans1$centers
cetroid_pun3
## X1 X2
## 1 -0.05159587 1.2446157
## 2 -1.59414980 0.9266082
## 3 1.14860014 2.5464171
paste0("Al agregar la variable x3 se nota un cambio en la posición de los centroides del cluster")
## [1] "Al agregar la variable x3 se nota un cambio en la posición de los centroides del cluster"
M_cor<-matrix(c(1,0.6,0.6,1),ncol=2)
M_cov<-(cor2cov(M_cor,sd=c(1,1)))
M_cov_pd<-as.matrix(nearPD(M_cov)$mat)
n1<-50 # Tamaño de la muestra de la clase 1
n2<-80 # Tamaño de la muestra de la clase 2
mu1<-c(0.5,1.5) # Vector de medias de la clase 1
mu2<-c(-1,1.5) # Vector de medias de la clase 2
mu3<-0 # Vector de medias de la clase 3
set.seed(1)
ei=rnorm(n1, mean = 0, sd = 4)
muestra1<-rmvnorm(n=n1,mean=mu1,sigma=M_cov_pd,method="eigen")
muestra2<-rmvnorm(n=n2,mean=mu2,sigma=M_cov_pd,method="eigen")
muestra3<-muestra1 + ei
muestra_nosep2<-rbind(muestra1,muestra2,muestra3)
clase<-c(rep(-1,n1),rep(1,n2),rep(2,nrow(muestra3)))
muestra_nosep_df2<-data.frame(muestra_nosep2,clase)
set.seed(1)
kmeans2 <- kmeans(muestra_nosep_df2[,-3], 3)
muestra_nosep_df2$clase <- kmeans2$cluster
ggplot() + geom_point(aes(x = X1, y = X2, color = clase), data = muestra_nosep_df2, size = 2) +
scale_colour_gradientn(colours=rainbow(4)) +
geom_point(aes(x = kmeans2$centers[, 1], y = kmeans2$centers[, 2]), color = 'black', size = 3) +
ggtitle('') +
xlab('X1') + ylab('X2')+theme_minimal()
###Centroides epsilon con desviación standar=1
cetroid_pun3<- kmeans1$centers
cetroid_pun3
## X1 X2
## 1 -0.05159587 1.2446157
## 2 -1.59414980 0.9266082
## 3 1.14860014 2.5464171
###Centroides epsilon con desviación standar=4
cetroid_pun4<- kmeans2$centers
cetroid_pun4
## X1 X2
## 1 -0.4931862 1.366406
## 2 -5.0332454 -3.353521
## 3 3.0190109 3.942491
paste0("Al aumentar la varianza del epsilon de la variable x3= x1 + epsilon los centroides cambian")
## [1] "Al aumentar la varianza del epsilon de la variable x3= x1 + epsilon los centroides cambian"
M_cor<-matrix(c(1,0.6,0.6,1),ncol=2)
M_cov<-(cor2cov(M_cor,sd=c(1,1)))
M_cov_pd<-as.matrix(nearPD(M_cov)$mat)
n1<-50 # Tamaño de la muestra de la clase 1
n2<-60 # Tamaño de la muestra de la clase 2
mu1<-c(0.5,1.5) # Vector de medias de la clase 1
mu2<-c(-1,1.5) # Vector de medias de la clase 2
mu3<-0 # Vector de medias de la clase 3
set.seed(1)
ei=rnorm(n1, mean = 0, sd = 1)
ej=rnorm(n2, mean = 0, sd = 2)
ek=rnorm(n2, mean = 0, sd = 5)
en=rnorm(n1, mean = 0, sd = 4)
muestra1<-rmvnorm(n=n1,mean=mu1,sigma=M_cov_pd,method="eigen")
muestra2<-rmvnorm(n=n2,mean=mu2,sigma=M_cov_pd,method="eigen")
muestra3<-muestra1 + ei
muestra4<-muestra2 + ej
muestra5<-muestra3 + en
muestra6<-muestra2 + ek
muestra_nosep1<-rbind(muestra1,muestra2,muestra3,muestra4,muestra5,muestra6)
clase<-c(rep(-1,n1),rep(1,n2),rep(2,nrow(muestra3)),rep(3,nrow(muestra4)),rep(4,nrow(muestra5)),rep(5,nrow(muestra6)))
muestra_nosep_df1<-data.frame(muestra_nosep1,clase)
set.seed(1)
kmeans3 <- kmeans(muestra_nosep_df1[,-3], 6)
muestra_nosep_df1$clase <- kmeans3$cluster
ggplot() + geom_point(aes(x = X1, y = X2, color = clase), data = muestra_nosep_df1, size = 2) +
scale_colour_gradientn(colours=rainbow(4)) +
geom_point(aes(x = kmeans3$centers[, 1], y = kmeans3$centers[, 2]), color = 'black', size = 3) +
ggtitle('') +
xlab('X1') + ylab('X2')+theme_minimal()
###Centroides punto 3
cetroid_pun3<- kmeans2$centers
cetroid_pun3
## X1 X2
## 1 -0.4931862 1.366406
## 2 -5.0332454 -3.353521
## 3 3.0190109 3.942491
###Centroides agregando más variables y aumentando la varianza
cetroid_pun4<- kmeans3$centers
cetroid_pun4
## X1 X2
## 1 0.6118035 2.0555689
## 2 2.9161685 4.6229972
## 3 -1.4997137 0.9778477
## 4 -3.6399738 -1.6103290
## 5 7.3938482 9.2747898
## 6 -7.9055742 -5.6834327
M_cor<-matrix(c(1,0.6,0.6,1),ncol=2)
M_cov<-(cor2cov(M_cor,sd=c(1,1)))
M_cov_pd<-as.matrix(nearPD(M_cov)$mat)
n1<-50 # Tamaño de la muestra de la clase 1
n2<-60 # Tamaño de la muestra de la clase 2
mu1<-c(0.5,1.5) # Vector de medias de la clase 1
mu2<-c(-1,1.5) # Vector de medias de la clase 2
mu3<-0 # Vector de medias de la clase 3
set.seed(1)
ei=rnorm(n1, mean = 0, sd = 3)
ej=rnorm(n2, mean = 0, sd = 4)
ek=rnorm(n2, mean = 0, sd = 6)
en=rnorm(n1, mean = 0, sd = 7)
muestra1<-rmvnorm(n=n1,mean=mu1,sigma=M_cov_pd,method="eigen")
muestra2<-rmvnorm(n=n2,mean=mu2,sigma=M_cov_pd,method="eigen")
muestra3<-muestra1 + ei
muestra4<-muestra2 + ej
muestra5<-muestra3 + en
muestra6<-muestra2 + ek
muestra_nosep1<-rbind(muestra1,muestra2,muestra3,muestra4,muestra5,muestra6)
clase<-c(rep(-1,n1),rep(1,n2),rep(2,nrow(muestra3)),rep(3,nrow(muestra4)),rep(4,nrow(muestra5)),rep(5,nrow(muestra6)))
muestra_nosep_df1<-data.frame(muestra_nosep1,clase)
set.seed(1)
kmeans4 <- kmeans(muestra_nosep_df1[,-3], 6)
muestra_nosep_df1$clase <- kmeans4$cluster
ggplot() + geom_point(aes(x = X1, y = X2, color = clase), data = muestra_nosep_df1, size = 2) +
scale_colour_gradientn(colours=rainbow(4)) +
geom_point(aes(x = kmeans4$centers[, 1], y = kmeans4$centers[, 2]), color = 'black', size = 3) +
ggtitle('') +
xlab('X1') + ylab('X2')+theme_minimal()
###Centroides punto 3
cetroid_anteriores<- kmeans3$centers
cetroid_anteriores
## X1 X2
## 1 0.6118035 2.0555689
## 2 2.9161685 4.6229972
## 3 -1.4997137 0.9778477
## 4 -3.6399738 -1.6103290
## 5 7.3938482 9.2747898
## 6 -7.9055742 -5.6834327
###Centroides agregando más variables
cetroid_pun4<- kmeans4$centers
cetroid_pun4
## X1 X2
## 1 5.084329 6.7727419
## 2 1.122769 2.7539673
## 3 -1.217594 0.9065223
## 4 -4.258527 -2.0935199
## 5 11.387556 12.9974295
## 6 -9.431592 -7.4581402
paste0("Al aumentar la varianza del epsilon de la variables nuevas los centroides cambian")
## [1] "Al aumentar la varianza del epsilon de la variables nuevas los centroides cambian"
[1] Introduction to Statistical Learning, Gareth James, Daniela Witten, Trevor Hastie and Robert Tibshirani libro Points of Significance: Clustering, Nature Methods, Martin Krzywinski & Naomi Altman
[2] Practical Guide to Cluster Analysis in R, Alboukadel kassambara
[3] Cluster Analysis for Gene Expression Data: A Survey. Daxin Jiang, Chun Tang, Aidong Zhang, Department of Computer Science and Engineering Ward’s Hierarchical Agglomerative Clustering Method: Which Algorithms Implement Ward’s Criterion? by Fionn Murtagh y Pierre Legendre
[4] clValid, an R package for cluster validation. Guy Brock, Vasyl Pihur, Susmita Datta, and Somnath Datta Department of Bioinformatics and Biostatistics, University of Louisville https://en.wikipedia.org/wiki/Jaccard_index
[5] How Many Clusters? Which Clustering Method? Answers Via Model-Based Cluster Analysis. C. Fraley and A. E. Raftery https://en.wikipedia.org/wiki/DBSCAN