Importar la base de datos y entenderla

data("USArrests")
summary(USArrests)
##      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.00

Herramienta: “Generador de Valor de Datos”

Paso 1. Definir el área de negocios que deseamos impactar o mejorar y su KPI.

Área de Seguridad en el Gobierno. Número de delitos por mes.

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.
  1. H: Los estados fronterizos son los que más delitos tienen y en los que más arrestos hay.
  2. Se debe limpiar la base de datos y hacer gráficas para comprender mejor la información arrojada.
Paso 4. Reunir los datos requeridos.

La información necesaria está completa.

Paso 5: Plan de ejecución.

En este caso, el gobierno de cada Estado, los cuales son California, Nevada, New York, Arizona y Colorado que son de los principales estados más poblados y algunos fronterizos, debería invertir en programas de seguridad para disminuir la delincuencia y los arrestos con el objetivo de mejorar la seguridad para su población.

Revisar presencia de datos anormales

boxplot(USArrests)

Anotaciones

Se determinó que hay datos anormales en Rape (Fuera del Limite Superior), pero No se eliminarán al ser muy cercanos a los demás datos

K-means Clustering

Paso 1. Normalizar variables

bd1 <- USArrests
bd1 <- as.data.frame(scale(USArrests))

Paso 2. k-means Clustering

segmentos <- kmeans(bd1, 4)
segmentos
## K-means clustering with 4 clusters of sizes 13, 13, 16, 8
## 
## Cluster means:
##       Murder    Assault   UrbanPop        Rape
## 1  0.6950701  1.0394414  0.7226370  1.27693964
## 2 -0.9615407 -1.1066010 -0.9301069 -0.96676331
## 3 -0.4894375 -0.3826001  0.5758298 -0.26165379
## 4  1.4118898  0.8743346 -0.8145211  0.01927104
## 
## Clustering vector:
##        Alabama         Alaska        Arizona       Arkansas     California 
##              4              1              1              4              1 
##       Colorado    Connecticut       Delaware        Florida        Georgia 
##              1              3              3              1              4 
##         Hawaii          Idaho       Illinois        Indiana           Iowa 
##              3              2              1              3              2 
##         Kansas       Kentucky      Louisiana          Maine       Maryland 
##              3              2              4              2              1 
##  Massachusetts       Michigan      Minnesota    Mississippi       Missouri 
##              3              1              2              4              1 
##        Montana       Nebraska         Nevada  New Hampshire     New Jersey 
##              2              2              1              2              3 
##     New Mexico       New York North Carolina   North Dakota           Ohio 
##              1              1              4              2              3 
##       Oklahoma         Oregon   Pennsylvania   Rhode Island South Carolina 
##              3              3              3              3              4 
##   South Dakota      Tennessee          Texas           Utah        Vermont 
##              2              4              1              3              2 
##       Virginia     Washington  West Virginia      Wisconsin        Wyoming 
##              3              3              2              2              3 
## 
## Within cluster sum of squares by cluster:
## [1] 19.922437 11.952463 16.212213  8.316061
##  (between_SS / total_SS =  71.2 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"
asignacion <- cbind(USArrests, cluster = segmentos$cluster)
head(asignacion,10)
##             Murder Assault UrbanPop Rape cluster
## Alabama       13.2     236       58 21.2       4
## Alaska        10.0     263       48 44.5       1
## Arizona        8.1     294       80 31.0       1
## Arkansas       8.8     190       50 19.5       4
## California     9.0     276       91 40.6       1
## Colorado       7.9     204       78 38.7       1
## Connecticut    3.3     110       77 11.1       3
## Delaware       5.9     238       72 15.8       3
## Florida       15.4     335       80 31.9       1
## Georgia       17.4     211       60 25.8       4

Exportar csv

write.csv(asignacion,"datos_con_cluster.csv")

Visualizar Segmentos

# 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(segmentos, data = bd1,
             palette=c("red", "blue", "black", "darkgreen"),
             ellipse.type = "euclid",
             star.plot = T,
             repel = T,
             ggtheme = theme())

Optimizar k

library(cluster)
# install.packages("data.table")
library(data.table)

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

Conclusiones

La función de clustering o bien, de segmentación, sirve para agrupar en este caso, los arrestos ocurridos en los diferentes estados de Estados Unidos de acuerdo a ciertas características que tienen en común. En este caso decidimos realizar 4 clusters, y encontramos que los estados más cercanos al eje son en los que que hay una mayor cantidad de crimenes, siendo estos principalmente California, Nevada, New York, Arizona y Colorado. En cambio, los que están mas lejos del eje, son los más seguros o los que menos cantidad de crimenes tienen, tales como West virginia, Vermont y North Dakota.

LS0tDQp0aXRsZTogPHNwYW4gc3R5bGU9IkNvbG9yOlJlZCIgPiJVU0EgQXJyZXN0cyINCmF1dGhvcjogIk1hcmlhbmEgVWxsb2EgLSBBMDEyNTMwNzYiDQpkYXRlOiAiMjAyMi0wOS0wNyINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiB0cnVlDQogICAgdG9jX2Zsb2F0OiB0cnVlDQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQ0KLS0tDQoNCjxpbWcgc3JjPSAiQzpcXFVzZXJzXFxtYXJpYVxcRG9jdW1lbnRzXFxJVEVTTSBMQUVUXFxTZW1lc3RyZSA3XFxNM1xcaW1hZ2VuZXNcXGFycmVzdHMucG5nIj4NCg0KIyMjIEltcG9ydGFyIGxhIGJhc2UgZGUgZGF0b3MgeSBlbnRlbmRlcmxhDQpgYGB7cn0NCmRhdGEoIlVTQXJyZXN0cyIpDQpzdW1tYXJ5KFVTQXJyZXN0cykNCmBgYA0KDQojIyMgSGVycmFtaWVudGE6ICJHZW5lcmFkb3IgZGUgVmFsb3IgZGUgRGF0b3MiDQoNCiMjIyMjICoqUGFzbyAxLioqIERlZmluaXIgZWwgw6FyZWEgZGUgbmVnb2Npb3MgcXVlIGRlc2VhbW9zIGltcGFjdGFyIG8gbWVqb3JhciB5IHN1IEtQSS4NCg0Kw4FyZWEgZGUgU2VndXJpZGFkIGVuIGVsIEdvYmllcm5vLiBOw7ptZXJvIGRlIGRlbGl0b3MgcG9yIG1lcy4NCg0KIyMjIyMgKipQYXNvIDIuKiogU2VsZWNjaW9uYXIgcGxhbnRpbGxhICgtcykgcGFyYSBjcmVhciB2YWxvciBhIHBhcnRpciBkZSBsb3MgZGF0b3MgZGUgbG9zIGNsaWVudGVzLg0KDQogIFZpc2nDs24gLyAqKlNlZ21lbnRhY2nDs24qKiAvIFBlcnNvbmFsaXphY2nDs24gLyBDb250ZXh0dWFsaXphY2nDs24NCiAgDQojIyMjIyAqKlBhc28gMy4qKiBHZW5lcmFyIGlkZWFzIG8gY29uY2VwdG9zIGVzcGVjw61maWNvcy4NCg0KMS4gSDogTG9zIGVzdGFkb3MgZnJvbnRlcml6b3Mgc29uIGxvcyBxdWUgbcOhcyBkZWxpdG9zIHRpZW5lbiB5IGVuIGxvcyBxdWUgbcOhcyBhcnJlc3RvcyBoYXkuDQoyLiBTZSBkZWJlIGxpbXBpYXIgbGEgYmFzZSBkZSBkYXRvcyB5IGhhY2VyIGdyw6FmaWNhcyBwYXJhIGNvbXByZW5kZXIgbWVqb3IgbGEgaW5mb3JtYWNpw7NuIGFycm9qYWRhLg0KDQojIyMjIyAqKlBhc28gNC4qKiBSZXVuaXIgbG9zIGRhdG9zIHJlcXVlcmlkb3MuDQpMYSBpbmZvcm1hY2nDs24gbmVjZXNhcmlhIGVzdMOhIGNvbXBsZXRhLg0KDQojIyMjICoqUGFzbyA1OioqIFBsYW4gZGUgZWplY3VjacOzbi4NCkVuIGVzdGUgY2FzbywgZWwgZ29iaWVybm8gZGUgY2FkYSBFc3RhZG8sIGxvcyBjdWFsZXMgc29uIENhbGlmb3JuaWEsIE5ldmFkYSwgTmV3IFlvcmssIEFyaXpvbmEgeSBDb2xvcmFkbyBxdWUgc29uIGRlIGxvcyBwcmluY2lwYWxlcyBlc3RhZG9zIG3DoXMgcG9ibGFkb3MgeSBhbGd1bm9zIGZyb250ZXJpem9zLCBkZWJlcsOtYSAqKmludmVydGlyIGVuIHByb2dyYW1hcyBkZSBzZWd1cmlkYWQgcGFyYSBkaXNtaW51aXIgbGEgZGVsaW5jdWVuY2lhIHkgbG9zIGFycmVzdG9zKiogY29uIGVsIG9iamV0aXZvIGRlIG1lam9yYXIgbGEgc2VndXJpZGFkIHBhcmEgc3UgcG9ibGFjacOzbi4NCg0KIyMjIFJldmlzYXIgcHJlc2VuY2lhIGRlIGRhdG9zIGFub3JtYWxlcw0KYGBge3J9DQpib3hwbG90KFVTQXJyZXN0cykNCmBgYA0KDQojIyMjIyBBbm90YWNpb25lcw0KICAqU2UgZGV0ZXJtaW7DsyBxdWUgaGF5IGRhdG9zIGFub3JtYWxlcyBlbiBSYXBlIChGdWVyYSBkZWwgTGltaXRlIFN1cGVyaW9yKSwgcGVybw0KICAqTm8gc2UgZWxpbWluYXLDoW4gYWwgc2VyIG11eSBjZXJjYW5vcyBhIGxvcyBkZW3DoXMgZGF0b3MNCg0KIyMgSy1tZWFucyBDbHVzdGVyaW5nDQoNCiMjIyBQYXNvIDEuIE5vcm1hbGl6YXIgdmFyaWFibGVzDQpgYGB7cn0NCmJkMSA8LSBVU0FycmVzdHMNCmJkMSA8LSBhcy5kYXRhLmZyYW1lKHNjYWxlKFVTQXJyZXN0cykpDQpgYGANCg0KIyMjIFBhc28gMi4gay1tZWFucyBDbHVzdGVyaW5nDQpgYGB7cn0NCnNlZ21lbnRvcyA8LSBrbWVhbnMoYmQxLCA0KQ0Kc2VnbWVudG9zDQoNCmFzaWduYWNpb24gPC0gY2JpbmQoVVNBcnJlc3RzLCBjbHVzdGVyID0gc2VnbWVudG9zJGNsdXN0ZXIpDQpoZWFkKGFzaWduYWNpb24sMTApDQpgYGANCg0KIyMjIEV4cG9ydGFyIGNzdg0KYGBge3J9DQp3cml0ZS5jc3YoYXNpZ25hY2lvbiwiZGF0b3NfY29uX2NsdXN0ZXIuY3N2IikNCmBgYA0KDQojIyMgVmlzdWFsaXphciBTZWdtZW50b3MNCmBgYHtyfQ0KIyBpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikNCmxpYnJhcnkoZmFjdG9leHRyYSkNCmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsIGRhdGEgPSBiZDEsDQogICAgICAgICAgICAgcGFsZXR0ZT1jKCJyZWQiLCAiYmx1ZSIsICJibGFjayIsICJkYXJrZ3JlZW4iKSwNCiAgICAgICAgICAgICBlbGxpcHNlLnR5cGUgPSAiZXVjbGlkIiwNCiAgICAgICAgICAgICBzdGFyLnBsb3QgPSBULA0KICAgICAgICAgICAgIHJlcGVsID0gVCwNCiAgICAgICAgICAgICBnZ3RoZW1lID0gdGhlbWUoKSkNCmBgYA0KDQojIyMgT3B0aW1pemFyIGsNCmBgYHtyfQ0KbGlicmFyeShjbHVzdGVyKQ0KIyBpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikNCmxpYnJhcnkoZGF0YS50YWJsZSkNCg0Kc2V0LnNlZWQoMTIzKQ0Kb3B0aW1pemFjaW9uIDwtIGNsdXNHYXAoYmQxLCBGVU4gPSBrbWVhbnMsIG5zdGFydCA9IDI1LCBLLm1heCA9IDEwLCBCID0gNTApDQpwbG90KG9wdGltaXphY2lvbiwgeGxhYiA9ICJOdW1lcm8gZGUgY2x1c3RlcnMgayIpDQpgYGANCg0KIyMjICoqQ29uY2x1c2lvbmVzKioNCkxhIGZ1bmNpw7NuIGRlIGNsdXN0ZXJpbmcgbyBiaWVuLCBkZSBzZWdtZW50YWNpw7NuLCBzaXJ2ZSBwYXJhIGFncnVwYXIgZW4gZXN0ZSBjYXNvLCBsb3MgYXJyZXN0b3Mgb2N1cnJpZG9zIGVuIGxvcyBkaWZlcmVudGVzIGVzdGFkb3MgZGUgRXN0YWRvcyBVbmlkb3MgZGUgYWN1ZXJkbyBhIGNpZXJ0YXMgY2FyYWN0ZXLDrXN0aWNhcyBxdWUgdGllbmVuIGVuIGNvbcO6bi4gRW4gZXN0ZSBjYXNvIGRlY2lkaW1vcyByZWFsaXphciA0IGNsdXN0ZXJzLCB5IGVuY29udHJhbW9zIHF1ZSAqKmxvcyBlc3RhZG9zIG3DoXMgY2VyY2Fub3MgYWwgZWplIHNvbiBlbiBsb3MgcXVlIHF1ZSBoYXkgdW5hIG1heW9yIGNhbnRpZGFkIGRlIGNyaW1lbmVzKiosIHNpZW5kbyBlc3RvcyBwcmluY2lwYWxtZW50ZSAqQ2FsaWZvcm5pYSwgTmV2YWRhLCBOZXcgWW9yaywgQXJpem9uYSB5IENvbG9yYWRvKi4gRW4gY2FtYmlvLCBsb3MgcXVlIGVzdMOhbiBtYXMgbGVqb3MgZGVsIGVqZSwgc29uIGxvcyBtw6FzIHNlZ3Vyb3MgbyBsb3MgcXVlIG1lbm9zIGNhbnRpZGFkIGRlIGNyaW1lbmVzIHRpZW5lbiwgdGFsZXMgY29tbyBXZXN0IHZpcmdpbmlhLCBWZXJtb250IHkgTm9ydGggRGFrb3RhLg0KDQo=