Contexto

Estos datos son el resultado de un estudio llevado a cabo por el INEGI, en el que se menciona sobre la aportación al PIB nacional por entidad federativa en 2022.

El análisis determinó el aporte de cada uno de los 32 estados.

Instalar paquetes y llamar librerías

rm(list=ls())
#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 optimizazción de número de clusters
library(factoextra)
#Housekeeping
rm(list=ls())

Paso2. Obtener los datos

d <- read.csv("/Users/luisenrique/Downloads/Documentos/Módulo 2/PIB_por_Estado.csv",sep = ";")

Paso 3. Entender los datos

summary(d)
##     Estado               PIBE        
##  Length:33          Min.   : 143717  
##  Class :character   1st Qu.: 314083  
##  Mode  :character   Median : 527322  
##                     Mean   : 756902  
##                     3rd Qu.: 920284  
##                     Max.   :3640388  
##                     NA's   :1
str(d)
## 'data.frame':    33 obs. of  2 variables:
##  $ Estado: chr  "Ciudad de México" "Estado de México" "Nuevo León" "Jalisco" ...
##  $ PIBE  : int  3640388 2184863 1945060 1783505 1128686 1032889 929459 922287 919617 820790 ...

Paso 4. Escalar los datos

# Sólo si los datos no están en la misma escala
df1 <- na.omit(d)

#df1 <- scale(df)

Paso 5. Determinar el número de grupos

# Siempre es un valor inical "cualquiera", luego se optimiza. 
#plot(df1)
grupos1 <-4

Paso 6. Generar los grupos

set.seed(123)
clusters1 <- kmeans(df1$PIBE,grupos1)
clusters1
## K-means clustering with 4 clusters of sizes 12, 8, 8, 4
## 
## Cluster means:
##        [,1]
## 1  260449.1
## 2  913167.8
## 3  529538.4
## 4 2388454.0
## 
## Clustering vector:
##  [1] 4 4 4 4 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 1 1 1 1 1 1 1 1 1 1 1 1
## 
## Within cluster sum of squares by cluster:
## [1] 8.418346e+10 1.091070e+11 5.784211e+10 2.171350e+12
##  (between_SS / total_SS =  85.4 %)
## 
## 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)
#optimizacion <- clusGap(df1$PIBE,FUN=kmeans, nstart=1,K.max=10)
#el K.max normalmente es 10, en este ejercicio al ser 8 datos se dejó en 7
#plot(optimizacion, xlab="Número de Clusters k")
# Se selecciona como óptimo el primer punto 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(df1,cluster=clusters1$cluster)
head(df1_clusters)
##                            Estado    PIBE cluster
## 1                Ciudad de México 3640388       4
## 2                Estado de México 2184863       4
## 3                      Nuevo León 1945060       4
## 4                         Jalisco 1783505       4
## 5                      Guanajuato 1128686       2
## 6 Veracruz de Ignacio de la Llave 1032889       2

Conclusiones

La técnica de clustering permite identificar patrones o grupos naturales en los datos sin necesidad de etiquetas previas.

En este caso, también se puede apreciar como los estados que más contribuyen al PIB de México son:

  • Ciudad de México
  • Estado de México
  • Nuevo León
LS0tCnRpdGxlOiAiQ2x1c3RlcmluZyAtIFBJQiBwb3IgRXN0YWRvIGVuIE3DqXhpY28iCmF1dGhvcjogIkEwMTczNzY0NCIKZGF0ZTogIjIwMjUtMDgtMTkiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogVFJVRQogICAgdG9jX2Zsb2F0OiBUUlVFCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICB0aGVtZTogY29zbW8KLS0tCgohW10oaHR0cHM6Ly9yZWFsZXN0YXRlbWFya2V0LmNvbS5teC9pbWFnZXMvMjAyNS8wNC1hYnJpbC8zMC9tZXhpY28tZXNxdWl2YS1sYS1yZWNlc2lvbi10ZWNuaWNhLXBpYi1jcmVjZS0wLTE2LWVuLWVsLXByaW1lci10cmltZXN0cmUtZy5naWYpCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZXZpb2xldDsiPiBDb250ZXh0byA8L3NwYW4+CgpFc3RvcyBkYXRvcyBzb24gZWwgcmVzdWx0YWRvIGRlIHVuIGVzdHVkaW8gbGxldmFkbyBhIGNhYm8gcG9yIGVsIElORUdJLCBlbiBlbCBxdWUgc2UgbWVuY2lvbmEgc29icmUgbGEgYXBvcnRhY2nDs24gYWwgUElCIG5hY2lvbmFsIHBvciBlbnRpZGFkIGZlZGVyYXRpdmEgZW4gMjAyMi4gIAoKRWwgYW7DoWxpc2lzIGRldGVybWluw7MgZWwgYXBvcnRlIGRlIGNhZGEgdW5vIGRlIGxvcyAzMiBlc3RhZG9zLiAgIAoKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWV2aW9sZXQ7Ij4gSW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hcyA8L3NwYW4+Cgo8L3NwYW4+CgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpybShsaXN0PWxzKCkpCiNpbnN0YWxsLnBhY2thZ2VzKCJjbHVzdGVyIikgICNBbsOhbGlzaXMgZGUgQWdydXBhbWllbnRvCmxpYnJhcnkoY2x1c3RlcikKI2luc3RhbGwucGFja2FnZXMoImdncGxvdDIiKSAjR3JhZmljYXIKbGlicmFyeShnZ3Bsb3QyKQojaW5zdGFsbC5wYWNrYWdlcygiZGF0YS50YWJsZSIpICNNYW5lam8gZGUgbXVjaG9zIGRhdG9zIApsaWJyYXJ5KGRhdGEudGFibGUpCiNpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikgI0dyw6FmaWNhIG9wdGltaXphemNpw7NuIGRlIG7Dum1lcm8gZGUgY2x1c3RlcnMKbGlicmFyeShmYWN0b2V4dHJhKQpgYGAKCmBgYHtyfQojSG91c2VrZWVwaW5nCnJtKGxpc3Q9bHMoKSkKYGBgCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZXZpb2xldDsiPiBQYXNvMi4gT2J0ZW5lciBsb3MgZGF0b3MgPC9zcGFuPgpgYGB7cn0KZCA8LSByZWFkLmNzdigiL1VzZXJzL2x1aXNlbnJpcXVlL0Rvd25sb2Fkcy9Eb2N1bWVudG9zL01vzIFkdWxvIDIvUElCX3Bvcl9Fc3RhZG8uY3N2IixzZXAgPSAiOyIpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZXZpb2xldDsiPiBQYXNvIDMuIEVudGVuZGVyIGxvcyBkYXRvcyA8L3NwYW4+CmBgYHtyfQpzdW1tYXJ5KGQpCnN0cihkKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWV2aW9sZXQ7Ij4gUGFzbyA0LiBFc2NhbGFyIGxvcyBkYXRvcyA8L3NwYW4+CmBgYHtyfQojIFPDs2xvIHNpIGxvcyBkYXRvcyBubyBlc3TDoW4gZW4gbGEgbWlzbWEgZXNjYWxhCmRmMSA8LSBuYS5vbWl0KGQpCgojZGYxIDwtIHNjYWxlKGRmKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWV2aW9sZXQ7Ij4gUGFzbyA1LiBEZXRlcm1pbmFyIGVsIG7Dum1lcm8gZGUgZ3J1cG9zICAgPC9zcGFuPgpgYGB7cn0KIyBTaWVtcHJlIGVzIHVuIHZhbG9yIGluaWNhbCAiY3VhbHF1aWVyYSIsIGx1ZWdvIHNlIG9wdGltaXphLiAKI3Bsb3QoZGYxKQpncnVwb3MxIDwtNApgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWV2aW9sZXQ7Ij4gUGFzbyA2LiBHZW5lcmFyIGxvcyBncnVwb3MgPC9zcGFuPgpgYGB7cn0Kc2V0LnNlZWQoMTIzKQpjbHVzdGVyczEgPC0ga21lYW5zKGRmMSRQSUJFLGdydXBvczEpCmNsdXN0ZXJzMQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWV2aW9sZXQ7Ij4gUGFzbyA3LiBPcHRpbWl6YXIgZWwgbsO6bWVybyBkZSBncnVwb3MgPC9zcGFuPgpgYGB7cn0KI3NldC5zZWVkKDEyMykKI29wdGltaXphY2lvbiA8LSBjbHVzR2FwKGRmMSRQSUJFLEZVTj1rbWVhbnMsIG5zdGFydD0xLEsubWF4PTEwKQojZWwgSy5tYXggbm9ybWFsbWVudGUgZXMgMTAsIGVuIGVzdGUgZWplcmNpY2lvIGFsIHNlciA4IGRhdG9zIHNlIGRlasOzIGVuIDcKI3Bsb3Qob3B0aW1pemFjaW9uLCB4bGFiPSJOw7ptZXJvIGRlIENsdXN0ZXJzIGsiKQojIFNlIHNlbGVjY2lvbmEgY29tbyDDs3B0aW1vIGVsIHByaW1lciBwdW50byBtw6FzIGFsdG8KYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVldmlvbGV0OyI+IFBhc28gOC4gIEdyYWZpY2FyIGxvcyBncnVwb3MgPC9zcGFuPgpgYGB7cn0KI2Z2aXpfY2x1c3RlcihjbHVzdGVyczEsZGF0YT1kZjEpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZXZpb2xldDsiPiBQYXNvIDkuIEFncmVnYXIgY2x1c3RlcnMgYSBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4KYGBge3J9CmRmMV9jbHVzdGVycyA8LSBjYmluZChkZjEsY2x1c3Rlcj1jbHVzdGVyczEkY2x1c3RlcikKaGVhZChkZjFfY2x1c3RlcnMpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZXZpb2xldDsiPiBDb25jbHVzaW9uZXMgPC9zcGFuPgpMYSB0w6ljbmljYSBkZSAqY2x1c3RlcmluZyogcGVybWl0ZSBpZGVudGlmaWNhciBwYXRyb25lcyBvIGdydXBvcyBuYXR1cmFsZXMgZW4gbG9zIGRhdG9zIHNpbiBuZWNlc2lkYWQgZGUgZXRpcXVldGFzIHByZXZpYXMuCgpFbiBlc3RlIGNhc28sIHRhbWJpw6luIHNlIHB1ZWRlIGFwcmVjaWFyIGNvbW8gbG9zIGVzdGFkb3MgcXVlIG3DoXMgY29udHJpYnV5ZW4gYWwgUElCIGRlIE3DqXhpY28gc29uOiAKCiogQ2l1ZGFkIGRlIE3DqXhpY28KKiBFc3RhZG8gZGUgTcOpeGljbwoqIE51ZXZvIExlw7NuCg==