Herramienta “El Generador de Valor de Datos”

Paso 1. Definir el área del negocio que buscamos impactar o mejorar y su KPI
Se busca mejorar la seguridad de cada gobierno de estado. KPI: delitos por mes/año

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.
¿Qué estados tienen mayor número de delitos? ¿Qué tipo de delitos se cometen?

Paso 4. Reunir los datos requeridos.

Importar base de datos

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

Revisar presencia de datos anormales

boxplot(USArrests)

Se determino 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

#install.packages("cluster")
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")

Paso 5. Plan de ejecución. Observar los estados con más índice de delitos (como California) y planear estrategias para aumentar la seguridad como es la inversión a los cuerpos policiales y programas de seguridad.

Conclusion

Para poder tener una mejor vision de los segmentos que se tienen en un mercado la elaboración de clusters es la indicada, ya que se puede analizar visualmente los tipos de clientes que se tienen y así poder hacer un acercamiento adecuado a cada uno de los segmentos. En este caso se elaboraron clusters para observar que estados tiene similitud con sus arrestos.
Así pues, los estados con más delitos son California, Nevada, Nueva York, etc; ya que estan más cerca del eje 0 y los estados de la lista con menos delitos son Vermont, West Virginia, South Dakota, entre otros.

LS0tCnRpdGxlOiA8c3BhbiBzdHlsZT0iQ29sb3I6Qmx1ZSI+ICAiU2VnbWVudGFjaW9uX2RlX21lcmNhZG9zLVVTQXJyZXN0cyIKYXV0aG9yOiAiRGFuYSBQZXJleiAtIEEwMDIyNzA0MSIKZGF0ZTogIjkvOC8yMDIyIgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6IAogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKCi0tLQoKPGltZyBzcmM9Ii9Vc2Vycy9kYW5uYXBlcmV6L0Rlc2t0b3AvaW1hZ2VuZXMgcGFyYSBIVE1ML2FycmVzdC5wbmciPgoKIyBIZXJyYW1pZW50YSAiRWwgR2VuZXJhZG9yIGRlIFZhbG9yIGRlIERhdG9zIgoqUGFzbyAxLiBEZWZpbmlyIGVsIMOhcmVhIGRlbCBuZWdvY2lvIHF1ZSBidXNjYW1vcyBpbXBhY3RhciBvIG1lam9yYXIgeSBzdSBLUEkqICAKU2UgYnVzY2EgbWVqb3JhciBsYSBzZWd1cmlkYWQgZGUgY2FkYSBnb2JpZXJubyBkZSBlc3RhZG8uIEtQSTogZGVsaXRvcyBwb3IgbWVzL2HDsW8KCipQYXNvIDIuIFNlbGVjY2lvbmFyIHBsYW50aWxsYSgtcykgcGFyYSBjcmVhciB2YWxvciBhIHBhcnRpciBkZSBsb3MgZGF0b3MgZGUgbG9zIGNsaWVudGVzLiogICAgClZpc2nDs24gLyAqKlNlZ21lbnRhY2nDs24qKiAvIFBlcnNvbmFsaXphY2nDs24gLyBDb250ZXh0dWFsaXphY2nDs24gIAoKKlBhc28gMy4gR2VuZXJhciBpZGVhcyBvIGNvbmNlcHRvcyBlc3BlY8OtZmljb3MuKiAgIArCv1F1w6kgZXN0YWRvcyB0aWVuZW4gbWF5b3IgbsO6bWVybyBkZSBkZWxpdG9zPwrCv1F1w6kgdGlwbyBkZSBkZWxpdG9zIHNlIGNvbWV0ZW4/CgoqUGFzbyA0LiBSZXVuaXIgbG9zIGRhdG9zIHJlcXVlcmlkb3MuKiAgICAKCiMgSW1wb3J0YXIgYmFzZSBkZSBkYXRvcwpgYGB7cn0KZGF0YSgiVVNBcnJlc3RzIikKc3VtbWFyeShVU0FycmVzdHMpCgpgYGAKCiMgUmV2aXNhciBwcmVzZW5jaWEgZGUgZGF0b3MgYW5vcm1hbGVzCmBgYHtyfQpib3hwbG90KFVTQXJyZXN0cykKYGBgClNlIGRldGVybWlubyBxdWUgaGF5IGRhdG9zIGFub3JtYWxlcyBlbiBSYXBlIChGdWVyYSBkZWwgTGltaXRlIFN1cGVyaW9yKSwgcGVybyBubyBzZSBlbGltaW5hcsOhbiBhbCBzZXIgbXV5IGNlcmNhbm9zIGEgbG9zIGRlbcOhcyBkYXRvcy4gIAoKIyBrLW1lYW5zIENsdXN0ZXJpbmcKCiMjIFBhc28gMS4gTm9ybWFsaXphciB2YXJpYWJsZXMKYGBge3J9CmJkMSA8LSBVU0FycmVzdHMKYmQxIDwtIGFzLmRhdGEuZnJhbWUoc2NhbGUoVVNBcnJlc3RzKSkKYGBgCgojIyBQYXNvIDIuIGstbWVhbnMgQ2x1c3RlcmluZwpgYGB7cn0Kc2VnbWVudG9zIDwtIGttZWFucyhiZDEsIDQpCnNlZ21lbnRvcwoKYXNpZ25hY2lvbiA8LSBjYmluZChVU0FycmVzdHMsIGNsdXN0ZXIgPSBzZWdtZW50b3MkY2x1c3RlcikKaGVhZChhc2lnbmFjaW9uLDEwKQpgYGAKCiMgRXhwb3J0YXIgY3N2CmBgYHtyfQp3cml0ZS5jc3YoYXNpZ25hY2lvbiwiZGF0b3NfY29uX2NsdXN0ZXIuY3N2IikKYGBgCgojIFZpc3VhbGl6YXIgU2VnbWVudG9zCmBgYHtyfQojaW5zdGFsbC5wYWNrYWdlcygiZmFjdG9leHRyYSIpCmxpYnJhcnkoZmFjdG9leHRyYSkKZnZpel9jbHVzdGVyKHNlZ21lbnRvcywgZGF0YSA9IGJkMSwKICAgICAgICAgICAgIHBhbGV0dGU9YygicmVkIiwgImJsdWUiLCAiYmxhY2siLCAiZGFya2dyZWVuIiksCiAgICAgICAgICAgICBlbGxpcHNlLnR5cGUgPSAiZXVjbGlkIiwKICAgICAgICAgICAgIHN0YXIucGxvdCA9IFQsCiAgICAgICAgICAgICByZXBlbCA9IFQsCiAgICAgICAgICAgICBnZ3RoZW1lID0gdGhlbWUoKSkKYGBgCgojIE9wdGltaXphciBrCmBgYHtyfQojaW5zdGFsbC5wYWNrYWdlcygiY2x1c3RlciIpCmxpYnJhcnkoY2x1c3RlcikKI2luc3RhbGwucGFja2FnZXMoImRhdGEudGFibGUiKQpsaWJyYXJ5KGRhdGEudGFibGUpCgpzZXQuc2VlZCgxMjMpCm9wdGltaXphY2lvbiA8LSBjbHVzR2FwKGJkMSwgRlVOID0ga21lYW5zLCBuc3RhcnQgPSAyNSwgSy5tYXggPSAxMCwgQiA9IDUwKQpwbG90KG9wdGltaXphY2lvbiwgeGxhYiA9ICJOdW1lcm8gZGUgY2x1c3RlcnMgayIpCmBgYAoKKlBhc28gNS4gUGxhbiBkZSBlamVjdWNpw7NuLiogCk9ic2VydmFyIGxvcyBlc3RhZG9zIGNvbiBtw6FzIMOtbmRpY2UgZGUgZGVsaXRvcyAoY29tbyBDYWxpZm9ybmlhKSB5IHBsYW5lYXIgZXN0cmF0ZWdpYXMgcGFyYSBhdW1lbnRhciBsYSBzZWd1cmlkYWQgY29tbyBlcyBsYSBpbnZlcnNpw7NuIGEgbG9zIGN1ZXJwb3MgcG9saWNpYWxlcyB5IHByb2dyYW1hcyBkZSBzZWd1cmlkYWQuCgojIENvbmNsdXNpb24KUGFyYSBwb2RlciB0ZW5lciB1bmEgbWVqb3IgdmlzaW9uIGRlIGxvcyBzZWdtZW50b3MgcXVlIHNlIHRpZW5lbiBlbiB1biBtZXJjYWRvIGxhIGVsYWJvcmFjacOzbiBkZSBjbHVzdGVycyBlcyBsYSBpbmRpY2FkYSwgeWEgcXVlIHNlIHB1ZWRlIGFuYWxpemFyIHZpc3VhbG1lbnRlIGxvcyB0aXBvcyBkZSBjbGllbnRlcyBxdWUgc2UgdGllbmVuIHkgYXPDrSBwb2RlciBoYWNlciB1biBhY2VyY2FtaWVudG8gYWRlY3VhZG8gYSBjYWRhIHVubyBkZSBsb3Mgc2VnbWVudG9zLiBFbiBlc3RlIGNhc28gc2UgZWxhYm9yYXJvbiBjbHVzdGVycyBwYXJhIG9ic2VydmFyIHF1ZSBlc3RhZG9zIHRpZW5lIHNpbWlsaXR1ZCBjb24gc3VzIGFycmVzdG9zLiAgCkFzw60gcHVlcywgbG9zIGVzdGFkb3MgY29uIG3DoXMgZGVsaXRvcyBzb24gQ2FsaWZvcm5pYSwgTmV2YWRhLCBOdWV2YSBZb3JrLCBldGM7IHlhIHF1ZSBlc3RhbiBtw6FzIGNlcmNhIGRlbCBlamUgMCB5IGxvcyBlc3RhZG9zIGRlIGxhIGxpc3RhIGNvbiBtZW5vcyBkZWxpdG9zIHNvbiBWZXJtb250LCBXZXN0IFZpcmdpbmlhLCBTb3V0aCBEYWtvdGEsIGVudHJlIG90cm9zLiA=