
Importar base de datos
#file.choose()
base_de_datos <- read.csv("/Users/isaacdiazruizdechavez/Downloads/USArrests.csv")
Entender base de datos
summary(base_de_datos)
## 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
bd1 <- base_de_datos
rownames(bd1) <- bd1$X
bd2<-bd1
bd2 <- subset(bd2, select= -c (X))
Herramienta “El generador de
valor de datos”
Paso 1. Definir el área del negocio que buscamos impactar o mejorar
y su KPI
El departamento de USA Arrests y la variable analizada como KPI será
arrestos.
Paso 2. Seleccionar plantilla (-s) para crear valor a partir de los
datos de los clientes
Vision | Segmentación | Personalización |
Contextualización
Paso 3. Generar ideas o conceptos específicos
Elaborar visualmente la herramienta de klusters para saber donde hay
más y menos inseguridad.
Paso 4. Reunir los datos requeridos
Elaborar una base de datos con los arrestos en USA.
Paso 5. Plan de ejecucion
- Identificar los estados con mayor inseguridad y arrestos
- Realizar una investigación externa para analizar más variables que
puedan ocasionar la incidencia del crimen
- Generar estrategias para aumentar la seguridad y disminuir o
arreglar los factores que obliguen la incidencia del crimen.
Revisar presencia de datos
anormales
boxplot(bd2)

En la gráfica anterior podemos observar que el crimen con mayor
incidencia es el asalto con un sesgo positivo ya que la mediana de dicho
boxplot se encuentra por debajo con una rango mucho mayor que los otros
crímenes. En rape podemos observar un dato anormal por fuera del
rango.
El crímen con la mayor desviación estándar es el asalto.
Paso 1. Normalizar variables
bd3 <- bd2
bd3 <- as.data.frame(scale(bd2))
k-means Clustering
clusters <- kmeans(bd3, 4)
asignacion <- cbind(base_de_datos, cluster=clusters$cluster)
head(asignacion,10)
## X Murder Assault UrbanPop Rape cluster
## Alabama Alabama 13.2 236 58 21.2 4
## Alaska Alaska 10.0 263 48 44.5 2
## Arizona Arizona 8.1 294 80 31.0 2
## Arkansas Arkansas 8.8 190 50 19.5 4
## California California 9.0 276 91 40.6 2
## Colorado Colorado 7.9 204 78 38.7 2
## Connecticut Connecticut 3.3 110 77 11.1 1
## Delaware Delaware 5.9 238 72 15.8 1
## Florida Florida 15.4 335 80 31.9 2
## Georgia Georgia 17.4 211 60 25.8 4
Exportar CSV
write.csv(asignacion,"datos_con_cluster.csv")
#install.packages("factoextra")
library(ggplot2)
library(factoextra)
## 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())

Conclusiones
Con el gráfico de los clústers, pudimos definir que se dividiera la
información en 4 clusters y vemos que California es el lugar más
inseguro, mientras que Missisipi es el más seguro. Podemos identificar
los patrones de comportamiento gracias a la segmentación generada con
los clusters.
library(cluster)
library(data.table)
set.seed(123)
optimizacion <- clusGap(bd3, FUN = kmeans, nstart = 25, K.max = 10, B = 50)
plot(optimizacion, xlab = "Numero de clusters k")

Nota
Como ejercicio extra, se realizó la gráfica de clusGap para confirmar
y buscar “optmizar” la cantidad de clusters realizados. Dicha gráfica
nos confirmó que 4 clusters era el número ideal para el ejercicio
realizado. En otro escenario, si hubieramos realizado 3 clusters
únicamente, dicha gráfica nos permitiría ver que 4 sería la cantidad
esperada y volver a realizar el ejercicio.
LS0tCnRpdGxlOiA8c3BhbiBzdHlsZT0iY29sb3I6T3JhbmdlIj4gVVNBIEFycmVzdHMgPC9zcGFuPgphdXRob3I6ICJJc2FhYyBEw61heiBBMDE1NDA1NDMiCmRhdGU6ICIyMDIyLTA5LTIyIgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IHRydWUKICAgIHRvY19mbG9hdDogdHJ1ZQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQotLS0KPGltZyBzcmM9ICIvVXNlcnMvaXNhYWNkaWF6cnVpemRlY2hhdmV6L0Rvd25sb2Fkcy9Ib3VzdG9uIFBEIEJhZGdlIE1TIFRULmpwZyI+CgojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmxpZ2h0c3RlZWxibHVlIj4gSW1wb3J0YXIgYmFzZSBkZSBkYXRvcyA8L3NwYW4+CgpgYGB7cn0KI2ZpbGUuY2hvb3NlKCkKCmJhc2VfZGVfZGF0b3MgPC0gcmVhZC5jc3YoIi9Vc2Vycy9pc2FhY2RpYXpydWl6ZGVjaGF2ZXovRG93bmxvYWRzL1VTQXJyZXN0cy5jc3YiKQoKYGBgCgojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmxpZ2h0c3RlZWxibHVlIj4gRW50ZW5kZXIgYmFzZSBkZSBkYXRvcyA8L3NwYW4+CmBgYHtyfQpzdW1tYXJ5KGJhc2VfZGVfZGF0b3MpCgpiZDEgPC0gYmFzZV9kZV9kYXRvcwpyb3duYW1lcyhiZDEpIDwtIGJkMSRYCgpiZDI8LWJkMQpiZDIgPC0gc3Vic2V0KGJkMiwgc2VsZWN0PSAtYyAoWCkpCgpgYGAKIyMjIDxzcGFuIHN0eWxlPSAiQ29sb3I6bGlnaHRzdGVlbGJsdWUiID5IZXJyYW1pZW50YSAiRWwgZ2VuZXJhZG9yIGRlIHZhbG9yIGRlIGRhdG9zIiA8L3NwYW4+CgojIyMjIFBhc28gMS4gRGVmaW5pciBlbCDDoXJlYSBkZWwgbmVnb2NpbyBxdWUgYnVzY2Ftb3MgaW1wYWN0YXIgbyBtZWpvcmFyIHkgc3UgS1BJCkVsIGRlcGFydGFtZW50byBkZSBVU0EgQXJyZXN0cyB5IGxhIHZhcmlhYmxlIGFuYWxpemFkYSBjb21vIEtQSSBzZXLDoSBhcnJlc3Rvcy4KCiMjIyMgUGFzbyAyLiBTZWxlY2Npb25hciBwbGFudGlsbGEgKC1zKSBwYXJhIGNyZWFyIHZhbG9yIGEgcGFydGlyIGRlIGxvcyBkYXRvcyBkZSBsb3MgY2xpZW50ZXMKVmlzaW9uIHwgKipTZWdtZW50YWNpw7NuKiogfCBQZXJzb25hbGl6YWNpw7NuIHwgQ29udGV4dHVhbGl6YWNpw7NuCgojIyMjIFBhc28gMy4gR2VuZXJhciBpZGVhcyBvIGNvbmNlcHRvcyBlc3BlY8OtZmljb3MKCkVsYWJvcmFyIHZpc3VhbG1lbnRlIGxhIGhlcnJhbWllbnRhIGRlIGtsdXN0ZXJzIHBhcmEgc2FiZXIgZG9uZGUgaGF5IG3DoXMgeSBtZW5vcyBpbnNlZ3VyaWRhZC4KCiMjIyMgUGFzbyA0LiBSZXVuaXIgbG9zIGRhdG9zIHJlcXVlcmlkb3MKCkVsYWJvcmFyIHVuYSBiYXNlIGRlIGRhdG9zIGNvbiBsb3MgYXJyZXN0b3MgZW4gVVNBLgoKIyMjIyBQYXNvIDUuIFBsYW4gZGUgZWplY3VjaW9uCgoxLiBJZGVudGlmaWNhciBsb3MgZXN0YWRvcyBjb24gbWF5b3IgaW5zZWd1cmlkYWQgeSBhcnJlc3RvcwoyLiBSZWFsaXphciB1bmEgaW52ZXN0aWdhY2nDs24gZXh0ZXJuYSBwYXJhIGFuYWxpemFyIG3DoXMgdmFyaWFibGVzIHF1ZSBwdWVkYW4gb2Nhc2lvbmFyIGxhIGluY2lkZW5jaWEgZGVsIGNyaW1lbgozLiBHZW5lcmFyIGVzdHJhdGVnaWFzIHBhcmEgYXVtZW50YXIgbGEgc2VndXJpZGFkIHkgZGlzbWludWlyIG8gYXJyZWdsYXIgbG9zIGZhY3RvcmVzIHF1ZSBvYmxpZ3VlbiBsYSBpbmNpZGVuY2lhIGRlbCBjcmltZW4uCgojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmxpZ2h0c3RlZWxibHVlIj4gUmV2aXNhciBwcmVzZW5jaWEgZGUgZGF0b3MgYW5vcm1hbGVzIDwvc3Bhbj4KYGBge3J9CmJveHBsb3QoYmQyKQpgYGAKCkVuIGxhIGdyw6FmaWNhIGFudGVyaW9yIHBvZGVtb3Mgb2JzZXJ2YXIgcXVlIGVsIGNyaW1lbiBjb24gbWF5b3IgaW5jaWRlbmNpYSBlcyBlbCBhc2FsdG8gY29uIHVuIHNlc2dvIHBvc2l0aXZvIHlhIHF1ZSBsYSBtZWRpYW5hIGRlIGRpY2hvIGJveHBsb3Qgc2UgZW5jdWVudHJhIHBvciBkZWJham8gY29uIHVuYSByYW5nbyBtdWNobyBtYXlvciBxdWUgbG9zIG90cm9zIGNyw61tZW5lcy4gRW4gcmFwZSBwb2RlbW9zIG9ic2VydmFyIHVuIGRhdG8gYW5vcm1hbCBwb3IgZnVlcmEgZGVsIHJhbmdvLiAKCkVsIGNyw61tZW4gY29uIGxhIG1heW9yIGRlc3ZpYWNpw7NuIGVzdMOhbmRhciBlcyBlbCBhc2FsdG8uIAoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpsaWdodHN0ZWVsYmx1ZSI+IFBhc28gMS4gTm9ybWFsaXphciB2YXJpYWJsZXMgPC9zcGFuPgpgYGB7cn0KYmQzIDwtIGJkMgpiZDMgPC0gYXMuZGF0YS5mcmFtZShzY2FsZShiZDIpKQpgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6bGlnaHRzdGVlbGJsdWUiPiBrLW1lYW5zIENsdXN0ZXJpbmcgPC9zcGFuPgpgYGB7cn0KY2x1c3RlcnMgPC0ga21lYW5zKGJkMywgNCkKCmFzaWduYWNpb24gPC0gY2JpbmQoYmFzZV9kZV9kYXRvcywgY2x1c3Rlcj1jbHVzdGVycyRjbHVzdGVyKQpoZWFkKGFzaWduYWNpb24sMTApCmBgYAoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpsaWdodHN0ZWVsYmx1ZSI+IEV4cG9ydGFyIENTViA8L3NwYW4+CmBgYHtyfQp3cml0ZS5jc3YoYXNpZ25hY2lvbiwiZGF0b3NfY29uX2NsdXN0ZXIuY3N2IikKCiNpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikKbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KGZhY3RvZXh0cmEpCgpmdml6X2NsdXN0ZXIoY2x1c3RlcnMsIGRhdGEgPSBiZDMsCiAgICAgICAgICAgICBwYWxldHRlPWMoInJlZCIsICJibHVlIiwgImJsYWNrIiwgImRhcmtncmVlbiIpLAogICAgICAgICAgICAgZWxsaXBzZS50eXBlID0gImV1Y2xpZCIsCiAgICAgICAgICAgICBzdGFyLnBsb3QgPSBULAogICAgICAgICAgICAgcmVwZWwgPSBULAogICAgICAgICAgICAgZ2d0aGVtZSA9IHRoZW1lKCkpCmBgYAoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpsaWdodHN0ZWVsYmx1ZSI+IENvbmNsdXNpb25lcyA8L3NwYW4+ICAKCkNvbiBlbCBncsOhZmljbyBkZSBsb3MgY2zDunN0ZXJzLCBwdWRpbW9zIGRlZmluaXIgcXVlIHNlIGRpdmlkaWVyYSBsYSBpbmZvcm1hY2nDs24gZW4gNCBjbHVzdGVycyB5IHZlbW9zIHF1ZSBDYWxpZm9ybmlhIGVzIGVsIGx1Z2FyIG3DoXMgaW5zZWd1cm8sIG1pZW50cmFzIHF1ZSBNaXNzaXNpcGkgZXMgZWwgbcOhcyBzZWd1cm8uIFBvZGVtb3MgaWRlbnRpZmljYXIgbG9zIHBhdHJvbmVzIGRlIGNvbXBvcnRhbWllbnRvIGdyYWNpYXMgYSBsYSBzZWdtZW50YWNpw7NuIGdlbmVyYWRhIGNvbiBsb3MgY2x1c3RlcnMuIAoKYGBge3J9CmxpYnJhcnkoY2x1c3RlcikKbGlicmFyeShkYXRhLnRhYmxlKQoKc2V0LnNlZWQoMTIzKQpvcHRpbWl6YWNpb24gPC0gY2x1c0dhcChiZDMsIEZVTiA9IGttZWFucywgbnN0YXJ0ID0gMjUsIEsubWF4ID0gMTAsIEIgPSA1MCkKcGxvdChvcHRpbWl6YWNpb24sIHhsYWIgPSAiTnVtZXJvIGRlIGNsdXN0ZXJzIGsiKQpgYGAKCiMjIyBOb3RhICAKCkNvbW8gZWplcmNpY2lvIGV4dHJhLCBzZSByZWFsaXrDsyBsYSBncsOhZmljYSBkZSBjbHVzR2FwIHBhcmEgY29uZmlybWFyIHkgYnVzY2FyICJvcHRtaXphciIgbGEgY2FudGlkYWQgZGUgY2x1c3RlcnMgcmVhbGl6YWRvcy4gRGljaGEgZ3LDoWZpY2Egbm9zIGNvbmZpcm3DsyBxdWUgNCBjbHVzdGVycyBlcmEgZWwgbsO6bWVybyBpZGVhbCBwYXJhIGVsIGVqZXJjaWNpbyByZWFsaXphZG8uIEVuIG90cm8gZXNjZW5hcmlvLCBzaSBodWJpZXJhbW9zIHJlYWxpemFkbyAzIGNsdXN0ZXJzIMO6bmljYW1lbnRlLCBkaWNoYSBncsOhZmljYSBub3MgcGVybWl0aXLDrWEgdmVyIHF1ZSA0IHNlcsOtYSBsYSBjYW50aWRhZCBlc3BlcmFkYSB5IHZvbHZlciBhIHJlYWxpemFyIGVsIGVqZXJjaWNpby4gCgoK