Cluster
Dario Gallardo
2025-02-19
Ejemplo vino
Contexto
Estos datos son el resuultado de un analsiis uqimica de vinos cultivodaods en la misma rehion de italia pero dervodado de tres cultivares diferentes.
El analsis determino las cantidades de 13 componentes que se encuentran en cada uno de los 3 cultivares
Instalar paquetes y librerias
#install.packages("cluster")
library(cluster)
#install.packages("ggplot2")
library(ggplot2)
#install.packages("factoextra")
library(factoextra)
#install.packages("data.table")
library(data.table)
#install.packages("tidyverse")
library(tidyverse)Importar base de datos
datos <- read.csv("C:\\Users\\Carlos\\Documents\\wine_dataset.csv")Entender 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.0000Escalar base de datos
datos_escalados <- scale(datos)
datos_escalados <- subset(datos_escalados, select= -target)Generar los segmentos
grupos <- 3
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
set.seed(123)
optimizacion <- clusGap(datos_escalados, FUN=kmeans, nstart=1, K.max = 10)
plot(optimizacion, xlab="Numero de clusters X")
Comparar segmentos
promedio <- aggregate(asignacion, by=list(asignacion$cluster),
FUN=mean)
promedio## Group.1 alcohol malic_acid ash alcalinity_of_ash magnesium
## 1 1 12.25092 1.897385 2.231231 20.06308 92.73846
## 2 2 13.13412 3.307255 2.417647 21.24118 98.66667
## 3 3 13.67677 1.997903 2.466290 17.46290 107.96774
## total_phenols flavanoids nonflavanoid_phenols proanthocyanins color_intensity
## 1 2.247692 2.0500000 0.3576923 1.624154 2.973077
## 2 1.683922 0.8188235 0.4519608 1.145882 7.234706
## 3 2.847581 3.0032258 0.2920968 1.922097 5.453548
## hue od280.od315_of_diluted_wines proline target cluster
## 1 1.0627077 2.803385 510.1692 1.0000000 1
## 2 0.6919608 1.696667 619.0588 1.9411765 2
## 3 1.0654839 3.163387 1100.2258 0.0483871 3table(asignacion$cluster)##
## 1 2 3
## 65 51 62Ejercicio Mexico 2024
Instalar paquetes y llamar librerias
#install.packages("sf")
library(sf)
#install.packages("rnaturalearth")
library(rnaturalearth)
#install.packages("rnaturalearthdata")
library(rnaturalearthdata)
#install.packages("devtools")
library(devtools)
devtools::install_github("ropensci/rnaturalearthhires")
#install.packages("dplyr")
library(dplyr)datosmex <- read.csv("C:\\Users\\Carlos\\Downloads\\mexico2024.csv")Obtener mapa de Mexico
mexico <- ne_states(country = "Mexico", returnclass = "sf")Entender la base de datos
summary(datosmex)## 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.00Eliminar datos no numéricos
datosmex_numerico <- subset(datosmex, select = -Estado)Escalar datos
datos_escaladosmex <- scale(datosmex_numerico)Escalar datos
set.seed(123)
optimizacion <- clusGap(datos_escaladosmex, FUN = kmeans, nstart = 1, K.max = 10)
plot(optimizacion, xlab = "Número de clusters")
## Generar los segmentos
grupos <- 3 # Se inicia con un valor y luego se ajusta según el análisis
segmentosmex <- kmeans(datos_escaladosmex, grupos)Asignar grupos a los datos
datosmex <- cbind(datosmex, clustermex = segmentosmex$cluster)Graficar los clusters
fviz_cluster(segmentosmex, data = datos_escaladosmex)
Unir Mapa con datos
mexico <- ne_states(country = "Mexico", returnclass = "sf")## <span style="color: green; ">Unir el mapa con los datos de clusters</span>
mexico_clusters <- left_join(mexico, datosmex, by = c("name" ="Estado"))Unir Mapa con datos
ggplot(mexico_clusters) +
geom_sf(aes(fill = as.factor(clustermex)), color = "black") +
scale_fill_manual(values = c("green", "yellow", "red")) +
labs(title = "Clusters de población por estado de México", fill = "Cluster") +
theme_minimal()