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

  1. Identificar los estados con mayor inseguridad y arrestos
  2. Realizar una investigación externa para analizar más variables que puedan ocasionar la incidencia del crimen
  3. 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