Wine Dataset

#Ejemplo vinos

##Contexto Estos datos son el resultado de un analisis quimico de vinos cultivados en la misma regionde Italia pero derivados de tres cultivares diferentes.

El analisis determino las cantidades de 13 componentes que se encuentran en cada uno de los 3 cultivares.

##Instalar paquetes y llamar librerias

#install.packages("cluster") #Agrupamientos
library(cluster)
#install.packages("ggplot2")#Graficar
library(ggplot2)
#install.packages("factoextra")#Visualizar Clusters
library(factoextra)
#install.packages("data.table")#Conjunto de datos grande
library(data.table)
#install.packages("tidyverse")
library(tidyverse)

##Importar base de datos

datos<- read.csv("C:/Users/Luis Arturo Reinoso/Downloads/wine_dataset.csv")

##Entender la base de datos

summary(datos)

##     alcohol        malic_acid         ash        alcalinity_of_ash
##  Min.   :11.03   Min.   :0.740   Min.   :1.360   Min.   :10.60    
##  1st Qu.:12.36   1st Qu.:1.603   1st Qu.:2.210   1st Qu.:17.20    
##  Median :13.05   Median :1.865   Median :2.360   Median :19.50    
##  Mean   :13.00   Mean   :2.336   Mean   :2.367   Mean   :19.49    
##  3rd Qu.:13.68   3rd Qu.:3.083   3rd Qu.:2.558   3rd Qu.:21.50    
##  Max.   :14.83   Max.   :5.800   Max.   :3.230   Max.   :30.00    
##    magnesium      total_phenols     flavanoids    nonflavanoid_phenols
##  Min.   : 70.00   Min.   :0.980   Min.   :0.340   Min.   :0.1300      
##  1st Qu.: 88.00   1st Qu.:1.742   1st Qu.:1.205   1st Qu.:0.2700      
##  Median : 98.00   Median :2.355   Median :2.135   Median :0.3400      
##  Mean   : 99.74   Mean   :2.295   Mean   :2.029   Mean   :0.3619      
##  3rd Qu.:107.00   3rd Qu.:2.800   3rd Qu.:2.875   3rd Qu.:0.4375      
##  Max.   :162.00   Max.   :3.880   Max.   :5.080   Max.   :0.6600      
##  proanthocyanins color_intensity       hue         od280.od315_of_diluted_wines
##  Min.   :0.410   Min.   : 1.280   Min.   :0.4800   Min.   :1.270               
##  1st Qu.:1.250   1st Qu.: 3.220   1st Qu.:0.7825   1st Qu.:1.938               
##  Median :1.555   Median : 4.690   Median :0.9650   Median :2.780               
##  Mean   :1.591   Mean   : 5.058   Mean   :0.9574   Mean   :2.612               
##  3rd Qu.:1.950   3rd Qu.: 6.200   3rd Qu.:1.1200   3rd Qu.:3.170               
##  Max.   :3.580   Max.   :13.000   Max.   :1.7100   Max.   :4.000               
##     proline           target      
##  Min.   : 278.0   Min.   :0.0000  
##  1st Qu.: 500.5   1st Qu.:0.0000  
##  Median : 673.5   Median :1.0000  
##  Mean   : 746.9   Mean   :0.9382  
##  3rd Qu.: 985.0   3rd Qu.:2.0000  
##  Max.   :1680.0   Max.   :2.0000

##Escalar la base de datos

datos_escalados<-datos
datos_escalados<- subset(datos_escalados, select = -target)
datos_escalados<- scale(datos) 

##Generar los segmentos

grupos<-3 #Inicio con cualquier valor y despues verifico
segmentos<- kmeans(datos_escalados,grupos)

##Asignar grupos a los datos

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

##Graficar los clusters

fviz_cluster(segmentos,data=datos)

##Optimizar la cantidad de grupos

#la cantidad optima corresponde al punto mas alto de la grafica
set.seed(123)
optimizacion<- clusGap(datos_escalados, FUN=kmeans, nstart=1,K.max = 10)
plot(optimizacion, xlab="Numero de clusters")

##Comparar segmentos

promedio<- aggregate(asignacion, by=list(asignacion$cluster), FUN = mean)
promedio

##   Group.1  alcohol malic_acid      ash alcalinity_of_ash magnesium
## 1       1 13.15163   3.344490 2.434694          21.43878  99.02041
## 2       2 12.25412   1.914265 2.239118          20.07941  93.04412
## 3       3 13.71148   1.997049 2.453770          17.28197 107.78689
##   total_phenols flavanoids nonflavanoid_phenols proanthocyanins color_intensity
## 1      1.678163  0.7979592            0.4508163        1.163061        7.343265
## 2      2.248971  2.0733824            0.3629412        1.601324        3.064706
## 3      2.842131  2.9691803            0.2891803        1.922951        5.444590
##         hue od280.od315_of_diluted_wines   proline     target cluster
## 1 0.6859184                     1.690204  627.5510 1.97959184       1
## 2 1.0542059                     2.788529  506.5882 1.00000000       2
## 3 1.0677049                     3.154754 1110.6393 0.03278689       3

table(asignacion$cluster)

## 
##  1  2  3 
## 49 68 61

#Ejercicio Mexico 2024

##Instalar paquetes y llamar librerias

#install.packages("sf") #Analisis de datos espaciales
library(sf)
#install.packages("rnaturalearth") #Proporciona limites geograficos
library(rnaturalearth)
#install.packages("rnaturalearthdata")#Datos de geografia
library(rnaturalearthdata)
#install.packages("devtools")
library(devtools)
devtools::install_github("ropensci/rnaturalearthhires") #Mapa de mexico particular

##Importar base de datos

datosmx <- read.csv("C:/Users/Luis Arturo Reinoso/Downloads/mexico2024.csv")

##Explorar la base de datos

summary(datosmx)

##     Estado            Población      PIB.per.cápita   Esperanza.de.vida
##  Length:32          Min.   : 0.700   Min.   : 44387   Min.   :73.50    
##  Class :character   1st Qu.: 1.875   1st Qu.: 84672   1st Qu.:74.50    
##  Mode  :character   Median : 3.050   Median :118147   Median :75.00    
##                     Mean   : 3.947   Mean   :133393   Mean   :75.00    
##                     3rd Qu.: 4.975   3rd Qu.:151772   3rd Qu.:75.53    
##                     Max.   :17.400   Max.   :481697   Max.   :76.50    
##  Tasa.de.pobreza Tasa.de.alfabetización
##  Min.   :13.30   Min.   :86.50         
##  1st Qu.:28.20   1st Qu.:94.42         
##  Median :35.25   Median :96.50         
##  Mean   :37.54   Mean   :95.61         
##  3rd Qu.:46.20   3rd Qu.:97.85         
##  Max.   :67.40   Max.   :99.00

##Escalar la base de datos

# Renombrar "Estado" a "name"
colnames(datosmx)[colnames(datosmx) == "Estado"] <- "name"

# Reemplazar valores NA con la media de cada columna numérica
datosmx[ , 2:ncol(datosmx)] <- apply(datosmx[ , 2:ncol(datosmx)], 2, function(x) ifelse(is.na(x), mean(x, na.rm = TRUE), x))

# Normalizar solo las variables numéricas (sin afectar "name")
datos_escaladosmx <- scale(datosmx[ , 2:ncol(datosmx)])

##Método del Codo para determinar el número de clusters

set.seed(123)

optimizacionmx <- clusGap(datos_escaladosmx, FUN = kmeans, nstart = 1, K.max = 10)
plot(optimizacionmx, xlab = "Número de clusters")

##Generar los clusters

gruposmx <- 6  # Número óptimo de clusters basado en el método del codo
segmentosmx <- kmeans(datos_escaladosmx, gruposmx)

##Asignar clusters a los estados

asignacionmx <- cbind(datosmx, cluster = segmentosmx$cluster)

##Visualizar los clusters

fviz_cluster(segmentosmx, data = datos_escaladosmx)

##Comparar los segmentos

promediomx <- aggregate(asignacionmx, by = list(asignacionmx$cluster), FUN = mean)

## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA
## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA
## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA
## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA
## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA
## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA

promediomx

##   Group.1 name Población PIB.per.cápita Esperanza.de.vida Tasa.de.pobreza
## 1       1   NA  6.425000       88347.25          74.02500        51.72500
## 2       2   NA 17.400000       85184.00          74.50000        42.70000
## 3       3   NA  4.366667       53849.33          73.76667        62.06667
## 4       4   NA  5.050000      399229.00          75.65000        34.65000
## 5       5   NA  2.066667      101284.00          74.77778        42.10000
## 6       6   NA  3.184615      150649.46          75.67692        24.41538
##   Tasa.de.alfabetización cluster
## 1               94.17500       1
## 2               97.10000       2
## 3               88.06667       3
## 4               97.75000       4
## 5               95.03333       5
## 6               97.73846       6

table(asignacionmx$cluster)

## 
##  1  2  3  4  5  6 
##  4  1  3  2  9 13

#Visualización en un Mapa de México ##Obtener el mapa de México

mexico <- ne_states(country = "Mexico", returnclass = "sf")

##Unir el mapa con los datos de clusters

# Asegurar que la columna de identificación coincida
colnames(datosmx)[colnames(datosmx) == "Estado"] <- "name"

# Unir datos de clusters con el mapa asegurando coincidencia en nombres
mexico_clusters <- left_join(mexico, asignacionmx, by = "name")


# Verificar si la columna "cluster" está presente
colnames(mexico_clusters)

##   [1] "featurecla"             "scalerank"              "adm1_code"             
##   [4] "diss_me"                "iso_3166_2"             "wikipedia"             
##   [7] "iso_a2"                 "adm0_sr"                "name"                  
##  [10] "name_alt"               "name_local"             "type"                  
##  [13] "type_en"                "code_local"             "code_hasc"             
##  [16] "note"                   "hasc_maybe"             "region"                
##  [19] "region_cod"             "provnum_ne"             "gadm_level"            
##  [22] "check_me"               "datarank"               "abbrev"                
##  [25] "postal"                 "area_sqkm"              "sameascity"            
##  [28] "labelrank"              "name_len"               "mapcolor9"             
##  [31] "mapcolor13"             "fips"                   "fips_alt"              
##  [34] "woe_id"                 "woe_label"              "woe_name"              
##  [37] "latitude"               "longitude"              "sov_a3"                
##  [40] "adm0_a3"                "adm0_label"             "admin"                 
##  [43] "geonunit"               "gu_a3"                  "gn_id"                 
##  [46] "gn_name"                "gns_id"                 "gns_name"              
##  [49] "gn_level"               "gn_region"              "gn_a1_code"            
##  [52] "region_sub"             "sub_code"               "gns_level"             
##  [55] "gns_lang"               "gns_adm1"               "gns_region"            
##  [58] "min_label"              "max_label"              "min_zoom"              
##  [61] "wikidataid"             "name_ar"                "name_bn"               
##  [64] "name_de"                "name_en"                "name_es"               
##  [67] "name_fr"                "name_el"                "name_hi"               
##  [70] "name_hu"                "name_id"                "name_it"               
##  [73] "name_ja"                "name_ko"                "name_nl"               
##  [76] "name_pl"                "name_pt"                "name_ru"               
##  [79] "name_sv"                "name_tr"                "name_vi"               
##  [82] "name_zh"                "ne_id"                  "name_he"               
##  [85] "name_uk"                "name_ur"                "name_fa"               
##  [88] "name_zht"               "FCLASS_ISO"             "FCLASS_US"             
##  [91] "FCLASS_FR"              "FCLASS_RU"              "FCLASS_ES"             
##  [94] "FCLASS_CN"              "FCLASS_TW"              "FCLASS_IN"             
##  [97] "FCLASS_NP"              "FCLASS_PK"              "FCLASS_DE"             
## [100] "FCLASS_GB"              "FCLASS_BR"              "FCLASS_IL"             
## [103] "FCLASS_PS"              "FCLASS_SA"              "FCLASS_EG"             
## [106] "FCLASS_MA"              "FCLASS_PT"              "FCLASS_AR"             
## [109] "FCLASS_JP"              "FCLASS_KO"              "FCLASS_VN"             
## [112] "FCLASS_TR"              "FCLASS_ID"              "FCLASS_PL"             
## [115] "FCLASS_GR"              "FCLASS_IT"              "FCLASS_NL"             
## [118] "FCLASS_SE"              "FCLASS_BD"              "FCLASS_UA"             
## [121] "FCLASS_TLC"             "Población"              "PIB.per.cápita"        
## [124] "Esperanza.de.vida"      "Tasa.de.pobreza"        "Tasa.de.alfabetización"
## [127] "cluster"                "geometry"

##Mapa de México con los clusters

ggplot(mexico_clusters) +
  geom_sf(aes(fill = factor(cluster)), color = "black") +
  scale_fill_manual(values = c("green", "yellow", "red", "blue", "brown", "purple")) +
  labs(title = "Clusters por Estado en México") +
  theme_minimal()