K-means Clustering - USArrest

Exportar Base de Datos
#file.choose()
bd<- read.csv ("/Users/ricardogc/Desktop/R - Analisis de datos para la toma de decisiones. /USArrests.csv")
data("USArrest")
## Warning in data("USArrest"): data set 'USArrest' not found
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”El Generador de valor de Datos”
Paso 1. Definir el area del negocio que buscamos impactar o mejorar
(Departamento) y el KPI.
El departamento de Arrestos en la Policia y el KPI a utilizar sería
la Tasa de Crimenes.
Paso 2. Seleccionar la plantilla para crear valor a partir de los
datos de los clientes.
Visión | Segmentación | Personalización |
Contextualización
Paso 3. Generar ideas y conceptos especificos.
Elaborar Clusters que nos ayuden a visualizar y analizar de manera
correcta la información y brindar una decisión para el area policial y
poder tomar acción en zonas con mayores arrestos.
Paso 4. Reunir los datos requeridos
Creación de una base de datos limpia y con la información más
relevante e importante para la toma de decisión, por medio de los
clusters.
Paso 5 Plan de ejecución.
Se evaluaran las areas con más crimenes y por medio de estas fases
se realizará el analisis adecuado:
Fase 1. Regulaciones estrictas y con una mayor
observación
Fase 2. Estrategías de implementación para el mejoramiento
de los arrestos en cada area
Fase 3. Notificación a las autoridades de las zonas con más
riesgo e implementar mayor observación en esas zonas.
Agregar la Columna X
bd1 <- bd
rownames (bd1) <- bd1$X
Eliminar Columna de X
bd2 <- bd1
bd2 <- subset(bd2, select = -c(X))
K-means Clustering
Revisar presencia de datos anormales
Se determino que hay datos anormales en Rape, fuera del limite
superior, pero no se eliminarán al ser muy cercanos a los demas
datos.
boxplot(USArrests)

Paso 1. Normalizar Variables
bd3 <- bd2
bd3 <- as.data.frame(scale(bd3))
Paso 2. k-means Clustering
km.res <- kmeans(bd3, 4)
km.res
## K-means clustering with 4 clusters of sizes 13, 13, 8, 16
##
## 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 1.4118898 0.8743346 -0.8145211 0.01927104
## 4 -0.4894375 -0.3826001 0.5758298 -0.26165379
##
## Clustering vector:
## Alabama Alaska Arizona Arkansas California
## 3 1 1 3 1
## Colorado Connecticut Delaware Florida Georgia
## 1 4 4 1 3
## Hawaii Idaho Illinois Indiana Iowa
## 4 2 1 4 2
## Kansas Kentucky Louisiana Maine Maryland
## 4 2 3 2 1
## Massachusetts Michigan Minnesota Mississippi Missouri
## 4 1 2 3 1
## Montana Nebraska Nevada New Hampshire New Jersey
## 2 2 1 2 4
## New Mexico New York North Carolina North Dakota Ohio
## 1 1 3 2 4
## Oklahoma Oregon Pennsylvania Rhode Island South Carolina
## 4 4 4 4 3
## South Dakota Tennessee Texas Utah Vermont
## 2 3 1 4 2
## Virginia Washington West Virginia Wisconsin Wyoming
## 4 4 2 2 4
##
## Within cluster sum of squares by cluster:
## [1] 19.922437 11.952463 8.316061 16.212213
## (between_SS / total_SS = 71.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
asignacion <- cbind(bd3, cluster = km.res$cluster)
head(asignacion, 10)
## Murder Assault UrbanPop Rape cluster
## Alabama 1.24256408 0.7828393 -0.5209066 -0.003416473 3
## Alaska 0.50786248 1.1068225 -1.2117642 2.484202941 1
## Arizona 0.07163341 1.4788032 0.9989801 1.042878388 1
## Arkansas 0.23234938 0.2308680 -1.0735927 -0.184916602 3
## California 0.27826823 1.2628144 1.7589234 2.067820292 1
## Colorado 0.02571456 0.3988593 0.8608085 1.864967207 1
## 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 1
## Georgia 2.20685994 0.4828549 -0.3827351 0.487701523 3
Exportar csv
write.csv(asignacion, "USArrest.csv")
Visualizar segmentos
#library(data.table)
#library(factoextra)
#fviz_cluster(segmentos, data = bd3, palette=c("red","blue","darkgreen"), ellipse.type= "euclid", star.plot= T, repel= T, ggthem= them())
Optimizar K
library(cluster)
set.seed(123)
#optimizacion <- clusGap(km.res, FUN = kmeans, nstart= 25, K.max= 10, B= 50)
#plot(optimizacion, xlab = "Numero de clusters k")
Conclusiones
Como se menciono en otros momentos, R Studio es escencial en muchas
areas, principalmente en la de Ciencias y Estadistica, que es primordial
para la toma de decisión y que genera un mayor y amplio analisis de los
datos. Pero también puede verse de gran utilidad en otras areas como en
esta actividad enfocada a los crimenes y en el estudio de aquellas zonas
con mayor riesgo y que se deben tomar acción para enfrentarlo. Como
podemos observar cada cluster representa cada Estado de EU para la
determinación del numero de arrestos de cada uno. Se tiene que tomar en
cuenta que si no se cuenta con la versión actualizada de R, los clusters
no se podran correr en el programa por la falta de paquetes y librerías
que no dejan utilizar por falta de esta versión.
LS0tCnRpdGxlOiA8c3BhbiBzdHlsZT0iQ29sb3I6UHVycGxlIj4gIlVTQXJyZXN0IgphdXRob3I6ICJSaWNhcmRvIEdhbGljaWEgLSBBMDE2NTMyNzkiCmRhdGU6ICcyMDIyLTA5LTIwJwpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IHRydWUKICAgIHRvY19mbG9hdDogdHJ1ZQogICAgY29kZV9kb3dubG9hZDogdHJ1ZSAKLS0tCiMjICoqSy1tZWFucyBDbHVzdGVyaW5nIC0gVVNBcnJlc3QqKgoKIVtdKC9Vc2Vycy9yaWNhcmRvZ2MvRGVza3RvcC9BY3RpdmlkYWQgMy4yL2xhcmdlLlBORykKCiMjICpFeHBvcnRhciBCYXNlIGRlIERhdG9zKgpgYGB7cn0KI2ZpbGUuY2hvb3NlKCkKYmQ8LSByZWFkLmNzdiAoIi9Vc2Vycy9yaWNhcmRvZ2MvRGVza3RvcC9SIC0gQW5hbGlzaXMgZGUgZGF0b3MgcGFyYSBsYSB0b21hIGRlIGRlY2lzaW9uZXMuIC9VU0FycmVzdHMuY3N2IikKZGF0YSgiVVNBcnJlc3QiKQpzdW1tYXJ5KFVTQXJyZXN0cykKYGBgCgojIyAqKiJIZXJyYW1pZW50YSAiRWwgR2VuZXJhZG9yIGRlIHZhbG9yIGRlIERhdG9zIioqCgojIyMgUGFzbyAxLiBEZWZpbmlyIGVsIGFyZWEgZGVsIG5lZ29jaW8gcXVlIGJ1c2NhbW9zIGltcGFjdGFyIG8gbWVqb3JhciAoRGVwYXJ0YW1lbnRvKSB5IGVsIEtQSS4KIyMjIyBFbCBkZXBhcnRhbWVudG8gZGUgQXJyZXN0b3MgZW4gbGEgUG9saWNpYSB5IGVsIEtQSSBhIHV0aWxpemFyIHNlcsOtYSBsYSBUYXNhIGRlIENyaW1lbmVzLiAKCiMjIyBQYXNvIDIuIFNlbGVjY2lvbmFyIGxhIHBsYW50aWxsYSBwYXJhIGNyZWFyIHZhbG9yIGEgcGFydGlyIGRlIGxvcyBkYXRvcyBkZSBsb3MgY2xpZW50ZXMuIAojIyMjICoqVmlzacOzbioqIHwgU2VnbWVudGFjacOzbiB8IFBlcnNvbmFsaXphY2nDs24gfCBDb250ZXh0dWFsaXphY2nDs24KCiMjIyBQYXNvIDMuIEdlbmVyYXIgaWRlYXMgeSBjb25jZXB0b3MgZXNwZWNpZmljb3MuCiMjIyMgRWxhYm9yYXIgQ2x1c3RlcnMgcXVlIG5vcyBheXVkZW4gYSB2aXN1YWxpemFyIHkgYW5hbGl6YXIgZGUgbWFuZXJhIGNvcnJlY3RhIGxhIGluZm9ybWFjacOzbiB5IGJyaW5kYXIgdW5hIGRlY2lzacOzbiBwYXJhIGVsIGFyZWEgcG9saWNpYWwgeSBwb2RlciB0b21hciBhY2Npw7NuIGVuIHpvbmFzIGNvbiBtYXlvcmVzIGFycmVzdG9zLiAKCiMjIyBQYXNvIDQuIFJldW5pciBsb3MgZGF0b3MgcmVxdWVyaWRvcwojIyMjIENyZWFjacOzbiBkZSB1bmEgYmFzZSBkZSBkYXRvcyBsaW1waWEgeSBjb24gbGEgaW5mb3JtYWNpw7NuIG3DoXMgcmVsZXZhbnRlIGUgaW1wb3J0YW50ZSBwYXJhIGxhIHRvbWEgZGUgZGVjaXNpw7NuLCBwb3IgbWVkaW8gZGUgbG9zIGNsdXN0ZXJzLiAKCiMjIyBQYXNvIDUgUGxhbiBkZSBlamVjdWNpw7NuLgojIyMjIFNlIGV2YWx1YXJhbiBsYXMgYXJlYXMgY29uIG3DoXMgY3JpbWVuZXMgeSBwb3IgbWVkaW8gZGUgZXN0YXMgZmFzZXMgc2UgcmVhbGl6YXLDoSBlbCBhbmFsaXNpcyBhZGVjdWFkbzoKIyMjIyAqRmFzZSAxLiogUmVndWxhY2lvbmVzIGVzdHJpY3RhcyB5IGNvbiB1bmEgbWF5b3Igb2JzZXJ2YWNpw7NuCiMjIyMgKkZhc2UgMi4qIEVzdHJhdGVnw61hcyBkZSBpbXBsZW1lbnRhY2nDs24gcGFyYSBlbCBtZWpvcmFtaWVudG8gZGUgbG9zIGFycmVzdG9zIGVuIGNhZGEgYXJlYQojIyMjICpGYXNlIDMuKiBOb3RpZmljYWNpw7NuIGEgbGFzIGF1dG9yaWRhZGVzIGRlIGxhcyB6b25hcyBjb24gbcOhcyByaWVzZ28gZSBpbXBsZW1lbnRhciBtYXlvciBvYnNlcnZhY2nDs24gZW4gZXNhcyB6b25hcy4KCiMjIEFncmVnYXIgbGEgQ29sdW1uYSBYCmBgYHtyfQpiZDEgPC0gYmQKcm93bmFtZXMgKGJkMSkgPC0gYmQxJFgKYGBgCgojIyBFbGltaW5hciBDb2x1bW5hIGRlIFgKYGBge3J9CmJkMiA8LSBiZDEKYmQyIDwtIHN1YnNldChiZDIsIHNlbGVjdCA9IC1jKFgpKQpgYGAKCiMjICoqSy1tZWFucyBDbHVzdGVyaW5nKioKIyMjICpSZXZpc2FyIHByZXNlbmNpYSBkZSBkYXRvcyBhbm9ybWFsZXMqCiMjIyAqU2UgZGV0ZXJtaW5vIHF1ZSBoYXkgZGF0b3MgYW5vcm1hbGVzIGVuIFJhcGUsIGZ1ZXJhIGRlbCBsaW1pdGUgc3VwZXJpb3IsIHBlcm8gbm8gc2UgZWxpbWluYXLDoW4gYWwgc2VyIG11eSBjZXJjYW5vcyBhIGxvcyBkZW1hcyBkYXRvcy4qCmBgYHtyfQpib3hwbG90KFVTQXJyZXN0cykKYGBgCgojIyAqUGFzbyAxLiogTm9ybWFsaXphciBWYXJpYWJsZXMKYGBge3J9CmJkMyA8LSBiZDIKYmQzIDwtIGFzLmRhdGEuZnJhbWUoc2NhbGUoYmQzKSkKYGBgCgojIyAqUGFzbyAyLiogay1tZWFucyBDbHVzdGVyaW5nCmBgYHtyfQprbS5yZXMgPC0ga21lYW5zKGJkMywgNCkKa20ucmVzCgphc2lnbmFjaW9uIDwtIGNiaW5kKGJkMywgY2x1c3RlciA9IGttLnJlcyRjbHVzdGVyKQpoZWFkKGFzaWduYWNpb24sIDEwKQpgYGAKCiMjIEV4cG9ydGFyIGNzdgpgYGB7cn0Kd3JpdGUuY3N2KGFzaWduYWNpb24sICJVU0FycmVzdC5jc3YiKQpgYGAKCiMjIFZpc3VhbGl6YXIgc2VnbWVudG9zCmBgYHtyfQojbGlicmFyeShkYXRhLnRhYmxlKQojbGlicmFyeShmYWN0b2V4dHJhKQoKI2Z2aXpfY2x1c3RlcihzZWdtZW50b3MsIGRhdGEgPSBiZDMsIHBhbGV0dGU9YygicmVkIiwiYmx1ZSIsImRhcmtncmVlbiIpLCBlbGxpcHNlLnR5cGU9ICJldWNsaWQiLCBzdGFyLnBsb3Q9IFQsIHJlcGVsPSBULCBnZ3RoZW09IHRoZW0oKSkKYGBgCgojIyBPcHRpbWl6YXIgSwpgYGB7cn0KbGlicmFyeShjbHVzdGVyKQpzZXQuc2VlZCgxMjMpCiNvcHRpbWl6YWNpb24gPC0gY2x1c0dhcChrbS5yZXMsIEZVTiA9IGttZWFucywgbnN0YXJ0PSAyNSwgSy5tYXg9IDEwLCBCPSA1MCkKI3Bsb3Qob3B0aW1pemFjaW9uLCB4bGFiID0gIk51bWVybyBkZSBjbHVzdGVycyBrIikKYGBgCgojIyBDb25jbHVzaW9uZXMKCkNvbW8gc2UgbWVuY2lvbm8gZW4gb3Ryb3MgbW9tZW50b3MsIFIgU3R1ZGlvIGVzIGVzY2VuY2lhbCBlbiBtdWNoYXMgYXJlYXMsIHByaW5jaXBhbG1lbnRlIGVuIGxhIGRlIENpZW5jaWFzIHkgRXN0YWRpc3RpY2EsIHF1ZSBlcyBwcmltb3JkaWFsIHBhcmEgbGEgdG9tYSBkZSBkZWNpc2nDs24geSBxdWUgZ2VuZXJhIHVuIG1heW9yIHkgYW1wbGlvIGFuYWxpc2lzIGRlIGxvcyBkYXRvcy4gUGVybyB0YW1iacOpbiBwdWVkZSB2ZXJzZSBkZSBncmFuIHV0aWxpZGFkIGVuIG90cmFzIGFyZWFzIGNvbW8gZW4gZXN0YSBhY3RpdmlkYWQgZW5mb2NhZGEgYSBsb3MgY3JpbWVuZXMgeSBlbiBlbCBlc3R1ZGlvIGRlIGFxdWVsbGFzIHpvbmFzIGNvbiBtYXlvciByaWVzZ28geSBxdWUgc2UgZGViZW4gdG9tYXIgYWNjacOzbiBwYXJhIGVuZnJlbnRhcmxvLiBDb21vIHBvZGVtb3Mgb2JzZXJ2YXIgY2FkYSBjbHVzdGVyIHJlcHJlc2VudGEgY2FkYSBFc3RhZG8gZGUgRVUgcGFyYSBsYSBkZXRlcm1pbmFjacOzbiBkZWwgbnVtZXJvIGRlIGFycmVzdG9zIGRlIGNhZGEgdW5vLiAKU2UgdGllbmUgcXVlIHRvbWFyIGVuIGN1ZW50YSBxdWUgc2kgbm8gc2UgY3VlbnRhIGNvbiBsYSB2ZXJzacOzbiBhY3R1YWxpemFkYSBkZSBSLCBsb3MgY2x1c3RlcnMgbm8gc2UgcG9kcmFuIGNvcnJlciBlbiBlbCBwcm9ncmFtYSBwb3IgbGEgZmFsdGEgZGUgcGFxdWV0ZXMgeSBsaWJyZXLDrWFzIHF1ZSBubyBkZWphbiB1dGlsaXphciBwb3IgZmFsdGEgZGUgZXN0YSB2ZXJzacOzbi4gCgo=