USArrests
Oscar Castañeda A01384841
2025-02-21
Contexto
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.
Instalar paquetes y llamas librerias
#install.packages("cluster") # Para agrupamientos
library(cluster)
#install.packages("ggplot2") # Hacer Gráficas
library(ggplot2)
#install.packages("factoextra") # Visualización Clusters
library(factoextra)
#install.packages("data.table") # Conjunto de datos grande
library(data.table)
library(tidyverse)Entender la base de datos
## 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.00Escalar base de datos
# Escalar la base de datos
datos_escalados <- scale(USArrests)
# Verificar la media y desviación estándar después del escalado
summary(datos_escalados)## Murder Assault UrbanPop Rape
## Min. :-1.6044 Min. :-1.5090 Min. :-2.31714 Min. :-1.4874
## 1st Qu.:-0.8525 1st Qu.:-0.7411 1st Qu.:-0.76271 1st Qu.:-0.6574
## Median :-0.1235 Median :-0.1411 Median : 0.03178 Median :-0.1209
## Mean : 0.0000 Mean : 0.0000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.7949 3rd Qu.: 0.9388 3rd Qu.: 0.84354 3rd Qu.: 0.5277
## Max. : 2.2069 Max. : 1.9948 Max. : 1.75892 Max. : 2.6444Generar los segmentos
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=kmeans, nstart=1, K.max=10)
plot(optimizacion, xlab="Número de clusters k",main="Método de silueta")
Comparar segmentos
## Group.1 Murder Assault UrbanPop Rape cluster
## 1 1 13.93750 243.62500 53.75000 21.41250 1
## 2 2 10.81538 257.38462 76.00000 33.19231 2
## 3 3 5.65625 138.87500 73.87500 18.78125 3
## 4 4 3.60000 78.53846 52.07692 12.17692 4##
## 1 2 3 4
## 8 13 16 13Obtener Mapa de USA
Unir mapa con datos
## Retrieving data for the year 2021## | | | 0% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 6% | |===== | 7% | |====== | 8% | |====== | 9% | |======= | 9% | |======= | 10% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========== | 14% | |========== | 15% | |=========== | 15% | |=========== | 16% | |============ | 17% | |============ | 18% | |============= | 18% | |============= | 19% | |============== | 20% | |============== | 21% | |=============== | 21% | |=============== | 22% | |================ | 23% | |================ | 24% | |================= | 24% | |================= | 25% | |================== | 25% | |================== | 26% | |=================== | 27% | |=================== | 28% | |==================== | 28% | |==================== | 29% | |===================== | 29% | |===================== | 30% | |====================== | 31% | |====================== | 32% | |======================= | 32% | |======================= | 33% | |======================== | 34% | |======================== | 35% | |========================= | 35% | |========================= | 36% | |========================== | 37% | |========================== | 38% | |=========================== | 38% | |=========================== | 39% | |============================ | 40% | |============================= | 41% | |============================= | 42% | |============================== | 42% | |============================== | 43% | |=============================== | 44% | |=============================== | 45% | |================================ | 45% | |================================ | 46% | |================================= | 47% | |================================= | 48% | |================================== | 48% | |================================== | 49% | |=================================== | 50% | |=================================== | 51% | |==================================== | 51% | |==================================== | 52% | |===================================== | 53% | |====================================== | 54% | |====================================== | 55% | |======================================= | 56% | |======================================== | 56% | |======================================== | 57% | |========================================= | 58% | |========================================= | 59% | |========================================== | 59% | |========================================== | 60% | |=========================================== | 61% | |=========================================== | 62% | |============================================ | 62% | |============================================ | 63% | |============================================= | 64% | |============================================= | 65% | |============================================== | 65% | |============================================== | 66% | |=============================================== | 67% | |=============================================== | 68% | |================================================ | 68% | |================================================ | 69% | |================================================= | 69% | |================================================= | 70% | |================================================== | 71% | |================================================== | 72% | |=================================================== | 72% | |=================================================== | 73% | |==================================================== | 74% | |==================================================== | 75% | |===================================================== | 75% | |===================================================== | 76% | |====================================================== | 77% | |====================================================== | 78% | |======================================================= | 78% | |======================================================= | 79% | |======================================================== | 80% | |======================================================== | 81% | |========================================================= | 81% | |========================================================= | 82% | |========================================================== | 83% | |========================================================== | 84% | |=========================================================== | 84% | |=========================================================== | 85% | |============================================================ | 85% | |============================================================ | 86% | |============================================================= | 86% | |============================================================= | 87% | |============================================================== | 88% | |============================================================== | 89% | |=============================================================== | 89% | |=============================================================== | 90% | |================================================================ | 91% | |================================================================ | 92% | |================================================================= | 92% | |================================================================= | 93% | |================================================================== | 94% | |================================================================== | 95% | |=================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 97% | |==================================================================== | 98% | |===================================================================== | 98% | |===================================================================== | 99% | |======================================================================| 99% | |======================================================================| 100%# Agregar la clasificación de seguridad basada en los clusters
asignacion$nivel_seguridad <- case_when(
asignacion$cluster == 1 ~ "Muy inseguro",
asignacion$cluster == 2 ~ "Inseguro",
asignacion$cluster == 3 ~ "Seguro",
asignacion$cluster == 4 ~ "Muy Seguro",
TRUE ~ "Desconocido"
)
head(asignacion)## Murder Assault UrbanPop Rape cluster nivel_seguridad
## Alabama 13.2 236 58 21.2 1 Muy inseguro
## Alaska 10.0 263 48 44.5 2 Inseguro
## Arizona 8.1 294 80 31.0 2 Inseguro
## Arkansas 8.8 190 50 19.5 1 Muy inseguro
## California 9.0 276 91 40.6 2 Inseguro
## Colorado 7.9 204 78 38.7 2 InseguroGraficar los clusters en el mapa
# Unir los datos con el mapa de EE.UU.
us_clustered <- left_join(us_map, asignacion, by = c("NAME" = "state"))
# Definir colores según el nivel de seguridad
colores_seguridad <- c("Muy inseguro" = "red",
"Inseguro" = "yellow",
"Seguro" = "orange",
"Muy Seguro" = "darkgreen")
# Graficar el mapa
ggplot(data = us_clustered) +
geom_sf(aes(fill = nivel_seguridad), color = "black", size = 0.2) +
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()
LS0tCnRpdGxlOiAiVVNBcnJlc3RzIgphdXRob3I6ICJPc2NhciBDYXN0YcOxZWRhIEEwMTM4NDg0MSIKZGF0ZTogIjIwMjUtMDItMjEiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgICAgdG9jOiBUUlVFCiAgICAgIHRvY19mbG9hdDogVFJVRQogICAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICAgIHRoZW1lOiAic3BhY2VsYWIiCiAgICAgIGhpZ2hsaWdodDogImthdGUiCi0tLQoKIVtdKC9Vc2Vycy9vc2NhcmNhc3RhbmVkYWdhcmNpYS9Eb3dubG9hZHMvbGEtcHVyZ2EuanBnKQoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5Db250ZXh0bzwvc3Bhbj4gIApMYSBiYXNlIGRlIGRhdG9zICoqVVNBcnJlc3RzKiogY29udGllbmUgZXN0YWTDrXN0aWNhcyBlbiBhcnJlc3RvcyBwb3IgY2FkYSAxMDAsMDAwIHJlc2lkZW50ZXMgcG9yIGFncmVzacOzbiwgYXNlc2luYXRvIHkgdmlvbGFjacOzbiBlbiBjYWRhIHVubyBkZSBsb3MgNTAgZXN0YWRvcyBkZSBFRS5VVS4gZW4gMTk3My4KCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsYWNrOyI+SW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXMgbGlicmVyaWFzPC9zcGFuPgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQojaW5zdGFsbC5wYWNrYWdlcygiY2x1c3RlciIpICMgUGFyYSBhZ3J1cGFtaWVudG9zCmxpYnJhcnkoY2x1c3RlcikKI2luc3RhbGwucGFja2FnZXMoImdncGxvdDIiKSAjIEhhY2VyIEdyw6FmaWNhcwpsaWJyYXJ5KGdncGxvdDIpCiNpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikgIyBWaXN1YWxpemFjacOzbiBDbHVzdGVycwpsaWJyYXJ5KGZhY3RvZXh0cmEpCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikgIyBDb25qdW50byBkZSBkYXRvcyBncmFuZGUKbGlicmFyeShkYXRhLnRhYmxlKQpsaWJyYXJ5KHRpZHl2ZXJzZSkKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsYWNrOyI+SW1wb3J0YXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4KYGBge3J9CmRhdG9zIDwtIFVTQXJyZXN0cwpgYGAKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+CmBgYHtyfQpzdW1tYXJ5KGRhdG9zKQpgYGAKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmxhY2s7Ij5Fc2NhbGFyIGJhc2UgZGUgZGF0b3M8L3NwYW4+ICAKYGBge3J9CiMgRXNjYWxhciBsYSBiYXNlIGRlIGRhdG9zCmRhdG9zX2VzY2FsYWRvcyA8LSBzY2FsZShVU0FycmVzdHMpCgojIFZlcmlmaWNhciBsYSBtZWRpYSB5IGRlc3ZpYWNpw7NuIGVzdMOhbmRhciBkZXNwdcOpcyBkZWwgZXNjYWxhZG8Kc3VtbWFyeShkYXRvc19lc2NhbGFkb3MpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkdlbmVyYXIgbG9zIHNlZ21lbnRvczwvc3Bhbj4KYGBge3J9CmdydXBvcyA8LSA0ICMgSW5pY2lvIGNvbiBjdWFscXVpZXIgdmFsb3IsIGx1ZWdvIHZlcmlmaWNhbW9zCnNlZ21lbnRvcyA8LSBrbWVhbnMoZGF0b3NfZXNjYWxhZG9zLCBncnVwb3MpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkFzaWduYXIgZ3J1cG9zIGEgbG9zIGRhdG9zPC9zcGFuPgpgYGB7cn0KYXNpZ25hY2lvbiA8LSBjYmluZChkYXRvcywgY2x1c3RlciA9IAogICAgICAgICAgICAgICAgICAgICAgc2VnbWVudG9zJGNsdXN0ZXIpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkdyYWZpY2FyIGxvcyBjbHVzdGVyczwvc3Bhbj4KYGBge3J9CmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsIGRhdGE9ZGF0b3MpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPk9wdGltaXphciBsYSBjYW50aWRhZCBkZSBncnVwb3M8L3NwYW4+CmBgYHtyfQojTGEgY2FudGlkYWQgb3B0aW1hIGRlIGdydXBvcyBjb3JyZXNwb25kZSBhbCBwdW50byBtYXMgYWx0byBkZSBsYSBncmFmaWNhCnNldC5zZWVkKDEyMykKb3B0aW1pemFjaW9uICA8LSBjbHVzR2FwKGRhdG9zX2VzY2FsYWRvcywgRlVOPWttZWFucywgbnN0YXJ0PTEsIEsubWF4PTEwKQpwbG90KG9wdGltaXphY2lvbiwgeGxhYj0iTsO6bWVybyBkZSBjbHVzdGVycyBrIixtYWluPSJNw6l0b2RvIGRlIHNpbHVldGEiKQojIGZ2aXpfbmJjbHVzdChkZixrbWVhbnMsbWV0aG9kPSJ3c3MiKSArCiAgI2dndGl0bGUoIk3DqXRvZG8gZGVsIGNvZG8iKQpgYGAKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkNvbXBhcmFyIHNlZ21lbnRvczwvc3Bhbj4KYGBge3J9CnByb21lZGlvIDwtIGFnZ3JlZ2F0ZShhc2lnbmFjaW9uLCBieT1saXN0KGFzaWduYWNpb24kY2x1c3RlciksRlVOPW1lYW4pCnByb21lZGlvCnRhYmxlKGFzaWduYWNpb24kY2x1c3RlcikKYGBgCiMgT2J0ZW5lciBNYXBhIGRlIFVTQQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KHNmKQojaW5zdGFsbC5wYWNrYWdlcygidGlncmlzIikKbGlicmFyeSh0aWdyaXMpCmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeSh0aWdyaXMpCmBgYAoKIyBVbmlyIG1hcGEgY29uIGRhdG9zCmBgYHtyfQojIE9idGVuZXIgZWwgbWFwYSBkZSBFRS5VVS4KdXNfbWFwIDwtIHN0YXRlcyhjYiA9IFRSVUUpCmBgYAoKYGBge3J9CiMgQWdyZWdhciBsYSBjbGFzaWZpY2FjacOzbiBkZSBzZWd1cmlkYWQgYmFzYWRhIGVuIGxvcyBjbHVzdGVycwphc2lnbmFjaW9uJG5pdmVsX3NlZ3VyaWRhZCA8LSBjYXNlX3doZW4oCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDEgfiAiTXV5IGluc2VndXJvIiwKICBhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gMiB+ICJJbnNlZ3VybyIsCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDMgfiAiU2VndXJvIiwKICBhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gNCB+ICJNdXkgU2VndXJvIiwKICBUUlVFIH4gIkRlc2Nvbm9jaWRvIiAgCikKaGVhZChhc2lnbmFjaW9uKQpgYGAKCmBgYHtyfQphc2lnbmFjaW9uIDwtIGFzaWduYWNpb24gJT4lCiAgcm93bmFtZXNfdG9fY29sdW1uKHZhciA9ICJzdGF0ZSIpCmBgYAoKIyBHcmFmaWNhciBsb3MgY2x1c3RlcnMgZW4gZWwgbWFwYQpgYGB7cn0KIyBVbmlyIGxvcyBkYXRvcyBjb24gZWwgbWFwYSBkZSBFRS5VVS4KdXNfY2x1c3RlcmVkIDwtIGxlZnRfam9pbih1c19tYXAsIGFzaWduYWNpb24sIGJ5ID0gYygiTkFNRSIgPSAic3RhdGUiKSkKCiMgRGVmaW5pciBjb2xvcmVzIHNlZ8O6biBlbCBuaXZlbCBkZSBzZWd1cmlkYWQKY29sb3Jlc19zZWd1cmlkYWQgPC0gYygiTXV5IGluc2VndXJvIiA9ICJyZWQiLCAKICAgICAgICAgICAgICAgICAgICAgICAiSW5zZWd1cm8iID0gInllbGxvdyIsIAogICAgICAgICAgICAgICAgICAgICAgICJTZWd1cm8iID0gIm9yYW5nZSIsIAogICAgICAgICAgICAgICAgICAgICAgICJNdXkgU2VndXJvIiA9ICJkYXJrZ3JlZW4iKQoKIyBHcmFmaWNhciBlbCBtYXBhCmdncGxvdChkYXRhID0gdXNfY2x1c3RlcmVkKSArCiAgZ2VvbV9zZihhZXMoZmlsbCA9IG5pdmVsX3NlZ3VyaWRhZCksIGNvbG9yID0gImJsYWNrIiwgc2l6ZSA9IDAuMikgKyAgCiAgc2NhbGVfZmlsbF9tYW51YWwodmFsdWVzID0gY29sb3Jlc19zZWd1cmlkYWQsIG5hbWUgPSAiTml2ZWwgZGUgU2VndXJpZGFkIikgKwogIGxhYnModGl0bGUgPSAiTWFwYSBkZSBTZWd1cmlkYWQgZW4gRUUuVVUuICgxOTczKSIsCiAgICAgICBzdWJ0aXRsZSA9ICJDbGFzaWZpY2FjacOzbiBiYXNhZGEgZW4gdGFzYXMgZGUgY3JpbWluYWxpZGFkIiwKICAgICAgIGNhcHRpb24gPSAiRnVlbnRlOiBVU0FycmVzdHMiKSArCiAgdGhlbWVfbWluaW1hbCgpCmBgYAoKCg==