knitr::include_graphics("C:\\Users\\vicca\\OneDrive\\Documentos\\Imagenes\\4f3d5094475769.5e7fc15b9f947.gif")

Base de datos

CREAR BASE DE DE DATOS

#CREAR BASE
df<-data.frame(x=c(2,2,8,5,7,6,1,4),
               y=c(10,5,4,8,5,4,2,9))

DEERMINAR NUMERO DE GRUPOS

grupos <- 3

REALIZAR CLASIFICACION

segmentos<- kmeans(df,grupos)

REVISAR ASIGNACION DE GRUPOS

asignacion <- cbind(df, cluster=segmentos$cluster)

Crear clusters

GRAFICAR RESULTADOS

#install.packages("ggplot2")
library(ggplot2)
#install.packages("factoextra")
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
fviz_cluster(segmentos,data=df)

Optimizar grupos

library(cluster)
library(data.table)

set.seed(123)
optimizacion<-clusGap(df,FUN=kmeans,nstart=1,K.max = 7)

plot(optimizacion,xlab="Numero de clusters K")

LS0tDQp0aXRsZTogIkFuw6FsaXNpcyBkZSBjbHVzdGVycyINCmF1dGhvcjogIlZJQ1RPUiBDQVJERU5BUyINCmRhdGU6ICIyMDIzLTA5LTI4Ig0Kb3V0cHV0Og0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogInNpbXBsZXgiDQogICAgaGlnaGxpZ2h0OiAibW9ub2Nocm9tZSINCiAgDQotLS0NCg0KYGBge3J9DQprbml0cjo6aW5jbHVkZV9ncmFwaGljcygiQzpcXFVzZXJzXFx2aWNjYVxcT25lRHJpdmVcXERvY3VtZW50b3NcXEltYWdlbmVzXFw0ZjNkNTA5NDQ3NTc2OS41ZTdmYzE1YjlmOTQ3LmdpZiIpDQoNCmBgYA0KDQoNCiMgPHNwYW4gc3R5bGUgPSAiY29sb3I6IGJsdWU7Ij5CYXNlIGRlIGRhdG9zPC9zcGFuPg0KDQojIyBDUkVBUiBCQVNFIERFIERFIERBVE9TICANCmBgYHtyfQ0KI0NSRUFSIEJBU0UNCmRmPC1kYXRhLmZyYW1lKHg9YygyLDIsOCw1LDcsNiwxLDQpLA0KICAgICAgICAgICAgICAgeT1jKDEwLDUsNCw4LDUsNCwyLDkpKQ0KDQpgYGANCg0KIyMgREVFUk1JTkFSIE5VTUVSTyBERSBHUlVQT1MgIA0KYGBge3J9DQpncnVwb3MgPC0gMyANCg0KYGBgDQoNCiMjIFJFQUxJWkFSIENMQVNJRklDQUNJT04gIA0KYGBge3J9DQpzZWdtZW50b3M8LSBrbWVhbnMoZGYsZ3J1cG9zKQ0KDQpgYGANCg0KIyMgUkVWSVNBUiBBU0lHTkFDSU9OIERFIEdSVVBPUyAgDQpgYGB7cn0NCmFzaWduYWNpb24gPC0gY2JpbmQoZGYsIGNsdXN0ZXI9c2VnbWVudG9zJGNsdXN0ZXIpDQoNCmBgYA0KDQojIDxzcGFuIHN0eWxlID0gImNvbG9yOiBibHVlOyI+Q3JlYXIgY2x1c3RlcnM8L3NwYW4+ICANCg0KIyMgR1JBRklDQVIgUkVTVUxUQURPUyAgDQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJnZ3Bsb3QyIikNCmxpYnJhcnkoZ2dwbG90MikNCiNpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikNCmxpYnJhcnkoZmFjdG9leHRyYSkNCmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsZGF0YT1kZikNCg0KDQoNCmBgYA0KDQoNCiMgPHNwYW4gc3R5bGUgPSAiY29sb3I6IGJsdWU7Ij5PcHRpbWl6YXIgZ3J1cG9zPC9zcGFuPg0KDQpgYGB7cn0NCmxpYnJhcnkoY2x1c3RlcikNCmxpYnJhcnkoZGF0YS50YWJsZSkNCg0Kc2V0LnNlZWQoMTIzKQ0Kb3B0aW1pemFjaW9uPC1jbHVzR2FwKGRmLEZVTj1rbWVhbnMsbnN0YXJ0PTEsSy5tYXggPSA3KQ0KDQpwbG90KG9wdGltaXphY2lvbix4bGFiPSJOdW1lcm8gZGUgY2x1c3RlcnMgSyIpDQoNCg0KYGBgDQoNCg==