K-means Clustering: USA
Arrests
Importar bases de datos
#file.choose()
bd <- read.csv("/Users/ErickaMtz/Downloads/USArrests (1).csv")
summary(bd)
## X Murder Assault UrbanPop
## Length:50 Min. : 0.800 Min. : 45.0 Min. :32.00
## Class :character 1st Qu.: 4.075 1st Qu.:109.0 1st Qu.:54.50
## Mode :character Median : 7.250 Median :159.0 Median :66.00
## Mean : 7.788 Mean :170.8 Mean :65.54
## 3rd Qu.:11.250 3rd Qu.:249.0 3rd Qu.:77.75
## Max. :17.400 Max. :337.0 Max. :91.00
## Rape
## Min. : 7.30
## 1st Qu.:15.07
## Median :20.10
## Mean :21.23
## 3rd Qu.:26.18
## Max. :46.00
Herramienta “El Generador de Valor de
Datos”
Paso 1. Definir el área del negocio que buscamos
impactar o mejorar su KPI.
El departamento de seguridad será el impactado y el
KPI a medir será el nivel o índice de inseguridad de un
estado
Paso 2. Seleccionar plantilla (-s) para crear valor a
partir de los datos de los clientes
Visión / Segmentación / Personalización /
Contextualización
Paso 3. Generar ideas o conceptos específicos
Elaborar un modelo de clusters que permita identificar los estados con
mayor índice de crímenes.
Paso 4. Reunir los datos requeridos
Elaborar distintos clusters en los que se pueda identificar el estado
con su índice de inseguridad.
Paso 5. Plan de ejecución.
A través de los resultados obtenidos se harán estrategias para
implementar mayor seguridad en los estados que se crea conveniente.
Agregar X como nombre de los renglones
bd1 <- bd
rownames(bd1) <- bd1$X
Eliminar la columna X
bd2 <- bd1
bd2 <- subset(bd2, select = -c (X))
boxplot(bd2)

boxplot(bd2$Rape)

Observaciones
Se determinó que hay datos anormales en Rape (Fuera del límite
superior), pero no se eliminarán al ser muy cercanos a los datos
Normalizar variables
bd3 <- bd2
bd3 <- as.data.frame(scale(bd3))
K-means Clustering
clusters<-kmeans(bd3,4)
asignacion<-cbind(bd3,Cluster=clusters$cluster)
head(asignacion,10)
## Murder Assault UrbanPop Rape Cluster
## Alabama 1.24256408 0.7828393 -0.5209066 -0.003416473 1
## Alaska 0.50786248 1.1068225 -1.2117642 2.484202941 2
## Arizona 0.07163341 1.4788032 0.9989801 1.042878388 2
## Arkansas 0.23234938 0.2308680 -1.0735927 -0.184916602 1
## California 0.27826823 1.2628144 1.7589234 2.067820292 2
## Colorado 0.02571456 0.3988593 0.8608085 1.864967207 2
## Connecticut -1.03041900 -0.7290821 0.7917228 -1.081740768 4
## Delaware -0.43347395 0.8068381 0.4462940 -0.579946294 4
## Florida 1.74767144 1.9707777 0.9989801 1.138966691 2
## Georgia 2.20685994 0.4828549 -0.3827351 0.487701523 1
Exportar csv
# write_csv(asignacion2, "datos_con_cluster.csv")
#install.packages("factoextra")
library(factoextra)
## Loading required package: ggplot2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
fviz_cluster(clusters, data=bd3,
palette=c("red","blue","black","darkgreen"),
ellipse.type="euclid",
star.plot=T,
repel=T,
ggtheme=theme())

Optimizar k
library("cluster")
set.seed(123)
optimizacion <- clusGap(bd3, FUN = kmeans, nstart = 25, K.max = 10, B = 50)
plot(optimizacion, xlab = "Numero de clusters k")

Conclusiones
En el caso de este ejercicio, los clusters nos sirven para
identificar los estados que tienen mayores incidencias en asesinatos,
violaciones, entre otros. Además de poder agrupas aquellos estados que
tienen índices de criminalidad parecidos y poblaciones parecidas. Al ver
los estados con mayores índices, se puede generar un plan de acción para
disminuir los índices de inseguridad al implementar mayor seguridad por
las noches y supervisión constante por parte de las autoridades en las
calles.
LS0tCnRpdGxlOiAiVVNBIEFycmVzdHMiCmF1dGhvcjogIkVyaWNrYSBNYXJ0aW5leiAtIEEwMTE3NzAxNyIKZGF0ZTogIjIwMjItMDktMDciCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCi0tLQojIyA8aW1nIHNyYz0gIi9Vc2Vycy9Fcmlja2FNdHovRGVza3RvcC93cDI4NjQyMTYud2VicCI+CgojIyA8c3BhbiBzdHlsZT0iY29sb3I6ICMzNjY0OEIiID4gKipLLW1lYW5zIENsdXN0ZXJpbmc6IFVTQSBBcnJlc3RzKiogPC9zcGFuPgoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogIzVDQUNFRSIgPiBJbXBvcnRhciBiYXNlcyBkZSBkYXRvcyA8L3NwYW4+CmBgYHtyfQojZmlsZS5jaG9vc2UoKQpiZCA8LSByZWFkLmNzdigiL1VzZXJzL0VyaWNrYU10ei9Eb3dubG9hZHMvVVNBcnJlc3RzICgxKS5jc3YiKQpzdW1tYXJ5KGJkKQpgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6ICM1Q0FDRUUiID4gSGVycmFtaWVudGEgIkVsIEdlbmVyYWRvciBkZSBWYWxvciBkZSBEYXRvcyIgIDwvc3Bhbj4KCioqUGFzbyAxLioqIERlZmluaXIgZWwgw6FyZWEgZGVsIG5lZ29jaW8gcXVlIGJ1c2NhbW9zIGltcGFjdGFyIG8gbWVqb3JhciBzdSBLUEkuICAgIApFbCAqKmRlcGFydGFtZW50byBkZSBzZWd1cmlkYWQgKiogc2Vyw6EgZWwgaW1wYWN0YWRvIHkgZWwgKktQSSogYSBtZWRpciBzZXLDoSBlbCBuaXZlbCBvIMOtbmRpY2UgZGUgaW5zZWd1cmlkYWQgZGUgdW4gZXN0YWRvICAgIAoqKlBhc28gMi4qKiBTZWxlY2Npb25hciBwbGFudGlsbGEgKC1zKSBwYXJhIGNyZWFyIHZhbG9yIGEgcGFydGlyIGRlIGxvcyBkYXRvcyBkZSBsb3MgY2xpZW50ZXMgICAgIApWaXNpw7NuIC8gKipTZWdtZW50YWNpw7NuKiogLyBQZXJzb25hbGl6YWNpw7NuIC8gQ29udGV4dHVhbGl6YWNpw7NuICAgICAgCioqUGFzbyAzLioqIEdlbmVyYXIgaWRlYXMgbyBjb25jZXB0b3MgZXNwZWPDrWZpY29zICAgICAgCkVsYWJvcmFyIHVuIG1vZGVsbyBkZSBjbHVzdGVycyBxdWUgcGVybWl0YSBpZGVudGlmaWNhciBsb3MgZXN0YWRvcyBjb24gbWF5b3Igw61uZGljZSBkZSBjcsOtbWVuZXMuICAKKipQYXNvIDQuKiogIFJldW5pciBsb3MgZGF0b3MgcmVxdWVyaWRvcyAgIApFbGFib3JhciBkaXN0aW50b3MgIGNsdXN0ZXJzIGVuIGxvcyBxdWUgc2UgcHVlZGEgaWRlbnRpZmljYXIgZWwgZXN0YWRvIGNvbiBzdSDDrW5kaWNlIGRlIGluc2VndXJpZGFkLiAgCioqUGFzbyA1LioqIFBsYW4gZGUgZWplY3VjacOzbi4gIApBIHRyYXbDqXMgZGUgbG9zIHJlc3VsdGFkb3Mgb2J0ZW5pZG9zIHNlIGhhcsOhbiBlc3RyYXRlZ2lhcyBwYXJhIGltcGxlbWVudGFyIG1heW9yIHNlZ3VyaWRhZCBlbiBsb3MgZXN0YWRvcyBxdWUgc2UgY3JlYSBjb252ZW5pZW50ZS4gIAoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogIzVDQUNFRSIgPiBBZ3JlZ2FyIFggY29tbyBub21icmUgZGUgbG9zIHJlbmdsb25lcyA8L3NwYW4+CmBgYHtyfQpiZDEgPC0gYmQKcm93bmFtZXMoYmQxKSA8LSBiZDEkWApgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6ICM1Q0FDRUUiID4gRWxpbWluYXIgbGEgY29sdW1uYSBYIDwvc3Bhbj4KYGBge3J9CmJkMiA8LSBiZDEKYmQyIDwtIHN1YnNldChiZDIsIHNlbGVjdCA9IC1jIChYKSkKCmJveHBsb3QoYmQyKQpib3hwbG90KGJkMiRSYXBlKQpgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6ICM1Q0FDRUUiID4gT2JzZXJ2YWNpb25lcyA8L3NwYW4+ClNlIGRldGVybWluw7MgcXVlIGhheSBkYXRvcyBhbm9ybWFsZXMgZW4gUmFwZSAoRnVlcmEgZGVsIGzDrW1pdGUgc3VwZXJpb3IpLCBwZXJvIG5vIHNlIGVsaW1pbmFyw6FuIGFsIHNlciBtdXkgY2VyY2Fub3MgYSBsb3MgZGF0b3MKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6ICM1Q0FDRUUiID4gTm9ybWFsaXphciB2YXJpYWJsZXMgPC9zcGFuPgpgYGB7cn0KYmQzIDwtIGJkMgpiZDMgPC0gYXMuZGF0YS5mcmFtZShzY2FsZShiZDMpKQpgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6ICM1Q0FDRUUiID4gSy1tZWFucyBDbHVzdGVyaW5nIDwvc3Bhbj4KYGBge3J9CmNsdXN0ZXJzPC1rbWVhbnMoYmQzLDQpCgphc2lnbmFjaW9uPC1jYmluZChiZDMsQ2x1c3Rlcj1jbHVzdGVycyRjbHVzdGVyKQpoZWFkKGFzaWduYWNpb24sMTApCmBgYAoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogIzVDQUNFRSIgPiBFeHBvcnRhciBjc3YgPC9zcGFuPgpgYGB7cn0KIyB3cml0ZV9jc3YoYXNpZ25hY2lvbjIsICJkYXRvc19jb25fY2x1c3Rlci5jc3YiKQoKI2luc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKQpsaWJyYXJ5KGZhY3RvZXh0cmEpCmZ2aXpfY2x1c3RlcihjbHVzdGVycywgZGF0YT1iZDMsCiAgICAgICAgICAgICBwYWxldHRlPWMoInJlZCIsImJsdWUiLCJibGFjayIsImRhcmtncmVlbiIpLAogICAgICAgICAgICAgZWxsaXBzZS50eXBlPSJldWNsaWQiLAogICAgICAgICAgICAgc3Rhci5wbG90PVQsCiAgICAgICAgICAgICByZXBlbD1ULAogICAgICAgICAgICAgZ2d0aGVtZT10aGVtZSgpKQpgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6ICM1Q0FDRUUiID4gT3B0aW1pemFyIGsgPC9zcGFuPgpgYGB7cn0KbGlicmFyeSgiY2x1c3RlciIpCnNldC5zZWVkKDEyMykKb3B0aW1pemFjaW9uIDwtIGNsdXNHYXAoYmQzLCBGVU4gPSBrbWVhbnMsIG5zdGFydCA9IDI1LCBLLm1heCA9IDEwLCBCID0gNTApCnBsb3Qob3B0aW1pemFjaW9uLCB4bGFiID0gIk51bWVybyBkZSBjbHVzdGVycyBrIikKYGBgCgojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiAjNUNBQ0VFIiA+IENvbmNsdXNpb25lcyA8L3NwYW4+IAo8cCBzdHlsZT0ndGV4dC1hbGlnbjpqdXN0aWZ5Oyc+ICoqRW4gZWwgY2FzbyBkZSBlc3RlIGVqZXJjaWNpbywgbG9zIGNsdXN0ZXJzIG5vcyBzaXJ2ZW4gcGFyYSBpZGVudGlmaWNhciBsb3MgZXN0YWRvcyBxdWUgdGllbmVuIG1heW9yZXMgaW5jaWRlbmNpYXMgZW4gYXNlc2luYXRvcywgdmlvbGFjaW9uZXMsIGVudHJlIG90cm9zLiBBZGVtw6FzIGRlIHBvZGVyIGFncnVwYXMgYXF1ZWxsb3MgZXN0YWRvcyBxdWUgdGllbmVuIMOtbmRpY2VzIGRlIGNyaW1pbmFsaWRhZCBwYXJlY2lkb3MgeSBwb2JsYWNpb25lcyBwYXJlY2lkYXMuIEFsIHZlciBsb3MgZXN0YWRvcyBjb24gbWF5b3JlcyDDrW5kaWNlcywgc2UgcHVlZGUgZ2VuZXJhciB1biBwbGFuIGRlIGFjY2nDs24gcGFyYSBkaXNtaW51aXIgbG9zIMOtbmRpY2VzIGRlIGluc2VndXJpZGFkIGFsIGltcGxlbWVudGFyIG1heW9yIHNlZ3VyaWRhZCBwb3IgbGFzIG5vY2hlcyB5IHN1cGVydmlzacOzbiBjb25zdGFudGUgcG9yIHBhcnRlIGRlIGxhcyBhdXRvcmlkYWRlcyBlbiBsYXMgY2FsbGVzLioqICA8L3A+Cg==