
Estos datos son el resultado de un análisis quÃmico de vinos cultivados en la misma región de Italia pero derivados de tres cultivares diferentes.
El análisis determinó las cantidades de 13 componentes que se encuentran en cada uno de los tres cultivares
library("cluster")
library("ggplot2")
library("factoextra")
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library("data.table")
library("tidyverse")
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.4 ✔ tibble 3.2.1
## ✔ purrr 1.0.4 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between() masks data.table::between()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks data.table::first()
## ✖ lubridate::hour() masks data.table::hour()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks data.table::last()
## ✖ lubridate::mday() masks data.table::mday()
## ✖ lubridate::minute() masks data.table::minute()
## ✖ lubridate::month() masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second() masks data.table::second()
## ✖ purrr::transpose() masks data.table::transpose()
## ✖ lubridate::wday() masks data.table::wday()
## ✖ lubridate::week() masks data.table::week()
## ✖ lubridate::yday() masks data.table::yday()
## ✖ lubridate::year() masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library("dplyr")
data <- read.csv("/Users/ernestoguendulainicloud.com/Downloads/wine_dataset.csv")
summary(data)
## 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
datos_escalados <- subset(data, select = -target)
datos_escalados <- scale(datos_escalados)
grupos <- 3 # Inicio con cualquier valor, luego verifico
segmentos <- kmeans(datos_escalados, grupos)
asignacion <- cbind(data, cluster =
segmentos$cluster)
fviz_cluster(segmentos, data = data)
## Optimizar la cantidad de
grupos
set.seed(123)
optimizacion <- clusGap(datos_escalados, FUN=kmeans, nstart=1, K.max=10)
plot(optimizacion, xlab="Número de clusters k")
## 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.67677 1.997903 2.466290 17.46290 107.96774
## 2 2 12.25092 1.897385 2.231231 20.06308 92.73846
## 3 3 13.13412 3.307255 2.417647 21.24118 98.66667
## total_phenols flavanoids nonflavanoid_phenols proanthocyanins color_intensity
## 1 2.847581 3.0032258 0.2920968 1.922097 5.453548
## 2 2.247692 2.0500000 0.3576923 1.624154 2.973077
## 3 1.683922 0.8188235 0.4519608 1.145882 7.234706
## hue od280.od315_of_diluted_wines proline target cluster
## 1 1.0654839 3.163387 1100.2258 0.0483871 1
## 2 1.0627077 2.803385 510.1692 1.0000000 2
## 3 0.6919608 1.696667 619.0588 1.9411765 3
library("sf") #Analiza datos espaciales
## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE
library("rnaturalearth") #Proporciona lÃmites geográficos
library("rnaturalearthdata") #Datos de geografÃa
##
## Attaching package: 'rnaturalearthdata'
## The following object is masked from 'package:rnaturalearth':
##
## countries110
library("devtools") #Instalar paquetes de fuentes externas
## Loading required package: usethis
devtools::install_github("ropensci/rnaturalearthhires")
## Skipping install of 'rnaturalearthhires' from a github remote, the SHA1 (153b0ea5) has not changed since last install.
## Use `force = TRUE` to force installation
datos_mx <- read.csv("/Users/ernestoguendulainicloud.com/Documents/mexico2024.csv")
datos_mx
## name Población PIB.per.cápita Esperanza.de.vida
## 1 Aguascalientes 1.4 142703 75.4
## 2 Baja California 3.7 152317 76.2
## 3 Baja California Sur 0.8 151590 76.5
## 4 Campeche 0.9 481697 75.1
## 5 Chiapas 5.5 44387 74.0
## 6 Chihuahua 3.8 141532 75.8
## 7 Distrito Federal 9.2 316761 76.2
## 8 Coahuila 3.2 166389 75.9
## 9 Colima 0.7 128953 75.6
## 10 Durango 1.8 101500 75.2
## 11 Guanajuato 6.2 104393 74.1
## 12 Guerrero 3.5 59922 73.5
## 13 Hidalgo 3.1 78891 74.8
## 14 Jalisco 8.3 133857 75.2
## 15 México 17.4 85184 74.5
## 16 Michoacán 4.8 82199 74.3
## 17 Morelos 2.0 87849 74.9
## 18 Nayarit 1.3 83135 74.7
## 19 Nuevo León 5.8 225862 75.8
## 20 Oaxaca 4.1 57239 73.8
## 21 Puebla 6.6 80424 73.9
## 22 Querétaro 2.3 160301 75.5
## 23 Quintana Roo 1.9 128903 75.6
## 24 San Luis Potosà 2.8 119143 74.8
## 25 Sinaloa 3.0 117150 75.5
## 26 Sonora 3.0 179296 75.5
## 27 Tabasco 2.4 180564 74.6
## 28 Tamaulipas 3.5 129590 75.3
## 29 Tlaxcala 1.3 65899 74.5
## 30 Veracruz 8.1 86373 73.8
## 31 Yucatán 2.3 107364 74.9
## 32 Zacatecas 1.6 87211 74.6
## Tasa.de.pobreza Tasa.de.alfabetización
## 1 27.2 98.0
## 2 13.4 98.5
## 3 13.3 98.6
## 4 40.9 96.5
## 5 67.4 88.7
## 6 26.3 97.5
## 7 28.4 99.0
## 8 20.2 98.2
## 9 18.0 98.3
## 10 32.7 96.8
## 11 43.4 95.0
## 12 60.4 86.5
## 13 43.5 94.5
## 14 29.8 97.8
## 15 42.7 97.1
## 16 46.0 94.0
## 17 45.0 94.8
## 18 35.0 95.5
## 19 16.0 98.5
## 20 58.4 89.0
## 21 59.4 94.2
## 22 27.6 98.1
## 23 30.2 97.0
## 24 35.5 95.8
## 25 30.0 96.8
## 26 34.5 96.8
## 27 50.9 94.0
## 28 30.9 96.5
## 29 48.4 94.5
## 30 58.1 93.5
## 31 41.1 95.4
## 32 46.8 94.0
datos_escalados_mx <- scale(datos_mx[, -1])
set.seed(123)
gap_stat <- clusGap(datos_escalados_mx, FUN = kmeans, nstart = 25, K.max = 10, B = 50)
plot(gap_stat, xlab = "Número de clusters", main = "Gap Statistic for Optimal Clusters")
grupos_mx <- maxSE(gap_stat$Tab[, "gap"], gap_stat$Tab[, "SE.sim"], method = "firstSEmax")
set.seed(123)
segmentos_mx <- kmeans(datos_escalados_mx, centers = grupos_mx, nstart = 25)
datos_mx$cluster <- as.factor(segmentos_mx$cluster)
cluster_mean_mex <- aggregate(datos_mx[, -1], by = list(datos_mx$cluster), FUN = mean)
print(cluster_mean_mex)
## Group.1 Población PIB.per.cápita Esperanza.de.vida Tasa.de.pobreza
## 1 1 6.425000 88347.25 74.02500 51.72500
## 2 2 0.900000 481697.00 75.10000 40.90000
## 3 3 4.366667 53849.33 73.76667 62.06667
## 4 4 17.400000 85184.00 74.50000 42.70000
## 5 5 2.100000 101257.00 74.72500 43.27500
## 6 6 2.100000 149812.25 76.05000 16.22500
## 7 7 3.222222 137203.56 75.44444 29.91111
## 8 8 7.500000 271311.50 76.00000 22.20000
## Tasa.de.alfabetización cluster
## 1 94.17500 NA
## 2 96.50000 NA
## 3 88.06667 NA
## 4 97.10000 NA
## 5 94.81250 NA
## 6 98.40000 NA
## 7 97.25556 NA
## 8 98.75000 NA
mexico <- ne_states(country = "Mexico", returnclass="sf")
mexico_clusters <- left_join(mexico, datos_mx, by = "name")
palette_colors <- c("#1f78b4", "#33a02c", "#e31a1c", "#ff7f00", "#6a3d9a")
generate_cluster_map <- function(variable, title) {
ggplot(mexico_clusters) +
geom_sf(aes_string(fill = variable), color = "black") +
scale_fill_viridis_c() +
labs(title = title) +
theme_minimal()
}
map1 <- generate_cluster_map("Población", "Clusters por Población en México")
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
map1