USArrests
Ana Paula Alvear Cantú
2025-02-21
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
#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)Importar base de datos
datos <- USArrests
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 la 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")
#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 10.81538 257.38462 76.00000 33.19231 1
## 2 2 5.65625 138.87500 73.87500 18.78125 2
## 3 3 13.93750 243.62500 53.75000 21.41250 3
## 4 4 3.60000 78.53846 52.07692 12.17692 4table(asignacion$cluster)##
## 1 2 3 4
## 13 16 8 13Obtener Mapa de USA
library(sf)
#install.packages("tigris")
library(tigris)
library(ggplot2)
#install.packages("tibble")
library(tibble)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% | |================= | 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% | |============================================================= | 86% | |============================================================= | 87% | |============================================================== | 88% | |============================================================== | 89% | |=============================================================== | 89% | |=============================================================== | 90% | |================================================================ | 91% | |================================================================ | 92% | |================================================================= | 92% | |================================================================= | 93% | |================================================================== | 94% | |================================================================== | 95% | |=================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 97% | |==================================================================== | 98% | |===================================================================== | 98% | |===================================================================== | 99% | |======================================================================| 99% | |======================================================================| 100%asignacion$nivel_seguridad <- case_when(
asignacion$cluster == 1 ~ "Alto",
asignacion$cluster == 2 ~ "Muy Alto",
asignacion$cluster == 3 ~ "Medio",
asignacion$cluster == 4 ~ "Bajo",
TRUE ~ "Desconocido" # Para manejar cualquier error
)
head(asignacion)## Murder Assault UrbanPop Rape cluster nivel_seguridad
## Alabama 13.2 236 58 21.2 3 Medio
## Alaska 10.0 263 48 44.5 1 Alto
## Arizona 8.1 294 80 31.0 1 Alto
## Arkansas 8.8 190 50 19.5 3 Medio
## California 9.0 276 91 40.6 1 Alto
## Colorado 7.9 204 78 38.7 1 Altoasignacion <- 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 Alto" = "red",
"Alto" = "orange",
"Medio" = "yellow",
"Bajo" = "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()
LS0tCnRpdGxlOiAiVVNBcnJlc3RzIgphdXRob3I6ICJBbmEgUGF1bGEgQWx2ZWFyIENhbnTDuiIKZGF0ZTogIjIwMjUtMDItMjEiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogVFJVRQogICAgdG9jX2Zsb2F0OiBUUlVFCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICB0aGVtZTogam91cm5hbAotLS0KCiFbXSgvVXNlcnMvYW5hcGF1YWx2ZWFyL0Rlc2t0b3AvbW9kdWxvIDIgUi85ZWQxMmY5YS1iMmNmLTQ5ZTgtYmRhOS1hOGFkNDVmNmNlY2ZfdGV4dC5naWYpCgpMYSBiYXNlIGRlIGRhdG9zICpVU0FycmVzdHMqIGNvbnRpZW5lIGVzdGFkw61zdGljYXMgZW4gYXJyZXN0b3MgcG9yIGNhZGEgMTAwLDAwMCByZXNpZGVudGVzIHBvciBhZ3Jlc2nDs24sIGFzZXNpbmF0byB5IHZpb2xhY2nDs24gZW4gY2FkYSB1bm8gZGUgbG9zIDUwIGVzdGFkb3MgZGUgRUUuVVUuIGVuIDE5NzMuCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+SW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hczwvc3Bhbj4KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KI2luc3RhbGwucGFja2FnZXMoImNsdXN0ZXIiKSAjIFBhcmEgYWdydXBhbWllbnRvcwpsaWJyYXJ5KGNsdXN0ZXIpCiNpbnN0YWxsLnBhY2thZ2VzKCJnZ3Bsb3QyIikgIyBIYWNlciBHcsOhZmljYXMKbGlicmFyeShnZ3Bsb3QyKQojaW5zdGFsbC5wYWNrYWdlcygiZmFjdG9leHRyYSIpICMgVmlzdWFsaXphY2nDs24gQ2x1c3RlcnMKbGlicmFyeShmYWN0b2V4dHJhKQojaW5zdGFsbC5wYWNrYWdlcygiZGF0YS50YWJsZSIpICMgQ29uanVudG8gZGUgZGF0b3MgZ3JhbmRlCmxpYnJhcnkoZGF0YS50YWJsZSkKbGlicmFyeSh0aWR5dmVyc2UpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPkltcG9ydGFyIGJhc2UgZGUgZGF0b3M8L3NwYW4+CmBgYHtyfQpkYXRvcyA8LSBVU0FycmVzdHMKc3VtbWFyeShkYXRvcykKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPkVzY2FsYXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4gIApgYGB7cn0KIyBFc2NhbGFyIGxhIGJhc2UgZGUgZGF0b3MKZGF0b3NfZXNjYWxhZG9zIDwtIHNjYWxlKFVTQXJyZXN0cykKCiMgVmVyaWZpY2FyIGxhIG1lZGlhIHkgZGVzdmlhY2nDs24gZXN0w6FuZGFyIGRlc3B1w6lzIGRlbCBlc2NhbGFkbwpzdW1tYXJ5KGRhdG9zX2VzY2FsYWRvcykKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPkdlbmVyYXIgbG9zIHNlZ21lbnRvczwvc3Bhbj4gIApgYGB7cn0KZ3J1cG9zIDwtIDQgIyBJbmljaW8gY29uIGN1YWxxdWllciB2YWxvciwgbHVlZ28gdmVyaWZpY2Ftb3MKc2VnbWVudG9zIDwtIGttZWFucyhkYXRvc19lc2NhbGFkb3MsIGdydXBvcykKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPkFzaWduYXIgZ3J1cG9zIGEgbG9zIGRhdG9zPC9zcGFuPiAgCmBgYHtyfQphc2lnbmFjaW9uIDwtIGNiaW5kKGRhdG9zLCBjbHVzdGVyID0gCiAgICAgICAgICAgICAgICAgICAgICBzZWdtZW50b3MkY2x1c3RlcikKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPkdyYWZpY2FyIGxvcyBjbHVzdGVyczwvc3Bhbj4gIApgYGB7cn0KZnZpel9jbHVzdGVyKHNlZ21lbnRvcywgZGF0YT1kYXRvcykKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5PcHRpbWl6YXIgbGEgY2FudGlkYWQgZGUgZ3J1cG9zPC9zcGFuPgpgYGB7cn0KI0xhIGNhbnRpZGFkIG9wdGltYSBkZSBncnVwb3MgY29ycmVzcG9uZGUgYWwgcHVudG8gbWFzIGFsdG8gZGUgbGEgZ3JhZmljYQpzZXQuc2VlZCgxMjMpCm9wdGltaXphY2lvbiAgPC0gY2x1c0dhcChkYXRvc19lc2NhbGFkb3MsIEZVTj1rbWVhbnMsIG5zdGFydD0xLCBLLm1heD0xMCkKcGxvdChvcHRpbWl6YWNpb24sIHhsYWI9Ik7Dum1lcm8gZGUgY2x1c3RlcnMgayIpCgojZnZpel9uYmNsdXN0KGRmLGttZWFucyxtZXRob2QgPSAid3NzIikgKwojICBnZ3RpdGxlKCJNw6l0b2RvIGRlbCBjb2RvIikKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5Db21wYXJhciBzZWdtZW50b3M8L3NwYW4+CmBgYHtyfQpwcm9tZWRpbyA8LSBhZ2dyZWdhdGUoYXNpZ25hY2lvbiwgYnk9bGlzdChhc2lnbmFjaW9uJGNsdXN0ZXIpLEZVTj1tZWFuKQpwcm9tZWRpbwp0YWJsZShhc2lnbmFjaW9uJGNsdXN0ZXIpCmBgYAoKIyBPYnRlbmVyIE1hcGEgZGUgVVNBCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkoc2YpCiNpbnN0YWxsLnBhY2thZ2VzKCJ0aWdyaXMiKQpsaWJyYXJ5KHRpZ3JpcykKbGlicmFyeShnZ3Bsb3QyKQojaW5zdGFsbC5wYWNrYWdlcygidGliYmxlIikKbGlicmFyeSh0aWJibGUpCgpgYGAKCiMgVW5pciBtYXBhIGNvbiBkYXRvcwpgYGB7cn0KIyBPYnRlbmVyIGVsIG1hcGEgZGUgRUUuVVUuCnVzX21hcCA8LSBzdGF0ZXMoY2IgPSBUUlVFKQpgYGAKCmBgYHtyfQphc2lnbmFjaW9uJG5pdmVsX3NlZ3VyaWRhZCA8LSBjYXNlX3doZW4oCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDEgfiAiQWx0byIsCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDIgfiAiTXV5IEFsdG8iLAogIGFzaWduYWNpb24kY2x1c3RlciA9PSAzIH4gIk1lZGlvIiwKICBhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gNCB+ICJCYWpvIiwKICBUUlVFIH4gIkRlc2Nvbm9jaWRvIiAgIyBQYXJhIG1hbmVqYXIgY3VhbHF1aWVyIGVycm9yCikKaGVhZChhc2lnbmFjaW9uKQpgYGAKCmBgYHtyfQphc2lnbmFjaW9uIDwtIGFzaWduYWNpb24gJT4lCiAgcm93bmFtZXNfdG9fY29sdW1uKHZhciA9ICJzdGF0ZSIpCmBgYAoKIyBHcmFmaWNhciBsb3MgY2x1c3RlcnMgZW4gZWwgbWFwYQpgYGB7cn0KIyBVbmlyIGxvcyBkYXRvcyBjb24gZWwgbWFwYSBkZSBFRS5VVS4KdXNfY2x1c3RlcmVkIDwtIGxlZnRfam9pbih1c19tYXAsIGFzaWduYWNpb24sIGJ5ID0gYygiTkFNRSIgPSAic3RhdGUiKSkKCiMgRGVmaW5pciBjb2xvcmVzIHNlZ8O6biBlbCBuaXZlbCBkZSBzZWd1cmlkYWQKY29sb3Jlc19zZWd1cmlkYWQgPC0gYygiTXV5IEFsdG8iID0gInJlZCIsIAogICAgICAgICAgICAgICAgICAgICAgICJBbHRvIiA9ICJvcmFuZ2UiLCAKICAgICAgICAgICAgICAgICAgICAgICAiTWVkaW8iID0gInllbGxvdyIsIAogICAgICAgICAgICAgICAgICAgICAgICJCYWpvIiA9ICJkYXJrZ3JlZW4iKQoKIyBHcmFmaWNhciBlbCBtYXBhCmdncGxvdChkYXRhID0gdXNfY2x1c3RlcmVkKSArCiAgZ2VvbV9zZihhZXMoZmlsbCA9IG5pdmVsX3NlZ3VyaWRhZCksIGNvbG9yID0gImJsYWNrIiwgc2l6ZSA9IDAuMikgKyAgCiAgc2NhbGVfZmlsbF9tYW51YWwodmFsdWVzID0gY29sb3Jlc19zZWd1cmlkYWQsIG5hbWUgPSAiTml2ZWwgZGUgU2VndXJpZGFkIikgKwogIGxhYnModGl0bGUgPSAiTWFwYSBkZSBTZWd1cmlkYWQgZW4gRUUuVVUuICgxOTczKSIsCiAgICAgICBzdWJ0aXRsZSA9ICJDbGFzaWZpY2FjacOzbiBiYXNhZGEgZW4gdGFzYXMgZGUgY3JpbWluYWxpZGFkIiwKICAgICAgIGNhcHRpb24gPSAiRnVlbnRlOiBVU0FycmVzdHMiKSArCiAgdGhlbWVfbWluaW1hbCgpCmBgYAo=