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=