USArrests
Carolina Suárez A00837922
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 llamar librerías
library(cluster)
library(ggplot2)
library(factoextra)
library(data.table)
library(tidyverse)
#install.packages("tibble")
library(tibble)Importar la base de datos
datos <- USArrestsEntender la base de datos
summary(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
grupos <- 4 # Inicio con cualquier valor, luego verificamos
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 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")
# fviz_nbclust(df,kmeans,method="wss") +
#ggtitle("Método del codo")Comparar segmentos
promedio <- aggregate(asignacion, by=list(asignacion$cluster),FUN=mean)
promedio## Group.1 Murder Assault UrbanPop Rape cluster
## 1 1 5.65625 138.87500 73.87500 18.78125 1
## 2 2 13.93750 243.62500 53.75000 21.41250 2
## 3 3 3.60000 78.53846 52.07692 12.17692 3
## 4 4 10.81538 257.38462 76.00000 33.19231 4table(asignacion$cluster)##
## 1 2 3 4
## 16 8 13 13Obtener Mapa de USA
library(sf)
#install.packages("tigris")
library(tigris)
library(ggplot2)
library(tigris)Unir mapa con datos
# Obtener el mapa de EE.UU.
us_map <- states(cb = TRUE)## Retrieving data for the year 2021## | | | 0% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======= | 9% | |======= | 10% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========== | 14% | |========== | 15% | |=========== | 15% | |=========== | 16% | |============ | 17% | |============ | 18% | |============= | 18% | |============= | 19% | |============== | 20% | |============== | 21% | |=============== | 21% | |=============== | 22% | |================ | 23% | |================= | 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% | |======================================= | 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% | |============================================================= | 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 2 Inseguro
## Alaska 10.0 263 48 44.5 4 Muy Seguro
## Arizona 8.1 294 80 31.0 4 Muy Seguro
## Arkansas 8.8 190 50 19.5 2 Inseguro
## California 9.0 276 91 40.6 4 Muy Seguro
## Colorado 7.9 204 78 38.7 4 Muy Seguroasignacion <- asignacion %>%
rownames_to_column(var = "state")Graficar 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()
LS0tCnRpdGxlOiAiVVNBcnJlc3RzIgphdXRob3I6ICJDYXJvbGluYSBTdcOhcmV6IEEwMDgzNzkyMiIKZGF0ZTogIjIwMjUtMDItMjEiCm91dHB1dDogCiAgIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IFRSVUUKICAgIHRvY19mbG9hdDogVFJVRQogICAgY29kZV9kb3dubG9hZDogVFJVRQogICAgdGhlbWU6ICJzcGFjZWxhYiIKLS0tCgohW10oL1VzZXJzL2Nhcm9zdWFyZXovRG93bmxvYWRzLzIwMHcuZ2lmKQoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsYWNrOyI+Q29udGV4dG88L3NwYW4+CkxhIGJhc2UgZGUgZGF0b3MgKlVTQXJyZXN0cyogY29udGllbmUgZXN0YWTDrXN0aWNhcyBlbiBhcnJlc3RvcyBwb3IgY2FkYSAxMDAsMDAwIHJlc2lkZW50ZXMgcG9yIGFncmVzacOzbiwgYXNlc2luYXRvIHkgdmlvbGFjacOzbiBlbiBjYWRhIHVubyBkZSBsb3MgNTAgZXN0YWRvcyBkZSBFRS5VVS4gZW4gMTk3My4KCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXM8L3NwYW4+CmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkoY2x1c3RlcikKbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KGZhY3RvZXh0cmEpCmxpYnJhcnkoZGF0YS50YWJsZSkKbGlicmFyeSh0aWR5dmVyc2UpCiNpbnN0YWxsLnBhY2thZ2VzKCJ0aWJibGUiKQpsaWJyYXJ5KHRpYmJsZSkKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsYWNrOyI+SW1wb3J0YXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4KYGBge3J9CmRhdG9zIDwtIFVTQXJyZXN0cwpgYGAKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+CmBgYHtyfQpzdW1tYXJ5KGRhdG9zKQpgYGAKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmxhY2s7Ij5Fc2NhbGFyIGJhc2UgZGUgZGF0b3M8L3NwYW4+ICAKYGBge3J9CiMgRXNjYWxhciBsYSBiYXNlIGRlIGRhdG9zCmRhdG9zX2VzY2FsYWRvcyA8LSBzY2FsZShVU0FycmVzdHMpCgojIFZlcmlmaWNhciBsYSBtZWRpYSB5IGRlc3ZpYWNpw7NuIGVzdMOhbmRhciBkZXNwdcOpcyBkZWwgZXNjYWxhZG8Kc3VtbWFyeShkYXRvc19lc2NhbGFkb3MpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkdlbmVyYXIgbG9zIHNlZ21lbnRvczwvc3Bhbj4KYGBge3J9CmdydXBvcyA8LSA0ICMgSW5pY2lvIGNvbiBjdWFscXVpZXIgdmFsb3IsIGx1ZWdvIHZlcmlmaWNhbW9zCnNlZ21lbnRvcyA8LSBrbWVhbnMoZGF0b3NfZXNjYWxhZG9zLCBncnVwb3MpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkFzaWduYXIgZ3J1cG9zIGEgbG9zIGRhdG9zPC9zcGFuPgpgYGB7cn0KYXNpZ25hY2lvbiA8LSBjYmluZChkYXRvcywgY2x1c3RlciA9IAogICAgICAgICAgICAgICAgICAgICAgc2VnbWVudG9zJGNsdXN0ZXIpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkdyYWZpY2FyIGxvcyBjbHVzdGVyczwvc3Bhbj4KYGBge3J9CmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsIGRhdGE9ZGF0b3MpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPk9wdGltaXphciBsYSBjYW50aWRhZCBkZSBncnVwb3M8L3NwYW4+CmBgYHtyfQojTGEgY2FudGlkYWQgb3B0aW1hIGRlIGdydXBvcyBjb3JyZXNwb25kZSBhbCBwdW50byBtYXMgYWx0byBkZSBsYSBncmFmaWNhCnNldC5zZWVkKDEyMykKb3B0aW1pemFjaW9uICA8LSBjbHVzR2FwKGRhdG9zX2VzY2FsYWRvcywgRlVOPWttZWFucywgbnN0YXJ0PTEsIEsubWF4PTEwKQpwbG90KG9wdGltaXphY2lvbiwgeGxhYj0iTsO6bWVybyBkZSBjbHVzdGVycyBrIixtYWluPSJNw6l0b2RvIGRlIHNpbHVldGEiKQojIGZ2aXpfbmJjbHVzdChkZixrbWVhbnMsbWV0aG9kPSJ3c3MiKSArCiAgI2dndGl0bGUoIk3DqXRvZG8gZGVsIGNvZG8iKQpgYGAKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjazsiPkNvbXBhcmFyIHNlZ21lbnRvczwvc3Bhbj4KYGBge3J9CnByb21lZGlvIDwtIGFnZ3JlZ2F0ZShhc2lnbmFjaW9uLCBieT1saXN0KGFzaWduYWNpb24kY2x1c3RlciksRlVOPW1lYW4pCnByb21lZGlvCnRhYmxlKGFzaWduYWNpb24kY2x1c3RlcikKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogYmxhY2s7Ij5PYnRlbmVyIE1hcGEgZGUgVVNBPC9zcGFuPgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KHNmKQojaW5zdGFsbC5wYWNrYWdlcygidGlncmlzIikKbGlicmFyeSh0aWdyaXMpCmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeSh0aWdyaXMpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsYWNrOyI+VW5pciBtYXBhIGNvbiBkYXRvcyA8L3NwYW4+CmBgYHtyfQojIE9idGVuZXIgZWwgbWFwYSBkZSBFRS5VVS4KdXNfbWFwIDwtIHN0YXRlcyhjYiA9IFRSVUUpCmBgYAoKYGBge3J9CiMgQWdyZWdhciBsYSBjbGFzaWZpY2FjacOzbiBkZSBzZWd1cmlkYWQgYmFzYWRhIGVuIGxvcyBjbHVzdGVycwphc2lnbmFjaW9uJG5pdmVsX3NlZ3VyaWRhZCA8LSBjYXNlX3doZW4oCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDEgfiAiTXV5IGluc2VndXJvIiwKICBhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gMiB+ICJJbnNlZ3VybyIsCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDMgfiAiU2VndXJvIiwKICBhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gNCB+ICJNdXkgU2VndXJvIiwKICBUUlVFIH4gIkRlc2Nvbm9jaWRvIiAgCikKaGVhZChhc2lnbmFjaW9uKQpgYGAKYGBge3J9CmFzaWduYWNpb24gPC0gYXNpZ25hY2lvbiAlPiUKICByb3duYW1lc190b19jb2x1bW4odmFyID0gInN0YXRlIikKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogYmxhY2s7Ij5HcmFmaWNhciBsb3MgY2x1c3RlcnMgZW4gZWwgbWFwYTwvc3Bhbj4KYGBge3J9CiMgVW5pciBsb3MgZGF0b3MgY29uIGVsIG1hcGEgZGUgRUUuVVUuCnVzX2NsdXN0ZXJlZCA8LSBsZWZ0X2pvaW4odXNfbWFwLCBhc2lnbmFjaW9uLCBieSA9IGMoIk5BTUUiID0gInN0YXRlIikpCgojIERlZmluaXIgY29sb3JlcyBzZWfDum4gZWwgbml2ZWwgZGUgc2VndXJpZGFkCmNvbG9yZXNfc2VndXJpZGFkIDwtIGMoIk11eSBpbnNlZ3VybyIgPSAicmVkIiwgCiAgICAgICAgICAgICAgICAgICAgICAgIkluc2VndXJvIiA9ICJ5ZWxsb3ciLCAKICAgICAgICAgICAgICAgICAgICAgICAiU2VndXJvIiA9ICJvcmFuZ2UiLCAKICAgICAgICAgICAgICAgICAgICAgICAiTXV5IFNlZ3VybyIgPSAiZGFya2dyZWVuIikKCiMgR3JhZmljYXIgZWwgbWFwYQpnZ3Bsb3QoZGF0YSA9IHVzX2NsdXN0ZXJlZCkgKwogIGdlb21fc2YoYWVzKGZpbGwgPSBuaXZlbF9zZWd1cmlkYWQpLCBjb2xvciA9ICJibGFjayIsIHNpemUgPSAwLjIpICsgIAogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGNvbG9yZXNfc2VndXJpZGFkLCBuYW1lID0gIk5pdmVsIGRlIFNlZ3VyaWRhZCIpICsKICBsYWJzKHRpdGxlID0gIk1hcGEgZGUgU2VndXJpZGFkIGVuIEVFLlVVLiAoMTk3MykiLAogICAgICAgc3VidGl0bGUgPSAiQ2xhc2lmaWNhY2nDs24gYmFzYWRhIGVuIHRhc2FzIGRlIGNyaW1pbmFsaWRhZCIsCiAgICAgICBjYXB0aW9uID0gIkZ1ZW50ZTogVVNBcnJlc3RzIikgKwogIHRoZW1lX21pbmltYWwoKQpgYGAKCgoK