
Teoría
En este trabajo se realizarán análisis de clustering sobre la
esperanza de vida en cada estado de México.
Se agruparan segun:
- Esperanza de vida alta.
- Esperanza de vida media.
- Esperanza de vida baja.
Paso 1. Instalar paquetes y llamar
librerías
#install.packages("cluster") #"Análisis de agrupamiento"
library(cluster)
#install.packages("ggplot2") #Graficar
library(ggplot2)
#install.packages("data.table") #Manejo de muchos datos
library(data.table)
#install.packages("factoextra") #Gráfica optimización de número de clusters
library(factoextra)
library(readxl)
Paso 2. Obtener los datos
df <- read_excel("/Users/RigobertoGB/Desktop/Inteligencia Artificial con Impacto Empresarial/M2/Base de datos/esperanza_vida_2025.xlsx")
Paso 3. Entender los datos
summary(df)
## Entidad federativa Total
## Length:32 Min. :73.20
## Class :character 1st Qu.:74.38
## Mode :character Median :75.60
## Mean :75.48
## 3rd Qu.:76.47
## Max. :77.90
str(df)
## tibble [32 × 2] (S3: tbl_df/tbl/data.frame)
## $ Entidad federativa: chr [1:32] "Aguascalientes" "Baja California" "Baja California Sur" "Campeche" ...
## $ Total : num [1:32] 77 76.7 77.3 74.7 77.2 76.3 73.2 76.8 77 75.7 ...
Paso 4. Escalar los datos
# Solo si los datos no estan en la misma escala.
df1 <- scale(df$Total)
Paso 5. Determinar número de grupos
# Siempre es un valor inicial "Cualquiera", luego se optimiza.
grupos1 <- 3
Paso 6. Generar los grupos
set.seed(123)
clusters1 <- kmeans(df1,grupos1)
clusters1
## K-means clustering with 3 clusters of sizes 12, 12, 8
##
## Cluster means:
## [,1]
## 1 -1.0928690
## 2 0.2688426
## 3 1.2360397
##
## Clustering vector:
## [1] 3 3 3 1 3 2 1 3 3 2 2 1 1 2 2 1 1 2 3 1 1 2 2 2 2 3 1 2 1 1 2 1
##
## Within cluster sum of squares by cluster:
## [1] 1.5917245 1.4032052 0.5830493
## (between_SS / total_SS = 88.5 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
Paso 7. optimizar el número de grupos
#set.seed(123)
#optimizacion1 <-clusGap(df1, FUN=kmeans, nstart=1, K.max=7)
#El K,max normalmente es 10, en este ejercicio al se 8 datos se dejó en 7.
#plot(optimizacion1, xlab="Número de clusters k")
#se selecciona como óptimo el primer puntos más alto.
Paso 8. Graficar los grupos
#fviz_cluster(clusters1,data=df1)
Paso 9. Agregar Clusters a la Base de
Datos
df1_clusters <-cbind(df,clusters = clusters1$cluster)
head(df1_clusters)
## Entidad federativa Total clusters
## 1 Aguascalientes 77.0 3
## 2 Baja California 76.7 3
## 3 Baja California Sur 77.3 3
## 4 Campeche 74.7 1
## 5 Coahuila 77.2 3
## 6 Colima 76.3 2
Conclusiones
La técnica de Clustering permite identificar grupos
naturales de los datos sin etiquetas previas. En este caso, se observa
como cada estado tiene su cluster. Hay estados grandes como nuevo león y
ciudad de méixco que tienen mayor calidad de vida y estados mas pequeñas
que tienen menos calidad de vida como Tabasco o Veracruz, sin embargo,
se encuentran estados grandes con menor calidad de vida y viceversa.
LS0tCnRpdGxlOiAiQ2x1c3RlcmluZyAtIEVzcGVyYW56YSBkZSBWaWRhIgphdXRob3I6ICJKb3NlIFJpZ29iZXJ0byBBMDE3MzU5OTQiCmRhdGU6ICIyMDI1LTA4LTE5IgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IFRydWUKICAgIHRvY19mbG9hdDogVHJ1ZQogICAgY29kZV9kb3dubG9hZDogVHJ1ZQogICAgdGhlbWU6IHlldGkKLS0tCgohW10oaHR0cHM6Ly9uZW1kaWdpdGFsc3RvcmFnZS5ibG9iLmNvcmUud2luZG93cy5uZXQvbmVtLW1haW4vaW1hZ2VzLzIwMjMvMDUvMjcvMmIxMTE2MmMtMjQzOS00ODExLWExNWUtODdlMzVhMjBjNjEwLnBuZykKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gVGVvcsOtYSA8L3NwYW4+CkVuIGVzdGUgdHJhYmFqbyBzZSByZWFsaXphcsOhbiBhbsOhbGlzaXMgZGUgY2x1c3RlcmluZyBzb2JyZSBsYSBlc3BlcmFuemEgZGUgdmlkYSBlbiBjYWRhIGVzdGFkbyBkZSBNw6l4aWNvLiAKClNlIGFncnVwYXJhbiBzZWd1bjoKCiogRXNwZXJhbnphIGRlIHZpZGEgYWx0YS4gCiogRXNwZXJhbnphIGRlIHZpZGEgbWVkaWEuICAgCiogRXNwZXJhbnphIGRlIHZpZGEgYmFqYS4gCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gMS4gSW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hcyA8L3NwYW4+CgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQojaW5zdGFsbC5wYWNrYWdlcygiY2x1c3RlciIpICMiQW7DoWxpc2lzIGRlIGFncnVwYW1pZW50byIKbGlicmFyeShjbHVzdGVyKQojaW5zdGFsbC5wYWNrYWdlcygiZ2dwbG90MiIpICNHcmFmaWNhcgpsaWJyYXJ5KGdncGxvdDIpCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikgI01hbmVqbyBkZSBtdWNob3MgZGF0b3MgCmxpYnJhcnkoZGF0YS50YWJsZSkKI2luc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKSAjR3LDoWZpY2Egb3B0aW1pemFjacOzbiBkZSBuw7ptZXJvIGRlIGNsdXN0ZXJzCmxpYnJhcnkoZmFjdG9leHRyYSkKbGlicmFyeShyZWFkeGwpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBQYXNvIDIuIE9idGVuZXIgbG9zIGRhdG9zIDwvc3Bhbj4KYGBge3J9CmRmIDwtIHJlYWRfZXhjZWwoIi9Vc2Vycy9SaWdvYmVydG9HQi9EZXNrdG9wL0ludGVsaWdlbmNpYSBBcnRpZmljaWFsIGNvbiBJbXBhY3RvIEVtcHJlc2FyaWFsL00yL0Jhc2UgZGUgZGF0b3MvZXNwZXJhbnphX3ZpZGFfMjAyNS54bHN4IikKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gMy4gRW50ZW5kZXIgbG9zIGRhdG9zIDwvc3Bhbj4KYGBge3J9CnN1bW1hcnkoZGYpCnN0cihkZikKYGBgCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyA0LiBFc2NhbGFyIGxvcyBkYXRvcyA8L3NwYW4+CmBgYHtyfQojIFNvbG8gc2kgbG9zIGRhdG9zIG5vIGVzdGFuIGVuIGxhIG1pc21hIGVzY2FsYS4KZGYxIDwtIHNjYWxlKGRmJFRvdGFsKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyA1LiBEZXRlcm1pbmFyIG7Dum1lcm8gZGUgZ3J1cG9zIDwvc3Bhbj4KCmBgYHtyfQojIFNpZW1wcmUgZXMgdW4gdmFsb3IgaW5pY2lhbCAiQ3VhbHF1aWVyYSIsIGx1ZWdvIHNlIG9wdGltaXphLgpncnVwb3MxIDwtIDMKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gNi4gR2VuZXJhciBsb3MgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CnNldC5zZWVkKDEyMykKY2x1c3RlcnMxIDwtIGttZWFucyhkZjEsZ3J1cG9zMSkKY2x1c3RlcnMxCmBgYAojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gNy4gb3B0aW1pemFyIGVsIG7Dum1lcm8gZGUgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CiNzZXQuc2VlZCgxMjMpCiNvcHRpbWl6YWNpb24xIDwtY2x1c0dhcChkZjEsIEZVTj1rbWVhbnMsIG5zdGFydD0xLCBLLm1heD03KQojRWwgSyxtYXggbm9ybWFsbWVudGUgZXMgMTAsIGVuIGVzdGUgZWplcmNpY2lvIGFsIHNlIDggZGF0b3Mgc2UgZGVqw7MgZW4gNy4gCiNwbG90KG9wdGltaXphY2lvbjEsIHhsYWI9Ik7Dum1lcm8gZGUgY2x1c3RlcnMgayIpCiNzZSBzZWxlY2Npb25hIGNvbW8gw7NwdGltbyBlbCBwcmltZXIgcHVudG9zIG3DoXMgYWx0by4KCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBQYXNvIDguIEdyYWZpY2FyIGxvcyBncnVwb3MgPC9zcGFuPgpgYGB7cn0KI2Z2aXpfY2x1c3RlcihjbHVzdGVyczEsZGF0YT1kZjEpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBQYXNvIDkuIEFncmVnYXIgQ2x1c3RlcnMgYSBsYSBCYXNlIGRlIERhdG9zIDwvc3Bhbj4KYGBge3J9CmRmMV9jbHVzdGVycyA8LWNiaW5kKGRmLGNsdXN0ZXJzID0gY2x1c3RlcnMxJGNsdXN0ZXIpCmhlYWQoZGYxX2NsdXN0ZXJzKQpgYGAKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBDb25jbHVzaW9uZXMgPC9zcGFuPgpMYSB0w6ljbmljYSBkZSAqQ2x1c3RlcmluZyogcGVybWl0ZSBpZGVudGlmaWNhciBncnVwb3MgbmF0dXJhbGVzIGRlIGxvcyBkYXRvcyBzaW4gZXRpcXVldGFzIHByZXZpYXMuIEVuIGVzdGUgY2Fzbywgc2Ugb2JzZXJ2YSBjb21vIGNhZGEgZXN0YWRvIHRpZW5lIHN1IGNsdXN0ZXIuIEhheSBlc3RhZG9zIGdyYW5kZXMgY29tbyBudWV2byBsZcOzbiB5IGNpdWRhZCBkZSBtw6lpeGNvIHF1ZSB0aWVuZW4gbWF5b3IgY2FsaWRhZCBkZSB2aWRhIHkgZXN0YWRvcyBtYXMgcGVxdWXDsWFzIHF1ZSB0aWVuZW4gbWVub3MgY2FsaWRhZCBkZSB2aWRhIGNvbW8gVGFiYXNjbyBvIFZlcmFjcnV6LCBzaW4gZW1iYXJnbywgc2UgZW5jdWVudHJhbiBlc3RhZG9zIGdyYW5kZXMgY29uIG1lbm9yIGNhbGlkYWQgZGUgdmlkYSB5IHZpY2V2ZXJzYS4gCgo=