Organizar BD

Paso. 1 Cargar base de datos

bd <- read.csv("/Users/ivannagarza/Downloads/USArrests.csv")

Herramienta “El Generador de Valor de Datos”

Paso 1. Definir el área de negocio que buscamos impactar o mejorar y su KPI. El departamento de dirección de EUA con el indicador de Crímenes por estado

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
Elaborar un gráfico de la segmentación de los estados del país con los crímenes cometidos.

Paso 4. Reunir los datos requeridos
Elaborar una gráfica (Boxplot) para identificar datos anormales en la base de datos y de ahí partir al siguiente paso.

Paso 5. Plan de ejecución
El departamento de dirección del país elaborará una estratégia de seguridad para los estados con mayor peligro dependiendo el crímen.

Paso 2. Agregar X como nombre de los renglones

bd1<- bd  
rownames(bd1) <- bd1$X

Paso 3. Eliminar la columna X

bd2<-bd1
bd2 <- subset (bd2, select = -c (X))

Paso 4. Revisar presencia de datos anormales

summary(bd2)
##      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

Creación de clusters

Paso 1.

Normalizar variables

bd3<-bd2
bd3 <- as.data.frame(scale(bd3))

Paso 2.

k-means clustering

segmentos <- kmeans(bd3, 4)
segmentos
## K-means clustering with 4 clusters of sizes 10, 20, 10, 10
## 
## Cluster means:
##       Murder    Assault   UrbanPop       Rape
## 1 -0.2084716 -0.4110987 -0.3412836 -0.2030666
## 2  1.0049340  1.0138274  0.1975853  0.8469650
## 3 -1.1727674 -1.2078573 -1.0045069 -1.1020261
## 4 -0.6286291 -0.4086988  0.9506200 -0.3888373
## 
## Clustering vector:
##        Alabama         Alaska        Arizona       Arkansas     California 
##              2              2              2              1              2 
##       Colorado    Connecticut       Delaware        Florida        Georgia 
##              2              4              4              2              2 
##         Hawaii          Idaho       Illinois        Indiana           Iowa 
##              4              3              2              1              3 
##         Kansas       Kentucky      Louisiana          Maine       Maryland 
##              1              1              2              3              2 
##  Massachusetts       Michigan      Minnesota    Mississippi       Missouri 
##              4              2              3              2              2 
##        Montana       Nebraska         Nevada  New Hampshire     New Jersey 
##              1              1              2              3              4 
##     New Mexico       New York North Carolina   North Dakota           Ohio 
##              2              2              2              3              4 
##       Oklahoma         Oregon   Pennsylvania   Rhode Island South Carolina 
##              1              1              4              4              2 
##   South Dakota      Tennessee          Texas           Utah        Vermont 
##              3              2              2              4              3 
##       Virginia     Washington  West Virginia      Wisconsin        Wyoming 
##              1              4              3              3              1 
## 
## Within cluster sum of squares by cluster:
## [1]  6.148786 46.747955  7.443899  9.326266
##  (between_SS / total_SS =  64.5 %)
## 
## 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       2
## Alaska        10.0     263       48 44.5       2
## Arizona        8.1     294       80 31.0       2
## Arkansas       8.8     190       50 19.5       1
## California     9.0     276       91 40.6       2
## Colorado       7.9     204       78 38.7       2
## Connecticut    3.3     110       77 11.1       4
## Delaware       5.9     238       72 15.8       4
## Florida       15.4     335       80 31.9       2
## Georgia       17.4     211       60 25.8       2

Visualización

Exportar csv

write.csv(asignacion,"USArrestsClusters")

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

Optimizar k

Se debe de insertar una libreria para cluster y para data.table, asimismo un paquete de data.table, sin embargo no se incluyo en el apartado R debido a que marcaba error para publicar.

El código que se puede observar a continuación, se visualiza como texto debido a que al momento de correr la funcion clusGap viene que no esta disponible para la versión de R que tengo. Sin embargo, a continuación se inserta la tabla que da de resultado el código siguiente;

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

Conclusiones

Realizar esta programación con R fue con el propósito de visualmente identificar los datos segmentados. Para poder realizar este programa de manera efectiva, hubieron muchos Warnings en el proceso, debido a la falta de la instalación de diversos paquetes y librerias tales como data.table, y factoextra. Una vez que se instalaron, se pudo representar visualmente los segmentos identificados en el paso 2 de la creación de los clusters, “k-means clustering”.

Hubo un detalle al momento de visualizar el plot de los segmentos, debido a que a comparación de la programación del profesor y mis compañeros, mi visualización se diferenciaba en el color de los circulos, sin embargo, no fue de mucha importancia debido a que la información que estos contenían era igual.

Esta codificación es de alta utilidad para el departamento de dirección de EUA debido a que conocer visualmente los estados con los cuales se hacen conjunto debido a la relación de números dependiendo el crimen ayudan para poder tomar decisiones estratégicas referente a la seguridad, y/o avisos a la población.

LS0tCnRpdGxlOiAiVVNBcnJlc3RzIgphdXRob3I6ICJJdmFubmEgR2FyemEgQTAxMjgzNzU5IgpkYXRlOiAiMjAyMi0wOS0wNiIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OiAKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICB0aGVtZTogY2VydWxlYW4KICAgIGhpZ2hsaWdodDogdGFuZ28gIAogICAgY29kZV9kb3dubG9hZDogdHJ1ZQogICAgCi0tLQo8aW1nIHNyYz0gIi9Vc2Vycy9pdmFubmFnYXJ6YS9EZXNrdG9wLzg2NDQ5YTAyNjE0NTRkNDlhNWVlNDQ0MDllYzBhYTVmLmdpZiI+CgojIE9yZ2FuaXphciBCRAojIyBQYXNvLiAxIENhcmdhciBiYXNlIGRlIGRhdG9zCmBgYHtyfQpiZCA8LSByZWFkLmNzdigiL1VzZXJzL2l2YW5uYWdhcnphL0Rvd25sb2Fkcy9VU0FycmVzdHMuY3N2IikKYGBgCgojICoqSGVycmFtaWVudGEgIkVsIEdlbmVyYWRvciBkZSBWYWxvciBkZSBEYXRvcyIqKiAgCgoqKlBhc28gMS4gRGVmaW5pciBlbCDDoXJlYSBkZSBuZWdvY2lvIHF1ZSBidXNjYW1vcyBpbXBhY3RhciBvIG1lam9yYXIgeSBzdSBLUEkuKioKKkVsIGRlcGFydGFtZW50byBkZSBkaXJlY2Npw7NuIGRlIEVVQSBjb24gZWwgaW5kaWNhZG9yIGRlIENyw61tZW5lcyBwb3IgZXN0YWRvKiAgCgoqKlBhc28gMi4gU2VsZWNjaW9uYXIgcGxhbnRpbGxhICgtcykgcGFyYSBjcmVhciB2YWxvciBhIHBhcnRpciBkZSBsb3MgZGF0b3MgZGUgbG9zIGNsaWVudGVzLioqICAKKlZpc2nDs24gLyogKipTZWdtZW50YWNpw7NuKiogKi8gUGVyc29uYWxpemFjacOzbiAvIENvbnRleHR1YWxpemFjacOzbioKCioqUGFzbyAzLiBHZW5lcmFyIGlkZWFzIG8gY29uY2VwdG9zIGVzcGVjw61maWNvcyoqICAKKkVsYWJvcmFyIHVuIGdyw6FmaWNvIGRlIGxhIHNlZ21lbnRhY2nDs24gZGUgbG9zIGVzdGFkb3MgZGVsIHBhw61zIGNvbiBsb3MgY3LDrW1lbmVzIGNvbWV0aWRvcy4qICAKCioqUGFzbyA0LiBSZXVuaXIgbG9zIGRhdG9zIHJlcXVlcmlkb3MqKiAgCipFbGFib3JhciB1bmEgZ3LDoWZpY2EgKEJveHBsb3QpICBwYXJhIGlkZW50aWZpY2FyIGRhdG9zIGFub3JtYWxlcyBlbiBsYSBiYXNlIGRlIGRhdG9zIHkgZGUgYWjDrSBwYXJ0aXIgYWwgc2lndWllbnRlIHBhc28uKiAgCgoqKlBhc28gNS4gUGxhbiBkZSBlamVjdWNpw7NuKiogIAoqRWwgZGVwYXJ0YW1lbnRvIGRlIGRpcmVjY2nDs24gZGVsIHBhw61zIGVsYWJvcmFyw6EgdW5hIGVzdHJhdMOpZ2lhIGRlIHNlZ3VyaWRhZCBwYXJhIGxvcyBlc3RhZG9zIGNvbiBtYXlvciBwZWxpZ3JvIGRlcGVuZGllbmRvIGVsIGNyw61tZW4uKiAgCgoKIyMgUGFzbyAyLiBBZ3JlZ2FyIFggY29tbyBub21icmUgZGUgbG9zIHJlbmdsb25lcyAKYGBge3J9CmJkMTwtIGJkICAKcm93bmFtZXMoYmQxKSA8LSBiZDEkWApgYGAKCiMjIFBhc28gMy4gRWxpbWluYXIgbGEgY29sdW1uYSBYCmBgYHtyfQpiZDI8LWJkMQpiZDIgPC0gc3Vic2V0IChiZDIsIHNlbGVjdCA9IC1jIChYKSkKYGBgCgojIyBQYXNvIDQuIFJldmlzYXIgcHJlc2VuY2lhIGRlIGRhdG9zIGFub3JtYWxlcwpgYGB7cn0Kc3VtbWFyeShiZDIpCmBgYAoKIyBDcmVhY2nDs24gZGUgY2x1c3RlcnMgCgojIyMgUGFzbyAxLiAKKipOb3JtYWxpemFyIHZhcmlhYmxlcyoqCmBgYHtyfQpiZDM8LWJkMgpiZDMgPC0gYXMuZGF0YS5mcmFtZShzY2FsZShiZDMpKQpgYGAKCiMjIyBQYXNvIDIuIAoqKmstbWVhbnMgY2x1c3RlcmluZyoqCmBgYHtyfQpzZWdtZW50b3MgPC0ga21lYW5zKGJkMywgNCkKc2VnbWVudG9zCgphc2lnbmFjaW9uIDwtIGNiaW5kKFVTQXJyZXN0cywgY2x1c3RlciA9IHNlZ21lbnRvcyRjbHVzdGVyKQpoZWFkKGFzaWduYWNpb24sMTApCmBgYAoKIyBWaXN1YWxpemFjacOzbgoKIyMgRXhwb3J0YXIgY3N2CmBgYHtyfQp3cml0ZS5jc3YoYXNpZ25hY2lvbiwiVVNBcnJlc3RzQ2x1c3RlcnMiKQpgYGAKCiMjIFZpc3VhbGl6YXIgU2VnbWVudG9zCmBgYHtyfQojIGluc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKQpsaWJyYXJ5KGZhY3RvZXh0cmEpCmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsIGRhdGEgPSBiZDMsCiAgICAgICAgICAgICBwYWxldHRlPWMoInJlZCIsICJibHVlIiwgImJsYWNrIiwgImRhcmtncmVlbiIpLAogICAgICAgICAgICAgZWxsaXBzZS50eXBlID0gImV1Y2xpZCIsCiAgICAgICAgICAgICBzdGFyLnBsb3QgPSBULAogICAgICAgICAgICAgcmVwZWwgPSBULAogICAgICAgICAgICAgZ2d0aGVtZSA9IHRoZW1lKCkpCmBgYAoKIyMgT3B0aW1pemFyIGsKClNlIGRlYmUgZGUgaW5zZXJ0YXIgdW5hIGxpYnJlcmlhIHBhcmEgY2x1c3RlciB5IHBhcmEgZGF0YS50YWJsZSwgYXNpbWlzbW8gdW4gcGFxdWV0ZSBkZSBkYXRhLnRhYmxlLCBzaW4gZW1iYXJnbyBubyBzZSBpbmNsdXlvIGVuIGVsIGFwYXJ0YWRvIFIgZGViaWRvIGEgcXVlIG1hcmNhYmEgZXJyb3IgcGFyYSBwdWJsaWNhci4gIAoKRWwgY8OzZGlnbyBxdWUgc2UgcHVlZGUgb2JzZXJ2YXIgYSBjb250aW51YWNpw7NuLCBzZSB2aXN1YWxpemEgY29tbyB0ZXh0byBkZWJpZG8gYSBxdWUgYWwgbW9tZW50byBkZSBjb3JyZXIgbGEgZnVuY2lvbiAqY2x1c0dhcCogdmllbmUgcXVlIG5vIGVzdGEgZGlzcG9uaWJsZSBwYXJhIGxhIHZlcnNpw7NuIGRlICpSKiBxdWUgdGVuZ28uIFNpbiBlbWJhcmdvLCBhIGNvbnRpbnVhY2nDs24gc2UgaW5zZXJ0YSBsYSB0YWJsYSBxdWUgZGEgZGUgcmVzdWx0YWRvIGVsIGPDs2RpZ28gc2lndWllbnRlOyAgCgo8c3BhbiBzdHlsZSA9ICJjb2xvcjpncmVlbiIgPgoqKnNldC5zZWVkKDEyMykqKgoqKm9wdGltaXphY2lvbiA8LSBjbHVzR2FwKGJkMywgRlVOID0ga21lYW5zLCBuc3RhcnQgPSAyNSwgSy5tYXggPSAxMCwgQiA9IDUwKSoqCioqcGxvdChvcHRpbWl6YWNpb24sIHhsYWIgPSAiTnVtZXJvIGRlIGNsdXN0ZXJzIGsiKSoqIDwvc3Bhbj4uIAoKPGltZyBzcmM9ICIvVXNlcnMvaXZhbm5hZ2FyemEvRGVza3RvcC9URUMvNyBTRU1FU1RSRS9NT0RVTE8zL1JwbG90LnBuZyI+CgojIENvbmNsdXNpb25lcwpSZWFsaXphciBlc3RhIHByb2dyYW1hY2nDs24gY29uICpSKiBmdWUgY29uIGVsIHByb3DDs3NpdG8gZGUgdmlzdWFsbWVudGUgaWRlbnRpZmljYXIgbG9zIGRhdG9zIHNlZ21lbnRhZG9zLiBQYXJhIHBvZGVyIHJlYWxpemFyIGVzdGUgcHJvZ3JhbWEgZGUgbWFuZXJhIGVmZWN0aXZhLCBodWJpZXJvbiBtdWNob3MgKldhcm5pbmdzKiBlbiBlbCBwcm9jZXNvLCBkZWJpZG8gYSBsYSBmYWx0YSBkZSBsYSBpbnN0YWxhY2nDs24gZGUgZGl2ZXJzb3MgcGFxdWV0ZXMgeSBsaWJyZXJpYXMgdGFsZXMgY29tbyAqZGF0YS50YWJsZSosIHkgKmZhY3RvZXh0cmEqLiBVbmEgdmV6IHF1ZSBzZSBpbnN0YWxhcm9uLCBzZSBwdWRvIHJlcHJlc2VudGFyIHZpc3VhbG1lbnRlIGxvcyBzZWdtZW50b3MgaWRlbnRpZmljYWRvcyBlbiBlbCBwYXNvIDIgZGUgbGEgY3JlYWNpw7NuIGRlIGxvcyAqY2x1c3RlcnMqLCAqImstbWVhbnMgY2x1c3RlcmluZyIqLiAgCgpIdWJvIHVuIGRldGFsbGUgYWwgbW9tZW50byBkZSB2aXN1YWxpemFyIGVsICpwbG90KiBkZSBsb3Mgc2VnbWVudG9zLCBkZWJpZG8gYSBxdWUgYSBjb21wYXJhY2nDs24gZGUgbGEgcHJvZ3JhbWFjacOzbiBkZWwgcHJvZmVzb3IgeSBtaXMgY29tcGHDsWVyb3MsIG1pIHZpc3VhbGl6YWNpw7NuIHNlIGRpZmVyZW5jaWFiYSBlbiBlbCBjb2xvciBkZSBsb3MgY2lyY3Vsb3MsIHNpbiBlbWJhcmdvLCBubyBmdWUgZGUgbXVjaGEgaW1wb3J0YW5jaWEgZGViaWRvIGEgcXVlIGxhIGluZm9ybWFjacOzbiBxdWUgZXN0b3MgY29udGVuw61hbiBlcmEgaWd1YWwuICAKCkVzdGEgY29kaWZpY2FjacOzbiBlcyBkZSBhbHRhIHV0aWxpZGFkIHBhcmEgZWwgZGVwYXJ0YW1lbnRvIGRlIGRpcmVjY2nDs24gZGUgRVVBIGRlYmlkbyBhIHF1ZSBjb25vY2VyIHZpc3VhbG1lbnRlIGxvcyBlc3RhZG9zIGNvbiBsb3MgY3VhbGVzIHNlIGhhY2VuIGNvbmp1bnRvIGRlYmlkbyBhIGxhIHJlbGFjacOzbiBkZSBuw7ptZXJvcyBkZXBlbmRpZW5kbyBlbCBjcmltZW4gYXl1ZGFuIHBhcmEgcG9kZXIgdG9tYXIgZGVjaXNpb25lcyBlc3RyYXTDqWdpY2FzIHJlZmVyZW50ZSBhIGxhIHNlZ3VyaWRhZCwgeS9vIGF2aXNvcyBhIGxhIHBvYmxhY2nDs24uCgo=