La base de datos USArrests contiene estadísticas en arrestos por cada 100,000 residentes por agresión, asesinato y violación en cada uno de los 50 estados de EE.UU. en 1973.
## Murder Assault UrbanPop Rape
## Min. : 0.800 Min. : 45.0 Min. :32.00 Min. : 7.30
## 1st Qu.: 4.075 1st Qu.:109.0 1st Qu.:54.50 1st Qu.:15.07
## Median : 7.250 Median :159.0 Median :66.00 Median :20.10
## Mean : 7.788 Mean :170.8 Mean :65.54 Mean :21.23
## 3rd Qu.:11.250 3rd Qu.:249.0 3rd Qu.:77.75 3rd Qu.:26.18
## Max. :17.400 Max. :337.0 Max. :91.00 Max. :46.00
# Escalar la base de datos
datos_escalados <- scale(USArrests)
# Verificar la media y desviación estándar después del escalado
apply(datos_escalados, 2, mean) # Debería estar cerca de 0## Murder Assault UrbanPop Rape
## -7.663087e-17 1.112408e-16 -4.332808e-16 8.942391e-17
## Murder Assault UrbanPop Rape
## 1 1 1 1
## Optimizar la cantidad de grupos
#La cantidad optima de grupos corresponde al punto mas alto de la grafica
set.seed(123)
optimizacion <- clusGap(datos_escalados,
FUN = function(x, k) kmeans(x, k, nstart = 25),
K.max = 10)
plot(optimizacion, xlab = "Número de clusters k")
## Comparar segmentos
## Group.1 Murder Assault UrbanPop Rape cluster
## 1 1 13.93750 243.62500 53.75000 21.41250 1
## 2 2 3.60000 78.53846 52.07692 12.17692 2
## 3 3 5.65625 138.87500 73.87500 18.78125 3
## 4 4 10.81538 257.38462 76.00000 33.19231 4
##
## 1 2 3 4
## 8 13 16 13
## | | | 0% | | | 1% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======= | 10% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========== | 14% | |========== | 15% | |=========== | 16% | |============ | 17% | |============ | 18% | |============= | 18% | |============= | 19% | |============== | 20% | |============== | 21% | |=============== | 21% | |=============== | 22% | |================ | 23% | |================ | 24% | |================= | 24% | |================= | 25% | |================== | 26% | |=================== | 27% | |==================== | 28% | |==================== | 29% | |===================== | 29% | |===================== | 30% | |====================== | 31% | |======================= | 32% | |======================= | 33% | |======================== | 34% | |======================== | 35% | |========================= | 35% | |========================= | 36% | |========================== | 37% | |========================== | 38% | |=========================== | 39% | |============================ | 40% | |============================= | 41% | |============================= | 42% | |============================== | 42% | |============================== | 43% | |=============================== | 44% | |=============================== | 45% | |================================ | 45% | |================================ | 46% | |================================= | 47% | |================================== | 49% | |=================================== | 50% | |==================================== | 51% | |==================================== | 52% | |===================================== | 53% | |===================================== | 54% | |====================================== | 55% | |======================================= | 56% | |======================================== | 57% | |========================================= | 58% | |========================================= | 59% | |========================================== | 60% | |=========================================== | 61% | |=========================================== | 62% | |============================================ | 63% | |============================================= | 65% | |============================================== | 65% | |============================================== | 66% | |=============================================== | 68% | |================================================ | 69% | |================================================= | 70% | |================================================= | 71% | |=================================================== | 73% | |===================================================== | 76% | |======================================================= | 78% | |========================================================= | 81% | |========================================================== | 82% | |========================================================== | 84% | |=========================================================== | 84% | |============================================================ | 85% | |============================================================ | 86% | |============================================================= | 86% | |============================================================= | 87% | |============================================================= | 88% | |============================================================== | 88% | |============================================================== | 89% | |=============================================================== | 89% | |=============================================================== | 90% | |================================================================ | 91% | |================================================================ | 92% | |================================================================= | 92% | |================================================================= | 93% | |================================================================== | 94% | |================================================================== | 95% | |=================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 97% | |==================================================================== | 98% | |===================================================================== | 98% | |===================================================================== | 99% | |======================================================================| 100%
# Normalizar nombres de los estados para que coincidan
asignacion$state <- tolower(rownames(asignacion))
us_map$NAME <- tolower(us_map$NAME)
# Unir el mapa con la clasificación de clusters
us_clustered <- left_join(us_map, asignacion, by = c("NAME" = "state"))# Agregar la clasificación de seguridad basada en los clusters
set.seed(123)
asignacion$nivel_seguridad <- case_when(
asignacion$cluster == 1 ~ "Bajo",
asignacion$cluster == 2 ~ "Medio",
asignacion$cluster == 3 ~ "Alto",
asignacion$cluster == 4 ~ "Muy Alto",
TRUE ~ "Desconocido" # Para manejar cualquier error
)
# Verificar la base con la nueva columna
head(asignacion)## Murder Assault UrbanPop Rape cluster state nivel_seguridad
## Alabama 13.2 236 58 21.2 1 alabama Bajo
## Alaska 10.0 263 48 44.5 4 alaska Muy Alto
## Arizona 8.1 294 80 31.0 4 arizona Muy Alto
## Arkansas 8.8 190 50 19.5 1 arkansas Bajo
## California 9.0 276 91 40.6 4 california Muy Alto
## Colorado 7.9 204 78 38.7 4 colorado Muy Alto
# Definir colores según el nivel de seguridad
colores_seguridad <- c("Bajo" = "darkgreen",
"Medio" = "yellow",
"Alto" = "orange",
"Muy Alto" = "red")
# Convertir los nombres de los estados a minúsculas en ambas bases
asignacion$state <- tolower(rownames(asignacion))
us_map$NAME <- tolower(us_map$NAME)
# Hacer el left_join nuevamente
us_clustered <- dplyr::left_join(us_map, asignacion, by = c("NAME" = "state"))
# Graficar el mapa
ggplot(data = us_clustered) +
geom_sf(aes(fill = nivel_seguridad), color = "black") +
scale_fill_manual(values = colores_seguridad, name = "Nivel de Seguridad") +
labs(title = "Mapa de Seguridad en EE.UU. (1973)",
subtitle = "Clasificación basada en tasas de criminalidad",
caption = "Fuente: USArrests") +
theme_minimal()