Contexto

Estos datos representan el volumen de producción de agave para mezcal en México durante el año 2024, desglosado por estado.

El análisis refleja la contribución de 11 estados productores, destacando Oaxaca como el líder absoluto, seguido por Michoacán y Guanajuato. La información permite comparar la escala de producción entre regiones y muestra la distribución geográfica de la industria mezcalera en el país.

P.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 optimizazción de número de clusters
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

Paso2. Obtener los datos

df <- read.csv("C:\\Users\\Max\\Desktop\\UNI TEC\\7mo semestre\\modulo 2\\R\\act mexico agave\\agave.csv")

P.3 Entender los datos

summary(df)
##     Estado          Volumen_Toneladas
##  Length:11          Min.   :   270   
##  Class :character   1st Qu.:  2761   
##  Mode  :character   Median : 12449   
##                     Mean   : 35338   
##                     3rd Qu.: 38744   
##                     Max.   :193428
str(df)
## 'data.frame':    11 obs. of  2 variables:
##  $ Estado           : chr  "Oaxaca" "Michoacán" "Guanajuato" "Guerrero" ...
##  $ Volumen_Toneladas: num  193428 74713 41440 36049 18693 ...

P.4 Determinar el numero de grupos

# Siempre es un valor inicial "cualquiera", luego se optimiza
grupos1 <- 3

P.5 Generar los grupos

# Selecciona solo la columna numérica
datos_num <- df["Volumen_Toneladas"]
clusters1 <- kmeans(datos_num,grupos1)
clusters1
## K-means clustering with 3 clusters of sizes 3, 7, 1
## 
## Cluster means:
##   Volumen_Toneladas
## 1         50733.853
## 2          6155.507
## 3        193427.800
## 
## Clustering vector:
##  [1] 3 1 1 1 2 2 2 2 2 2 2
## 
## Within cluster sum of squares by cluster:
## [1] 877002094 289603114         0
##  (between_SS / total_SS =  96.4 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

P.6 Optimizar el numero de grupos

set.seed(123)
optimizacion <- clusGap(datos_num, FUN=kmeans, nstart=1, K.max=7)
# El k.max noramlmente es 10, en este ejercicio al ser 8 datos se dejo en 7
plot(optimizacion, xlab="Numero de clusters k")

# Se selecciona como optimo el primer punto mas alto.

P.7 Agregar Clusters a la base de datos

df1_clusters <- cbind(df, cluster = clusters1$cluster)
head(df1_clusters)
##       Estado Volumen_Toneladas cluster
## 1     Oaxaca         193427.80       3
## 2  Michoacán          74712.60       1
## 3 Guanajuato          41440.00       1
## 4   Guerrero          36048.96       1
## 5     Puebla          18692.59       2
## 6    Jalisco          12448.80       2

P.8 Graficar los grupos

# Agregar la asignación de cluster al dataframe
df$Cluster <- clusters1$cluster

ggplot(df, aes(x = reorder(Estado, -Volumen_Toneladas), 
               y = Volumen_Toneladas, fill = factor(Cluster))) +
  geom_bar(stat = "identity") +
  coord_flip() +
  labs(title = "Clusters de producción de agave mezcal (k-means)",
       x = "Estado", y = "Volumen (toneladas)", fill = "Cluster") +
  theme_minimal()

LS0tDQp0aXRsZTogIkFHQVZFIEVOIE1FWElDTyINCmF1dGhvcjogIk1heCBWaWRhbCINCmRhdGU6ICJgciBTeXMuRGF0ZSgpYCINCm91dHB1dDoNCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6IGRhcmtseQ0KLS0tDQoNCiFbXShodHRwczovL25ld3MuYWlyYm5iLmNvbS93cC1jb250ZW50L3VwbG9hZHMvc2l0ZXMvNC8yMDE3LzA2L0dJRl8xX1BPVVItQ09NUFJFU1NFRC5naWYpDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmdyZWVuOyI+IENvbnRleHRvIDwvc3Bhbj4NCg0KRXN0b3MgZGF0b3MgcmVwcmVzZW50YW4gZWwgdm9sdW1lbiBkZSBwcm9kdWNjacOzbiBkZSBhZ2F2ZSBwYXJhIG1lemNhbCBlbiBNw6l4aWNvIGR1cmFudGUgZWwgYcOxbyAyMDI0LCBkZXNnbG9zYWRvIHBvciBlc3RhZG8uDQoNCkVsIGFuw6FsaXNpcyByZWZsZWphIGxhIGNvbnRyaWJ1Y2nDs24gZGUgMTEgZXN0YWRvcyBwcm9kdWN0b3JlcywgZGVzdGFjYW5kbyBPYXhhY2EgY29tbyBlbCBsw61kZXIgYWJzb2x1dG8sIHNlZ3VpZG8gcG9yIE1pY2hvYWPDoW4geSBHdWFuYWp1YXRvLiBMYSBpbmZvcm1hY2nDs24gcGVybWl0ZSBjb21wYXJhciBsYSBlc2NhbGEgZGUgcHJvZHVjY2nDs24gZW50cmUgcmVnaW9uZXMgeSBtdWVzdHJhIGxhIGRpc3RyaWJ1Y2nDs24gZ2VvZ3LDoWZpY2EgZGUgbGEgaW5kdXN0cmlhIG1lemNhbGVyYSBlbiBlbCBwYcOtcy4NCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpncmVlbjsiPiBQLjEgSW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hcyA8L3NwYW4+DQoNCjwvc3Bhbj4NCg0KYGBge3J9DQojaW5zdGFsbC5wYWNrYWdlcygiY2x1c3RlciIpICAjQW7DoWxpc2lzIGRlIEFncnVwYW1pZW50bw0KbGlicmFyeShjbHVzdGVyKQ0KI2luc3RhbGwucGFja2FnZXMoImdncGxvdDIiKSAjR3JhZmljYXINCmxpYnJhcnkoZ2dwbG90MikNCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikgI01hbmVqbyBkZSBtdWNob3MgZGF0b3MgDQpsaWJyYXJ5KGRhdGEudGFibGUpDQojaW5zdGFsbC5wYWNrYWdlcygiZmFjdG9leHRyYSIpICNHcsOhZmljYSBvcHRpbWl6YXpjacOzbiBkZSBuw7ptZXJvIGRlIGNsdXN0ZXJzDQpsaWJyYXJ5KGZhY3RvZXh0cmEpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Z3JlZW47Ij4gUGFzbzIuIE9idGVuZXIgbG9zIGRhdG9zIDwvc3Bhbj4NCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcTWF4XFxEZXNrdG9wXFxVTkkgVEVDXFw3bW8gc2VtZXN0cmVcXG1vZHVsbyAyXFxSXFxhY3QgbWV4aWNvIGFnYXZlXFxhZ2F2ZS5jc3YiKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmdyZWVuOyI+IFAuMyBFbnRlbmRlciBsb3MgZGF0b3MgPC9zcGFuPg0KYGBge3J9DQpzdW1tYXJ5KGRmKQ0Kc3RyKGRmKQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpncmVlbjsiPiBQLjQgRGV0ZXJtaW5hciBlbCBudW1lcm8gZGUgZ3J1cG9zIDwvc3Bhbj4NCmBgYHtyfQ0KIyBTaWVtcHJlIGVzIHVuIHZhbG9yIGluaWNpYWwgImN1YWxxdWllcmEiLCBsdWVnbyBzZSBvcHRpbWl6YQ0KZ3J1cG9zMSA8LSAzDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Z3JlZW47Ij4gUC41IEdlbmVyYXIgbG9zIGdydXBvcyA8L3NwYW4+DQpgYGB7cn0NCiMgU2VsZWNjaW9uYSBzb2xvIGxhIGNvbHVtbmEgbnVtw6lyaWNhDQpkYXRvc19udW0gPC0gZGZbIlZvbHVtZW5fVG9uZWxhZGFzIl0NCmNsdXN0ZXJzMSA8LSBrbWVhbnMoZGF0b3NfbnVtLGdydXBvczEpDQpjbHVzdGVyczENCmBgYA0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Z3JlZW47Ij4gUC42IE9wdGltaXphciBlbCBudW1lcm8gZGUgZ3J1cG9zIDwvc3Bhbj4NCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0Kb3B0aW1pemFjaW9uIDwtIGNsdXNHYXAoZGF0b3NfbnVtLCBGVU49a21lYW5zLCBuc3RhcnQ9MSwgSy5tYXg9NykNCiMgRWwgay5tYXggbm9yYW1sbWVudGUgZXMgMTAsIGVuIGVzdGUgZWplcmNpY2lvIGFsIHNlciA4IGRhdG9zIHNlIGRlam8gZW4gNw0KcGxvdChvcHRpbWl6YWNpb24sIHhsYWI9Ik51bWVybyBkZSBjbHVzdGVycyBrIikNCiMgU2Ugc2VsZWNjaW9uYSBjb21vIG9wdGltbyBlbCBwcmltZXIgcHVudG8gbWFzIGFsdG8uDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Z3JlZW47Ij4gUC43IEFncmVnYXIgQ2x1c3RlcnMgYSBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4NCmBgYHtyfQ0KZGYxX2NsdXN0ZXJzIDwtIGNiaW5kKGRmLCBjbHVzdGVyID0gY2x1c3RlcnMxJGNsdXN0ZXIpDQpoZWFkKGRmMV9jbHVzdGVycykNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpncmVlbjsiPiBQLjggR3JhZmljYXIgbG9zIGdydXBvcyA8L3NwYW4+DQpgYGB7cn0NCiMgQWdyZWdhciBsYSBhc2lnbmFjacOzbiBkZSBjbHVzdGVyIGFsIGRhdGFmcmFtZQ0KZGYkQ2x1c3RlciA8LSBjbHVzdGVyczEkY2x1c3Rlcg0KDQpnZ3Bsb3QoZGYsIGFlcyh4ID0gcmVvcmRlcihFc3RhZG8sIC1Wb2x1bWVuX1RvbmVsYWRhcyksIA0KICAgICAgICAgICAgICAgeSA9IFZvbHVtZW5fVG9uZWxhZGFzLCBmaWxsID0gZmFjdG9yKENsdXN0ZXIpKSkgKw0KICBnZW9tX2JhcihzdGF0ID0gImlkZW50aXR5IikgKw0KICBjb29yZF9mbGlwKCkgKw0KICBsYWJzKHRpdGxlID0gIkNsdXN0ZXJzIGRlIHByb2R1Y2Npw7NuIGRlIGFnYXZlIG1lemNhbCAoay1tZWFucykiLA0KICAgICAgIHggPSAiRXN0YWRvIiwgeSA9ICJWb2x1bWVuICh0b25lbGFkYXMpIiwgZmlsbCA9ICJDbHVzdGVyIikgKw0KICB0aGVtZV9taW5pbWFsKCkNCmBgYA0KDQo=