Contexto

This data set contains statistics, in arrests per 100,000 residents for assault, murder, and rape in each of the 50 US states in 1973. Also given is the percent of the population living in urban areas

Paso 1 - Instalar librerías

#install.packages("cluster")
library(cluster)
## Warning: package 'cluster' was built under R version 4.2.3
#install.packages("ggplot2")
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.2.3
#install.packages("data.table")
library(data.table)
#install.packages("factoextra")
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(maps)
## Warning: package 'maps' was built under R version 4.2.3
## 
## Attaching package: 'maps'
## The following object is masked from 'package:cluster':
## 
##     votes.repub

Paso 2 - Escalar datos

df <- USArrests
df1 <- USArrests[,-c(3)]
dfescalada <- scale(df1)

Paso 3 - Cantidad de grupos

grupos <- 5

Paso 4 - Generar segmentos

segmentos <- kmeans (dfescalada,grupos)
segmentos
## K-means clustering with 5 clusters of sizes 7, 12, 12, 11, 8
## 
## Cluster means:
##       Murder     Assault       Rape
## 1  0.5308219  1.08625216  1.8207361
## 2  1.3420549  1.04882553  0.2875176
## 3 -1.1471294 -1.06406474 -1.1235570
## 4 -0.4000784 -0.68544804 -0.3305049
## 5 -0.2067496  0.01487923  0.1153593
## 
## Clustering vector:
##        Alabama         Alaska        Arizona       Arkansas     California 
##              2              1              1              5              1 
##       Colorado    Connecticut       Delaware        Florida        Georgia 
##              1              3              5              2              2 
##         Hawaii          Idaho       Illinois        Indiana           Iowa 
##              4              3              2              4              3 
##         Kansas       Kentucky      Louisiana          Maine       Maryland 
##              4              4              2              3              2 
##  Massachusetts       Michigan      Minnesota    Mississippi       Missouri 
##              4              1              3              2              5 
##        Montana       Nebraska         Nevada  New Hampshire     New Jersey 
##              4              4              1              3              5 
##     New Mexico       New York North Carolina   North Dakota           Ohio 
##              1              2              2              3              4 
##       Oklahoma         Oregon   Pennsylvania   Rhode Island South Carolina 
##              5              5              4              3              2 
##   South Dakota      Tennessee          Texas           Utah        Vermont 
##              3              2              2              4              3 
##       Virginia     Washington  West Virginia      Wisconsin        Wyoming 
##              5              5              3              3              4 
## 
## Within cluster sum of squares by cluster:
## [1] 4.158414 8.838465 3.793704 3.714932 4.144240
##  (between_SS / total_SS =  83.2 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Paso 5 - Asignar el grupo de cada observación

asignacion <- cbind(df1,cluster = segmentos$cluster)
asignacion
##                Murder Assault Rape cluster
## Alabama          13.2     236 21.2       2
## Alaska           10.0     263 44.5       1
## Arizona           8.1     294 31.0       1
## Arkansas          8.8     190 19.5       5
## California        9.0     276 40.6       1
## Colorado          7.9     204 38.7       1
## Connecticut       3.3     110 11.1       3
## Delaware          5.9     238 15.8       5
## Florida          15.4     335 31.9       2
## Georgia          17.4     211 25.8       2
## Hawaii            5.3      46 20.2       4
## Idaho             2.6     120 14.2       3
## Illinois         10.4     249 24.0       2
## Indiana           7.2     113 21.0       4
## Iowa              2.2      56 11.3       3
## Kansas            6.0     115 18.0       4
## Kentucky          9.7     109 16.3       4
## Louisiana        15.4     249 22.2       2
## Maine             2.1      83  7.8       3
## Maryland         11.3     300 27.8       2
## Massachusetts     4.4     149 16.3       4
## Michigan         12.1     255 35.1       1
## Minnesota         2.7      72 14.9       3
## Mississippi      16.1     259 17.1       2
## Missouri          9.0     178 28.2       5
## Montana           6.0     109 16.4       4
## Nebraska          4.3     102 16.5       4
## Nevada           12.2     252 46.0       1
## New Hampshire     2.1      57  9.5       3
## New Jersey        7.4     159 18.8       5
## New Mexico       11.4     285 32.1       1
## New York         11.1     254 26.1       2
## North Carolina   13.0     337 16.1       2
## North Dakota      0.8      45  7.3       3
## Ohio              7.3     120 21.4       4
## Oklahoma          6.6     151 20.0       5
## Oregon            4.9     159 29.3       5
## Pennsylvania      6.3     106 14.9       4
## Rhode Island      3.4     174  8.3       3
## South Carolina   14.4     279 22.5       2
## South Dakota      3.8      86 12.8       3
## Tennessee        13.2     188 26.9       2
## Texas            12.7     201 25.5       2
## Utah              3.2     120 22.9       4
## Vermont           2.2      48 11.2       3
## Virginia          8.5     156 20.7       5
## Washington        4.0     145 26.2       5
## West Virginia     5.7      81  9.3       3
## Wisconsin         2.6      53 10.8       3
## Wyoming           6.8     161 15.6       4

Paso 6 - Graficar clusters

fviz_cluster(segmentos,data = dfescalada)

Paso 7 - Optimizar clusters

set.seed(123)
optimizacion <- clusGap(dfescalada, FUN = kmeans, nstart = 1, K.max = 10)
plot(optimizacion,xlab = "Numero de clusters k")

Paso 8 - Definir clusters

cluster1 <- rownames(df1)[which(asignacion$cluster == 1)]
cluster2 <- rownames(df1)[which(asignacion$cluster == 2)]
cluster3 <- rownames(df1)[which(asignacion$cluster == 3)]
cluster4 <- rownames(df1)[which(asignacion$cluster == 4)]
cluster5 <- rownames(df1)[which(asignacion$cluster == 5)]
promedio <- aggregate(asignacion, by = list(asignacion$cluster), FUN=mean)
promedio
##   Group.1    Murder   Assault     Rape cluster
## 1       1 10.100000 261.28571 38.28571       1
## 2       2 13.633333 258.16667 23.92500       2
## 3       3  2.791667  82.08333 10.70833       3
## 4       4  6.045455 113.63636 18.13636       4
## 5       5  6.887500 172.00000 22.31250       5

Paso 9 - Definir mapa

map(database = "state")
map (database = "state", cluster5, col = "green", fill = T, add = TRUE)
map (database = "state", cluster4, col = "lightgreen", fill = T, add = TRUE)
map (database = "state", cluster1, col = "yellow", fill = T, add = TRUE)
map (database = "state", cluster3, col = "orange", fill = T, add = TRUE)
map (database = "state", cluster2, col = "red", fill = T, add = TRUE)

Conclusiones

En conclusión, tras un análisis detallado de los promedios de arrestos por crimen en cada cluster, hemos podido identificar con claridad aquellos clusters que representan niveles de seguridad y de riesgo distintos dentro del país. Este estudio nos permitió priorizar y evaluar el nivel de inseguridad asociado a delitos de alta gravedad, como son el asesinato y la violación, sobre otros delitos menores como los robos. Esta diferenciación es crucial, dado que los primeros tienen un impacto más profundo y directo en la percepción de seguridad de la comunidad y en su bienestar general.

De acuerdo con los promedios calculados, el cluster 2 resultó como el más inseguro, destacándose por sus alarmantes tasas de violaciones, un delito que, por su naturaleza, tiende a tener efectos devastadores en las víctimas y en la estructura social de las comunidades afectadas. Por otro lado, el cluster 5 se caracterizó por presentar los niveles más bajos de arrestos en todas las categorías de crimen examinadas, lo que nos lleva a considerarlo como el más seguro. Este contraste entre clusters subraya la diversidad de contextos de seguridad que se pueden encontrar a lo largo del país.

Además, nuestro análisis reveló una división geográfica notable en términos de seguridad, con la región norte mostrándose significativamente más segura en comparación con la región sur. Este patrón podría estar influenciado por una serie de factores socioeconómicos y culturales. Entre ellos, la alta migración que enfrentan los estados del sur, el paso del tráfico de armas y drogas provenientes de la frontera con México, la desigualdad histórica en el sur del país, la cultura histórica y cultural del país con segregaciones raciales y múltiples problemas sociales y las legislaciones con altas libertades en la portación y uso de armas.

Los hallazgos actuales ofrecen una perspectiva valiosa de la situación de seguridad en el país, así mismo apuntan hacia la necesidad de estrategias de intervención en múltiples factores que aborden las raíces profundas de la inseguridad, esencialmente en la región sur del país y promuevan con ello el desarrollo de comunidades seguras y prósperas en todas las regiones.

LS0tCnRpdGxlOiAiVVNBcnJlc3RzIgphdXRob3I6ICJHYWJyaWVsIE1lZGluYSAtIEEwMTI3NTc2MywgTHVpcyBNZW5kb3phIC0gQTAwODI5MDk5LCBDZWNpbGlhIFJpdmFzIC0gQTAxMjg0ODc0IgpkYXRlOiAiMjAyNC0wMi0yMCIKb3V0cHV0OgogIGh0bWxfZG9jdW1lbnQ6CiAgICBjb2RlX2ZvbGRpbmc6IGhpZGUKICAgIHRvYzogeWVzCiAgICB0b2NfZmxvYXQ6IHllcwogICAgY29kZV9kb3dubG9hZDogeWVzCiAgICB0aGVtZTogZGFya2x5CiAgICBoaWdobGlnaHQ6IHRhbmdvCiAgcGRmX2RvY3VtZW50OgogICAgdG9jOiB5ZXMKLS0tCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiB5ZWxsb3c7Ij5Db250ZXh0bzwvc3Bhbj4KClRoaXMgZGF0YSBzZXQgY29udGFpbnMgc3RhdGlzdGljcywgaW4gYXJyZXN0cyBwZXIgMTAwLDAwMCByZXNpZGVudHMgZm9yIGFzc2F1bHQsIG11cmRlciwgYW5kIHJhcGUgaW4gZWFjaCBvZiB0aGUgNTAgVVMgc3RhdGVzIGluIDE5NzMuIEFsc28gZ2l2ZW4gaXMgdGhlIHBlcmNlbnQgb2YgdGhlIHBvcHVsYXRpb24gbGl2aW5nIGluIHVyYmFuIGFyZWFzCgoKIVtdKC9Vc2Vycy9nYWJyaWVsbWVkaW5hL0Rvd25sb2Fkcy9naWYuZ2lmKQoKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogeWVsbG93OyI+UGFzbyAxIC0gSW5zdGFsYXIgbGlicmVyw61hczwvc3Bhbj4KCgpgYGB7cn0KI2luc3RhbGwucGFja2FnZXMoImNsdXN0ZXIiKQpsaWJyYXJ5KGNsdXN0ZXIpCiNpbnN0YWxsLnBhY2thZ2VzKCJnZ3Bsb3QyIikKbGlicmFyeShnZ3Bsb3QyKQojaW5zdGFsbC5wYWNrYWdlcygiZGF0YS50YWJsZSIpCmxpYnJhcnkoZGF0YS50YWJsZSkKI2luc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKQpsaWJyYXJ5KGZhY3RvZXh0cmEpCmxpYnJhcnkobWFwcykKYGBgCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiB5ZWxsb3c7Ij5QYXNvIDIgLSBFc2NhbGFyIGRhdG9zPC9zcGFuPgoKCmBgYHtyfQoKCmRmIDwtIFVTQXJyZXN0cwpkZjEgPC0gVVNBcnJlc3RzWywtYygzKV0KZGZlc2NhbGFkYSA8LSBzY2FsZShkZjEpCmBgYAoKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogeWVsbG93OyI+UGFzbyAzIC0gQ2FudGlkYWQgZGUgZ3J1cG9zPC9zcGFuPgoKYGBge3J9CgoKZ3J1cG9zIDwtIDUKYGBgCgoKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogeWVsbG93OyI+UGFzbyA0IC0gR2VuZXJhciBzZWdtZW50b3M8L3NwYW4+CgoKYGBge3J9CgoKc2VnbWVudG9zIDwtIGttZWFucyAoZGZlc2NhbGFkYSxncnVwb3MpCnNlZ21lbnRvcwpgYGAKCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IHllbGxvdzsiPlBhc28gNSAtIEFzaWduYXIgZWwgZ3J1cG8gZGUgY2FkYSBvYnNlcnZhY2nDs248L3NwYW4+CgoKYGBge3J9CiAKCmFzaWduYWNpb24gPC0gY2JpbmQoZGYxLGNsdXN0ZXIgPSBzZWdtZW50b3MkY2x1c3RlcikKYXNpZ25hY2lvbgoKYGBgCgoKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogeWVsbG93OyI+UGFzbyA2IC0gR3JhZmljYXIgY2x1c3RlcnM8L3NwYW4+CgoKCmBgYHtyfQoKCmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsZGF0YSA9IGRmZXNjYWxhZGEpCmBgYAoKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogeWVsbG93OyI+UGFzbyA3IC0gT3B0aW1pemFyIGNsdXN0ZXJzPC9zcGFuPgoKCmBgYHtyfQpzZXQuc2VlZCgxMjMpCm9wdGltaXphY2lvbiA8LSBjbHVzR2FwKGRmZXNjYWxhZGEsIEZVTiA9IGttZWFucywgbnN0YXJ0ID0gMSwgSy5tYXggPSAxMCkKcGxvdChvcHRpbWl6YWNpb24seGxhYiA9ICJOdW1lcm8gZGUgY2x1c3RlcnMgayIpCmBgYAoKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogeWVsbG93OyI+UGFzbyA4IC0gRGVmaW5pciBjbHVzdGVyczwvc3Bhbj4KCgpgYGB7cn0KCgpjbHVzdGVyMSA8LSByb3duYW1lcyhkZjEpW3doaWNoKGFzaWduYWNpb24kY2x1c3RlciA9PSAxKV0KY2x1c3RlcjIgPC0gcm93bmFtZXMoZGYxKVt3aGljaChhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gMildCmNsdXN0ZXIzIDwtIHJvd25hbWVzKGRmMSlbd2hpY2goYXNpZ25hY2lvbiRjbHVzdGVyID09IDMpXQpjbHVzdGVyNCA8LSByb3duYW1lcyhkZjEpW3doaWNoKGFzaWduYWNpb24kY2x1c3RlciA9PSA0KV0KY2x1c3RlcjUgPC0gcm93bmFtZXMoZGYxKVt3aGljaChhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gNSldCgoKYGBgCgpgYGB7cn0KcHJvbWVkaW8gPC0gYWdncmVnYXRlKGFzaWduYWNpb24sIGJ5ID0gbGlzdChhc2lnbmFjaW9uJGNsdXN0ZXIpLCBGVU49bWVhbikKcHJvbWVkaW8KYGBgCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiB5ZWxsb3c7Ij5QYXNvIDkgLSBEZWZpbmlyIG1hcGE8L3NwYW4+CgoKYGBge3J9Cm1hcChkYXRhYmFzZSA9ICJzdGF0ZSIpCm1hcCAoZGF0YWJhc2UgPSAic3RhdGUiLCBjbHVzdGVyNSwgY29sID0gImdyZWVuIiwgZmlsbCA9IFQsIGFkZCA9IFRSVUUpCm1hcCAoZGF0YWJhc2UgPSAic3RhdGUiLCBjbHVzdGVyNCwgY29sID0gImxpZ2h0Z3JlZW4iLCBmaWxsID0gVCwgYWRkID0gVFJVRSkKbWFwIChkYXRhYmFzZSA9ICJzdGF0ZSIsIGNsdXN0ZXIxLCBjb2wgPSAieWVsbG93IiwgZmlsbCA9IFQsIGFkZCA9IFRSVUUpCm1hcCAoZGF0YWJhc2UgPSAic3RhdGUiLCBjbHVzdGVyMywgY29sID0gIm9yYW5nZSIsIGZpbGwgPSBULCBhZGQgPSBUUlVFKQptYXAgKGRhdGFiYXNlID0gInN0YXRlIiwgY2x1c3RlcjIsIGNvbCA9ICJyZWQiLCBmaWxsID0gVCwgYWRkID0gVFJVRSkKYGBgCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiB5ZWxsb3c7Ij5Db25jbHVzaW9uZXM8L3NwYW4+CgoKRW4gY29uY2x1c2nDs24sIHRyYXMgdW4gYW7DoWxpc2lzIGRldGFsbGFkbyBkZSBsb3MgcHJvbWVkaW9zIGRlIGFycmVzdG9zIHBvciBjcmltZW4gZW4gY2FkYSBjbHVzdGVyLCBoZW1vcyBwb2RpZG8gaWRlbnRpZmljYXIgY29uIGNsYXJpZGFkIGFxdWVsbG9zIGNsdXN0ZXJzIHF1ZSByZXByZXNlbnRhbiBuaXZlbGVzIGRlIHNlZ3VyaWRhZCB5IGRlIHJpZXNnbyBkaXN0aW50b3MgZGVudHJvIGRlbCBwYcOtcy4gRXN0ZSBlc3R1ZGlvIG5vcyBwZXJtaXRpw7MgcHJpb3JpemFyIHkgZXZhbHVhciBlbCBuaXZlbCBkZSBpbnNlZ3VyaWRhZCBhc29jaWFkbyBhIGRlbGl0b3MgZGUgYWx0YSBncmF2ZWRhZCwgY29tbyBzb24gZWwgYXNlc2luYXRvIHkgbGEgdmlvbGFjacOzbiwgc29icmUgb3Ryb3MgZGVsaXRvcyBtZW5vcmVzIGNvbW8gbG9zIHJvYm9zLiBFc3RhIGRpZmVyZW5jaWFjacOzbiBlcyBjcnVjaWFsLCBkYWRvIHF1ZSBsb3MgcHJpbWVyb3MgdGllbmVuIHVuIGltcGFjdG8gbcOhcyBwcm9mdW5kbyB5IGRpcmVjdG8gZW4gbGEgcGVyY2VwY2nDs24gZGUgc2VndXJpZGFkIGRlIGxhIGNvbXVuaWRhZCB5IGVuIHN1IGJpZW5lc3RhciBnZW5lcmFsLgoKRGUgYWN1ZXJkbyBjb24gbG9zIHByb21lZGlvcyBjYWxjdWxhZG9zLCBlbCBjbHVzdGVyIDIgcmVzdWx0w7MgY29tbyBlbCBtw6FzIGluc2VndXJvLCBkZXN0YWPDoW5kb3NlIHBvciBzdXMgYWxhcm1hbnRlcyB0YXNhcyBkZSB2aW9sYWNpb25lcywgdW4gZGVsaXRvIHF1ZSwgcG9yIHN1IG5hdHVyYWxlemEsIHRpZW5kZSBhIHRlbmVyIGVmZWN0b3MgZGV2YXN0YWRvcmVzIGVuIGxhcyB2w61jdGltYXMgeSBlbiBsYSBlc3RydWN0dXJhIHNvY2lhbCBkZSBsYXMgY29tdW5pZGFkZXMgYWZlY3RhZGFzLiBQb3Igb3RybyBsYWRvLCBlbCBjbHVzdGVyIDUgc2UgY2FyYWN0ZXJpesOzIHBvciBwcmVzZW50YXIgbG9zIG5pdmVsZXMgbcOhcyBiYWpvcyBkZSBhcnJlc3RvcyBlbiB0b2RhcyBsYXMgY2F0ZWdvcsOtYXMgZGUgY3JpbWVuIGV4YW1pbmFkYXMsIGxvIHF1ZSBub3MgbGxldmEgYSBjb25zaWRlcmFybG8gY29tbyBlbCBtw6FzIHNlZ3Vyby4gRXN0ZSBjb250cmFzdGUgZW50cmUgY2x1c3RlcnMgc3VicmF5YSBsYSBkaXZlcnNpZGFkIGRlIGNvbnRleHRvcyBkZSBzZWd1cmlkYWQgcXVlIHNlIHB1ZWRlbiBlbmNvbnRyYXIgYSBsbyBsYXJnbyBkZWwgcGHDrXMuCgpBZGVtw6FzLCBudWVzdHJvIGFuw6FsaXNpcyByZXZlbMOzIHVuYSBkaXZpc2nDs24gZ2VvZ3LDoWZpY2Egbm90YWJsZSBlbiB0w6lybWlub3MgZGUgc2VndXJpZGFkLCBjb24gbGEgcmVnacOzbiBub3J0ZSBtb3N0csOhbmRvc2Ugc2lnbmlmaWNhdGl2YW1lbnRlIG3DoXMgc2VndXJhIGVuIGNvbXBhcmFjacOzbiBjb24gbGEgcmVnacOzbiBzdXIuIEVzdGUgcGF0csOzbiBwb2Ryw61hIGVzdGFyIGluZmx1ZW5jaWFkbyBwb3IgdW5hIHNlcmllIGRlIGZhY3RvcmVzIHNvY2lvZWNvbsOzbWljb3MgeSBjdWx0dXJhbGVzLiBFbnRyZSBlbGxvcywgbGEgYWx0YSBtaWdyYWNpw7NuIHF1ZSBlbmZyZW50YW4gbG9zIGVzdGFkb3MgZGVsIHN1ciwgZWwgcGFzbyBkZWwgdHLDoWZpY28gZGUgYXJtYXMgeSBkcm9nYXMgcHJvdmVuaWVudGVzIGRlIGxhIGZyb250ZXJhIGNvbiBNw6l4aWNvLCBsYSBkZXNpZ3VhbGRhZCBoaXN0w7NyaWNhIGVuIGVsIHN1ciBkZWwgcGHDrXMsIGxhIGN1bHR1cmEgaGlzdMOzcmljYSB5IGN1bHR1cmFsIGRlbCBwYcOtcyBjb24gc2VncmVnYWNpb25lcyByYWNpYWxlcyB5IG3Dumx0aXBsZXMgcHJvYmxlbWFzIHNvY2lhbGVzIHkgbGFzIGxlZ2lzbGFjaW9uZXMgY29uIGFsdGFzIGxpYmVydGFkZXMgZW4gbGEgcG9ydGFjacOzbiB5IHVzbyBkZSBhcm1hcy4KCkxvcyBoYWxsYXpnb3MgYWN0dWFsZXMgb2ZyZWNlbiB1bmEgcGVyc3BlY3RpdmEgdmFsaW9zYSBkZSBsYSBzaXR1YWNpw7NuIGRlIHNlZ3VyaWRhZCBlbiBlbCBwYcOtcywgYXPDrSBtaXNtbyBhcHVudGFuIGhhY2lhIGxhIG5lY2VzaWRhZCBkZSBlc3RyYXRlZ2lhcyBkZSBpbnRlcnZlbmNpw7NuIGVuIG3Dumx0aXBsZXMgZmFjdG9yZXMgcXVlIGFib3JkZW4gbGFzIHJhw61jZXMgcHJvZnVuZGFzIGRlIGxhIGluc2VndXJpZGFkLCBlc2VuY2lhbG1lbnRlIGVuIGxhIHJlZ2nDs24gc3VyIGRlbCBwYcOtcyB5IHByb211ZXZhbiBjb24gZWxsbyBlbCBkZXNhcnJvbGxvIGRlIGNvbXVuaWRhZGVzIHNlZ3VyYXMgeSBwcsOzc3BlcmFzIGVuIHRvZGFzIGxhcyByZWdpb25lcy4K