JuveYell

Importar la base de datos

file.choose()
## [1] "C:\\Users\\Migue\\OneDrive\\Documentos\\R\\Primer bloque\\USArrests\\USArrests.Rmd"
bd1<- read.csv("C:\\Users\\Migue\\OneDrive\\Documentos\\R\\Primer bloque\\USArrests\\USArrests.csv")

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

Agregar el X como nombre de los renglones

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

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

Eliminar la columna de X

bd3 <- bd2
bd3 <- subset (bd3, select = -c (X))
summary(bd3)
##      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
plot(bd3$Murder,bd3$Assault)

Los datos fuera de lo normal están fuera de los siguientes límites:

### Límite Inferior = Q1 - 1.5*IQR
### Límite Superior = Q3 + 1.5*IQR
### Q1: Cuartil 1, Q3: Cuartil 3, IQR: Rango Intercuartil = Q3 - Q1

Calcular el límite superior del total

iqr_murder <- IQR(bd3$Murder)
limite_superior_murder <- 11.250 + 1.5*iqr_murder
limite_superior_murder
## [1] 22.0125

Conservar sólo los datos de asalto y asesinato

bd4 <- bd3
bd4 <- bd4[bd4$Murder < 22.0125, ]
summary(bd4)
##      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
plot(bd4$Murder,bd4$Assault)

k-means Clustering

Paso 1. Normalizar variables

bd5 <- bd4
bd4 <- as.data.frame(scale(bd4))

plot(bd4$Murder,bd4$Assault)

Paso 2. k-means Clustering

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

Exportar csv

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

Optimizar k

library(cluster)
library(data.table)

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

Revisar presencia de datos anormales

boxplot(bd5)

La Herramienta “El Generador de Valor de Datos”

Paso 1. Definir el área del negocio que buscamos impactar o mejorar y su KPI.

Reducir el porcentaje de asesinatos y casos hostiles en California.

Paso 2. Seleccionar plantilla(s) para crear valor a partir de los datos de los clientes. Visión | Segmentación | Personalización | Contextualización

Segmentación.

Paso 3. Generar ideas o conceptos específicos.

Posicionar en estas áreas más cuerpos policiacos o escuadrones de protección para reducir el porcentaje de incidentes.

Paso 4. Reunir los datos requeridos.

Identificar las áreas o sectores donde ocurren más crímenes.

Paso 5. Plan de ejecución.

Escuadrones de policía en áreas más inseguras de California para reducir el porcentaje de asesinatos y eventos violentos, dándole a los ciudadanos una ciudad más segura y mayor sentido de seguridad.

Observaciones:

# Se determinó que hay datos anormales en Rape (fuera del límite superior), pero
# No se eliminarán al ser muy cercanos a los demás datos.

Conclusiones

En las gráficas se muestra la correlación entre los asaltos contra asesinatos. En este destaca que hay más asaltos sin asesinato que asaltos con asesinatos. De acuerdo a los segmentos y vectores (clusters), se tienen más incidentes de asesinato, asalto, urbanpop y abuso sexual en Georgia, mientras que en Connecticut es el estado en donde existen menos eventos de violencia.

En general, vemos que en Estados Unidos existe una mayor cantidad de casos de asaltos y aquellos con menor frecuencia en el registro son los asesinatos.

JuveYell

LS0tDQp0aXRsZTogPHNwYW4gc3R5bGU9IkNvbG9yOlB1cnBsZSI+ICJVU0FycmVzdHMiDQphdXRob3I6ICJKaW1lbmEgTWlndWVsIC0gQTAxMzY1ODE5Ig0KZGF0ZTogIjIwMjItMDktMDYiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiB0cnVlDQogICAgdG9jX2Zsb2F0OiB0cnVlDQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQ0KLS0tDQoNCjxkaXY+DQo8cCBzdHlsZSA9ICd0ZXh0LWFsaWduOmNlbnRlcjsnPg0KPGltZyBzcmM9Imh0dHBzOi8vdXBsb2FkLndpa2ltZWRpYS5vcmcvd2lraXBlZGlhL2NvbW1vbnMvdGh1bWIvNy83OC9NYXBfb2ZfVVNBX3dpdGhfc3RhdGVfbmFtZXNfZXMuc3ZnLzgwMHB4LU1hcF9vZl9VU0Ffd2l0aF9zdGF0ZV9uYW1lc19lcy5zdmcucG5nIiBhbHQ9Ikp1dmVZZWxsIiB3aWR0aD0iMzAwcHgiPg0KPC9wPg0KPC9kaXY+DQoNCiMjIEltcG9ydGFyIGxhIGJhc2UgZGUgZGF0b3MNCg0KYGBge3J9DQpmaWxlLmNob29zZSgpDQpiZDE8LSByZWFkLmNzdigiQzpcXFVzZXJzXFxNaWd1ZVxcT25lRHJpdmVcXERvY3VtZW50b3NcXFJcXFByaW1lciBibG9xdWVcXFVTQXJyZXN0c1xcVVNBcnJlc3RzLmNzdiIpDQoNCnN1bW1hcnkoYmQxKQ0KYGBgDQoNCiMjIEFncmVnYXIgZWwgWCBjb21vIG5vbWJyZSBkZSBsb3MgcmVuZ2xvbmVzDQpgYGB7cn0NCmJkMiA8LSBiZDENCnJvd25hbWVzKGJkMik8LSBiZDIkWA0KDQpzdW1tYXJ5KGJkMikNCmBgYA0KDQojIyBFbGltaW5hciBsYSBjb2x1bW5hIGRlIFgNCg0KYGBge3J9DQpiZDMgPC0gYmQyDQpiZDMgPC0gc3Vic2V0IChiZDMsIHNlbGVjdCA9IC1jIChYKSkNCnN1bW1hcnkoYmQzKQ0KcGxvdChiZDMkTXVyZGVyLGJkMyRBc3NhdWx0KQ0KYGBgDQoNCiMjIExvcyBkYXRvcyBmdWVyYSBkZSBsbyBub3JtYWwgZXN0w6FuIGZ1ZXJhIGRlIGxvcyBzaWd1aWVudGVzIGzDrW1pdGVzOg0KYGBge3J9DQojIyMgTMOtbWl0ZSBJbmZlcmlvciA9IFExIC0gMS41KklRUg0KIyMjIEzDrW1pdGUgU3VwZXJpb3IgPSBRMyArIDEuNSpJUVINCiMjIyBRMTogQ3VhcnRpbCAxLCBRMzogQ3VhcnRpbCAzLCBJUVI6IFJhbmdvIEludGVyY3VhcnRpbCA9IFEzIC0gUTENCmBgYA0KDQojIyBDYWxjdWxhciBlbCBsw61taXRlIHN1cGVyaW9yIGRlbCB0b3RhbA0KDQpgYGB7cn0NCmlxcl9tdXJkZXIgPC0gSVFSKGJkMyRNdXJkZXIpDQpsaW1pdGVfc3VwZXJpb3JfbXVyZGVyIDwtIDExLjI1MCArIDEuNSppcXJfbXVyZGVyDQpsaW1pdGVfc3VwZXJpb3JfbXVyZGVyDQpgYGANCg0KIyMgQ29uc2VydmFyIHPDs2xvIGxvcyBkYXRvcyBkZSBhc2FsdG8geSBhc2VzaW5hdG8NCg0KYGBge3J9DQpiZDQgPC0gYmQzDQpiZDQgPC0gYmQ0W2JkNCRNdXJkZXIgPCAyMi4wMTI1LCBdDQpzdW1tYXJ5KGJkNCkNCnBsb3QoYmQ0JE11cmRlcixiZDQkQXNzYXVsdCkNCmBgYA0KDQojIyBrLW1lYW5zIENsdXN0ZXJpbmcNCg0KIyMjIFBhc28gMS4gTm9ybWFsaXphciB2YXJpYWJsZXMNCmBgYHtyfQ0KDQpiZDUgPC0gYmQ0DQpiZDQgPC0gYXMuZGF0YS5mcmFtZShzY2FsZShiZDQpKQ0KDQpwbG90KGJkNCRNdXJkZXIsYmQ0JEFzc2F1bHQpDQpgYGANCg0KIyMjIFBhc28gMi4gay1tZWFucyBDbHVzdGVyaW5nDQoNCmBgYHtyfQ0Kc2VnbWVudG9zIDwtIGttZWFucyhiZDQsNCkNCnNlZ21lbnRvcw0KDQphc2lnbmFjaW9uIDwtIGNiaW5kKGJkMywgY2x1c3RlciA9IHNlZ21lbnRvcyRjbHVzdGVyKQ0KaGVhZChhc2lnbmFjaW9uLDEwKQ0KYGBgDQoNCiMjIEV4cG9ydGFyIGNzdg0KDQpgYGB7cn0NCndyaXRlLmNzdihhc2lnbmFjaW9uLCJjbGllbnRlc19zZWdtZW50YWRvcy5jc3YiKQ0KYGBgDQoNCiMjIFZpc3VhbGl6YXIgU2VnbWVudG9zDQoNCmBgYHtyfQ0KI2luc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKQ0KbGlicmFyeShmYWN0b2V4dHJhKQ0KZnZpel9jbHVzdGVyKHNlZ21lbnRvcywgZGF0YSA9IGJkNCwNCiAgICAgICAgICAgICBwYWxldHRlPWMoInJlZCIsICJibHVlIiwgImJsYWNrIiwgImRhcmtncmVlbiIpLA0KICAgICAgICAgICAgIGVsbGlwc2UudHlwZSA9ICJldWNsaWQiLA0KICAgICAgICAgICAgIHN0YXIucGxvdCA9IFQsDQogICAgICAgICAgICAgcmVwZWwgPSBULA0KICAgICAgICAgICAgIGdndGhlbWUgPSB0aGVtZSgpKQ0KYGBgDQoNCiMjIE9wdGltaXphciBrDQoNCmBgYHtyfQ0KbGlicmFyeShjbHVzdGVyKQ0KbGlicmFyeShkYXRhLnRhYmxlKQ0KDQpzZXQuc2VlZCgxMjMpDQpvcHRpbWl6YWNpb24gPC0gY2x1c0dhcChiZDQsIEZVTiA9IGttZWFucywgbnN0YXJ0ID0gMjUsIEsubWF4ID0gMTAsIEIgPSA1MCkNCnBsb3Qob3B0aW1pemFjaW9uLCB4bGFiID0gIk51bWVybyBkZSBjbHVzdGVycyBrIikNCmBgYA0KDQojIyBSZXZpc2FyIHByZXNlbmNpYSBkZSBkYXRvcyBhbm9ybWFsZXMNCg0KYGBge3J9DQpib3hwbG90KGJkNSkNCmBgYA0KDQojIyBMYSBIZXJyYW1pZW50YSAiRWwgR2VuZXJhZG9yIGRlIFZhbG9yIGRlIERhdG9zIg0KDQojIyMgUGFzbyAxLiBEZWZpbmlyIGVsIMOhcmVhIGRlbCBuZWdvY2lvIHF1ZSBidXNjYW1vcyBpbXBhY3RhciBvIG1lam9yYXIgeSBzdSBLUEkuDQpSZWR1Y2lyIGVsIHBvcmNlbnRhamUgZGUgYXNlc2luYXRvcyB5IGNhc29zIGhvc3RpbGVzIGVuIENhbGlmb3JuaWEuDQoNCiMjIyBQYXNvIDIuIFNlbGVjY2lvbmFyIHBsYW50aWxsYShzKSBwYXJhIGNyZWFyIHZhbG9yIGEgcGFydGlyIGRlIGxvcyBkYXRvcyBkZSBsb3MgY2xpZW50ZXMuIFZpc2nDs24gfCBTZWdtZW50YWNpw7NuIHwgUGVyc29uYWxpemFjacOzbiB8IENvbnRleHR1YWxpemFjacOzbg0KU2VnbWVudGFjacOzbi4NCg0KIyMjIFBhc28gMy4gR2VuZXJhciBpZGVhcyBvIGNvbmNlcHRvcyBlc3BlY8OtZmljb3MuDQpQb3NpY2lvbmFyIGVuIGVzdGFzIMOhcmVhcyBtw6FzIGN1ZXJwb3MgcG9saWNpYWNvcyBvIGVzY3VhZHJvbmVzIGRlIHByb3RlY2Npw7NuIHBhcmEgcmVkdWNpciBlbCBwb3JjZW50YWplIGRlIGluY2lkZW50ZXMuDQoNCiMjIyBQYXNvIDQuIFJldW5pciBsb3MgZGF0b3MgcmVxdWVyaWRvcy4NCklkZW50aWZpY2FyIGxhcyDDoXJlYXMgbyBzZWN0b3JlcyBkb25kZSBvY3VycmVuIG3DoXMgY3LDrW1lbmVzLg0KDQojIyMgUGFzbyA1LiBQbGFuIGRlIGVqZWN1Y2nDs24uDQpFc2N1YWRyb25lcyBkZSBwb2xpY8OtYSBlbiDDoXJlYXMgbcOhcyBpbnNlZ3VyYXMgZGUgQ2FsaWZvcm5pYSBwYXJhIHJlZHVjaXIgZWwgcG9yY2VudGFqZSBkZSBhc2VzaW5hdG9zIHkgZXZlbnRvcyB2aW9sZW50b3MsIGTDoW5kb2xlIGEgbG9zIGNpdWRhZGFub3MgdW5hIGNpdWRhZCBtw6FzIHNlZ3VyYSB5IG1heW9yIHNlbnRpZG8gZGUgc2VndXJpZGFkLg0KDQojIyBPYnNlcnZhY2lvbmVzOg0KDQpgYGB7cn0NCiMgU2UgZGV0ZXJtaW7DsyBxdWUgaGF5IGRhdG9zIGFub3JtYWxlcyBlbiBSYXBlIChmdWVyYSBkZWwgbMOtbWl0ZSBzdXBlcmlvciksIHBlcm8NCiMgTm8gc2UgZWxpbWluYXLDoW4gYWwgc2VyIG11eSBjZXJjYW5vcyBhIGxvcyBkZW3DoXMgZGF0b3MuDQpgYGANCg0KIyMgQ29uY2x1c2lvbmVzDQpFbiBsYXMgZ3LDoWZpY2FzIHNlIG11ZXN0cmEgbGEgX19jb3JyZWxhY2nDs24gZW50cmUgbG9zIGFzYWx0b3MgY29udHJhIGFzZXNpbmF0b3NfXy4gRW4gZXN0ZSBkZXN0YWNhIHF1ZSBoYXkgbcOhcyBhc2FsdG9zIHNpbiBhc2VzaW5hdG8gcXVlIGFzYWx0b3MgY29uIGFzZXNpbmF0b3MuIERlIGFjdWVyZG8gYSBsb3Mgc2VnbWVudG9zIHkgdmVjdG9yZXMgKF9jbHVzdGVyc18pLCBzZSB0aWVuZW4gbcOhcyBpbmNpZGVudGVzIGRlIGFzZXNpbmF0bywgYXNhbHRvLCBfdXJiYW5wb3BfIHkgYWJ1c28gc2V4dWFsIGVuIEdlb3JnaWEsIG1pZW50cmFzIHF1ZSBlbiBDb25uZWN0aWN1dCBlcyBlbCBlc3RhZG8gZW4gZG9uZGUgZXhpc3RlbiBtZW5vcyBldmVudG9zIGRlIHZpb2xlbmNpYS4NCg0KRW4gZ2VuZXJhbCwgdmVtb3MgcXVlIGVuIEVzdGFkb3MgVW5pZG9zIGV4aXN0ZSB1bmEgbWF5b3IgY2FudGlkYWQgZGUgY2Fzb3MgZGUgYXNhbHRvcyB5IGFxdWVsbG9zIGNvbiBtZW5vciBmcmVjdWVuY2lhIGVuIGVsIHJlZ2lzdHJvIHNvbiBsb3MgYXNlc2luYXRvcy4NCg0KDQo8ZGl2Pg0KPHAgc3R5bGUgPSAndGV4dC1hbGlnbjpjZW50ZXI7Jz4NCjxpbWcgc3JjPSJodHRwczovL3BhMS5uYXJ2aWkuY29tLzY5MTkvZjEzNGI4M2U2MDdiMjkzOTk1MGYwYWJmNDgwZDZjOGI4NzZlMzRmOHIxLTUwMC00MDBfaHEuZ2lmIiBhbHQ9Ikp1dmVZZWxsIiB3aWR0aD0iMzAwcHgiPg0KPC9wPg0KPC9kaXY+