Importar base de datos

#file.choose()
arrest_BD<- read.csv("C:\\Users\\danyc\\OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey\\Desktop\\Excel y CSV\\USArrests.csv")
summary(arrest_BD)
##       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

Limpiar base de datos

Herramienta “El Generador de Valor de Datos”

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

El área del gobierno a impactar sería el gobierno.

Los KPI´s a impactar son:

a. Nivel de peligrosidad en las ciudades de EUA

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.
Creación de estrategía para mantener a los clientes y generar un incremento en sus compras.

Paso 4. Reunir los datos requeridos.
Se necesita una base de datos que nos informe acerca del estado de los arrestos en Estados Unidos de America para poder hacer un cluster que nos identifique cuales son los lúgres más peligrosos dentro del país.

Paso 5. Plan de ejecución.
Departamento de seguridad Preveer los datos de los arrestos incurridos en cierto periodo de tiempo.

Departamento de análisis Modificar las bases de datos para manipularlas en la generación de información utilizable.

Departamento del uso de impuestos Gestinar el dinero de los impuestos en la generación de soluciones y protección de las ciudades más peligrosas.

Paso 1:Asignar X como nombre de los renglones

BD <- arrest_BD
rownames(BD) <- BD$X

Paso 2:Eliminar columna X

BD1<- BD
BD1<- subset(BD1, select= -c(X))

Paso 3. Revisar datos anormales

boxplot(USArrests)

#Se determino que aunque hay datos anormales en Rape arriba de 40, no tiene caso eliminarlos al denotar cierta cercania.

Paso 3: Clustering de datos

Normalizar variables

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

Hacer el cluster con KMeans

clusters<-kmeans(BD1, 4)

asignacion <-cbind(BD, Cluster=clusters$cluster)
head(asignacion,10)
##                       X Murder Assault UrbanPop Rape Cluster
## Alabama         Alabama   13.2     236       58 21.2       3
## Alaska           Alaska   10.0     263       48 44.5       3
## Arizona         Arizona    8.1     294       80 31.0       3
## Arkansas       Arkansas    8.8     190       50 19.5       4
## California   California    9.0     276       91 40.6       3
## Colorado       Colorado    7.9     204       78 38.7       3
## Connecticut Connecticut    3.3     110       77 11.1       1
## Delaware       Delaware    5.9     238       72 15.8       1
## Florida         Florida   15.4     335       80 31.9       3
## Georgia         Georgia   17.4     211       60 25.8       3

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

Generar optimización en K

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

set.seed(123)
#123 se dejan igual en set.seed o se puden dejar iguales.

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

Conclusión y Aprendizaje

Para este programa, de arrestos la recomendación de la optimización en K nos dio el dato de elegir 4 clusters para obtener datos más exactos, es por eso que nuestros clusters se dividieron en 4 partes y podemos ver que en la parte izquierda inferior son los lugares más peligrosos agrupados en el mismo cluster de color negro mientras que en la derecha superior podemos ver los lugares más seguros en color verde.

Esta segmentación nos sirve para saber dentro de nuestro plan de ejecución que ciudades son las que necesitarían esa inyección de capital para fomentar la protección de sus ciudadanos y evitar más siniestros.

Hablando del modelo de clusters, como constate en el trabajo de supermercados esto personalmente me servirá para hacer planes de mercadotecnia con pocas líneas de código y basándonos en datos precisos que se nos dan dentro de las bases de datos.

LS0tDQp0aXRsZTogPHNwYW4gc3R5bGU9IkNvbG9yOiNGMDVGMzIiPioqIlVTIEFycmVzdHMiKiogPC9zcGFuPg0KYXV0aG9yOiAiRGFuaWVsYSBDw6FyZGVuYXMgWiAvLyBBMDE3MjA1MzUiDQpkYXRlOiAiMjAyMi0wOS0yMCINCm91dHB1dDogDQogICAgICBodG1sX2RvY3VtZW50Og0KICAgICAgICB0b2M6IHRydWUNCiAgICAgICAgdG9jX2Zsb2F0OiB0cnVlDQogICAgICAgIGNvZGVfZm9sZGluZzogImhpZGUiDQogICAgICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCi0tLQ0KKioqDQoNCiMgPGltZyBzcmM9ICJDOlxcVXNlcnNcXGRhbnljXFxEb3dubG9hZHNcXGphaWwuanBnIiAvPg0KDQojIDxzcGFuIHN0eWxlPSJDb2xvcjojRjA1RjMyIj5JbXBvcnRhciBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4NCmBgYHtyfQ0KI2ZpbGUuY2hvb3NlKCkNCmFycmVzdF9CRDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXGRhbnljXFxPbmVEcml2ZSAtIEluc3RpdHV0byBUZWNub2xvZ2ljbyB5IGRlIEVzdHVkaW9zIFN1cGVyaW9yZXMgZGUgTW9udGVycmV5XFxEZXNrdG9wXFxFeGNlbCB5IENTVlxcVVNBcnJlc3RzLmNzdiIpDQpzdW1tYXJ5KGFycmVzdF9CRCkNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJDb2xvcjojRjA1RjMyIj5MaW1waWFyIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQojIDxzcGFuIHN0eWxlPSJDb2xvcjpyZWQiPiBIZXJyYW1pZW50YSDigJxFbCBHZW5lcmFkb3IgZGUgVmFsb3IgZGUgRGF0b3PigJ0gPC9zcGFuPg0KPHN0eWxlPg0KZGl2LmJsdWUgeyBiYWNrZ3JvdW5kLWNvbG9yOiM1ODk4MWY7IGJvcmRlci1yYWRpdXM6IDVweDsgcGFkZGluZzogMjBweDt9DQo8L3N0eWxlPg0KPGRpdiBjbGFzcyA9ICJibHVlIj4NCg0KKlBhc28gMS4qIERlZmluaXIgZWwgw6FyZWEgZGVsIG5lZ29jaW8gcXVlIGJ1c2NhbW9zIGltcGFjdGFyIG8gbWVqb3JhciB5IHN1IEtQSSANCg0KRWwgw6FyZWEgZGVsIGdvYmllcm5vIGEgaW1wYWN0YXIgc2Vyw61hIGVsIGdvYmllcm5vLiAgDQoNCkxvcyBLUEnCtHMgYSBpbXBhY3RhciBzb246ICANCg0KKiphLiBOaXZlbCBkZSBwZWxpZ3Jvc2lkYWQgZW4gbGFzIGNpdWRhZGVzIGRlIEVVQSoqDQoNCipQYXNvIDIuKiBTZWxlY2Npb25hciBwbGFudGlsbGEoLXMpIHBhcmEgY3JlYXIgdmFsb3IgYSBwYXJ0aXIgZGUgbG9zIGRhdG9zIGRlIGxvcyBjbGllbnRlcy4gICAgIA0KDQpWaXNpw7NuIC8gKipTZWdtZW50YWNpw7NuKiogLyBQZXJzb25hbGl6YWNpw7NuIC8gQ29udGV4dHVhbGl6YWNpw7NuICAgICAgIA0KDQoqUGFzbyAzLiogR2VuZXJhciBpZGVhcyBvIGNvbmNlcHRvcyBlc3BlY8OtZmljb3MuICAgIA0KQ3JlYWNpw7NuIGRlIGVzdHJhdGVnw61hIHBhcmEgbWFudGVuZXIgYSBsb3MgY2xpZW50ZXMgeSBnZW5lcmFyIHVuIGluY3JlbWVudG8gZW4gc3VzIGNvbXByYXMuIA0KDQoqUGFzbyA0LiogUmV1bmlyIGxvcyBkYXRvcyByZXF1ZXJpZG9zLiAgDQpTZSBuZWNlc2l0YSB1bmEgYmFzZSBkZSBkYXRvcyBxdWUgbm9zIGluZm9ybWUgYWNlcmNhIGRlbCBlc3RhZG8gZGUgbG9zIGFycmVzdG9zIGVuIEVzdGFkb3MgVW5pZG9zIGRlIEFtZXJpY2EgcGFyYSBwb2RlciBoYWNlciB1biBjbHVzdGVyIHF1ZSBub3MgaWRlbnRpZmlxdWUgY3VhbGVzIHNvbiBsb3MgbMO6Z3JlcyBtw6FzIHBlbGlncm9zb3MgZGVudHJvIGRlbCBwYcOtcy4NCg0KKlBhc28gNS4qIFBsYW4gZGUgZWplY3VjacOzbi4gIA0KKipEZXBhcnRhbWVudG8gZGUgc2VndXJpZGFkKiogDQpQcmV2ZWVyIGxvcyBkYXRvcyBkZSBsb3MgYXJyZXN0b3MgaW5jdXJyaWRvcyBlbiBjaWVydG8gcGVyaW9kbyBkZSB0aWVtcG8uIA0KDQoqKkRlcGFydGFtZW50byBkZSBhbsOhbGlzaXMqKg0KTW9kaWZpY2FyIGxhcyBiYXNlcyBkZSBkYXRvcyBwYXJhIG1hbmlwdWxhcmxhcyBlbiBsYSBnZW5lcmFjacOzbiBkZSBpbmZvcm1hY2nDs24gdXRpbGl6YWJsZS4gDQoNCioqRGVwYXJ0YW1lbnRvIGRlbCB1c28gZGUgaW1wdWVzdG9zKiogDQpHZXN0aW5hciBlbCBkaW5lcm8gZGUgbG9zIGltcHVlc3RvcyBlbiBsYSBnZW5lcmFjacOzbiBkZSBzb2x1Y2lvbmVzIHkgcHJvdGVjY2nDs24gZGUgbGFzIGNpdWRhZGVzIG3DoXMgcGVsaWdyb3Nhcy4gDQo8L2Rpdj4gDQoNCiMjIyA8c3BhbiBzdHlsZT0iQ29sb3I6IzRENEQ0RCI+UGFzbyAxOkFzaWduYXIgWCBjb21vIG5vbWJyZSBkZSBsb3MgcmVuZ2xvbmVzPC9zcGFuPiANCmBgYHtyfQ0KQkQgPC0gYXJyZXN0X0JEDQpyb3duYW1lcyhCRCkgPC0gQkQkWA0KDQpgYGANCg0KIyMjIDxzcGFuIHN0eWxlPSJDb2xvcjojNEQ0RDREIj5QYXNvIDI6RWxpbWluYXIgY29sdW1uYSBYPC9zcGFuPiANCmBgYHtyfQ0KQkQxPC0gQkQNCkJEMTwtIHN1YnNldChCRDEsIHNlbGVjdD0gLWMoWCkpDQpgYGANCg0KDQojIyMgPHNwYW4gc3R5bGU9IkNvbG9yOiM0RDRENEQiPiBQYXNvIDMuIFJldmlzYXIgZGF0b3MgYW5vcm1hbGVzIDwvc3Bhbj4gDQpgYGB7cn0NCmJveHBsb3QoVVNBcnJlc3RzKQ0KI1NlIGRldGVybWlubyBxdWUgYXVucXVlIGhheSBkYXRvcyBhbm9ybWFsZXMgZW4gUmFwZSBhcnJpYmEgZGUgNDAsIG5vIHRpZW5lIGNhc28gZWxpbWluYXJsb3MgYWwgZGVub3RhciBjaWVydGEgY2VyY2FuaWEuDQpgYGANCg0KDQojIyMgPHNwYW4gc3R5bGU9IkNvbG9yOiM0RDRENEQiPlBhc28gMzogQ2x1c3RlcmluZyBkZSBkYXRvcyA8L3NwYW4+IA0KDQojIyMgPHNwYW4gc3R5bGU9IkNvbG9yOiM0RDRENEQiPk5vcm1hbGl6YXIgdmFyaWFibGVzPC9zcGFuPiANCmBgYHtyfQ0KQkQxIDwtIGFzLmRhdGEuZnJhbWUoc2NhbGUoVVNBcnJlc3RzKSkNCmBgYA0KDQoNCiMgPHNwYW4gc3R5bGU9IkNvbG9yOiNGMDVGMzIiPkhhY2VyIGVsIGNsdXN0ZXIgY29uIEtNZWFuczwvc3Bhbj4NCmBgYHtyfQ0KY2x1c3RlcnM8LWttZWFucyhCRDEsIDQpDQoNCmFzaWduYWNpb24gPC1jYmluZChCRCwgQ2x1c3Rlcj1jbHVzdGVycyRjbHVzdGVyKQ0KaGVhZChhc2lnbmFjaW9uLDEwKQ0KYGBgDQoNCg0KIyMgPHNwYW4gc3R5bGU9IkNvbG9yOiM0RDRENEQiPkV4cG9ydGFyIENTVjwvc3Bhbj4gDQpgYGB7cn0NCiN3cml0ZS5jc3YoYXNpZ25hY2lvbiwgImRhdG9zX2Nvbl9jbHVzdGVyLmNzdiIpDQoNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJDb2xvcjojRjA1RjMyIj5WaXN1YWxpemFyIFNlZ21lbnRvcyA8L3NwYW4+DQpgYGB7cn0NCg0KI2luc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKQ0KbGlicmFyeShmYWN0b2V4dHJhKQ0KZnZpel9jbHVzdGVyKGNsdXN0ZXJzLCBkYXRhID0gQkQxLA0KICAgICAgICAgICAgIHBhbGV0dGU9YygicmVkIiwgImJsdWUiLCAiYmxhY2siLCAiZGFya2dyZWVuIiksDQogICAgICAgICAgICAgZWxsaXBzZS50eXBlID0gImV1Y2xpZCIsDQogICAgICAgICAgICAgc3Rhci5wbG90ID0gVCwNCiAgICAgICAgICAgICByZXBlbCA9IFQsDQogICAgICAgICAgICAgZ2d0aGVtZSA9IHRoZW1lKCkpDQoNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJDb2xvcjojRjA1RjMyIj5HZW5lcmFyIG9wdGltaXphY2nDs24gZW4gKksqPC9zcGFuPg0KYGBge3J9DQpsaWJyYXJ5KGNsdXN0ZXIpDQojaW5zdGFsbC5wYWNrYWdlcygiZGF0YS50YWJsZSIpDQpsaWJyYXJ5KGRhdGEudGFibGUpDQoNCnNldC5zZWVkKDEyMykNCiMxMjMgc2UgZGVqYW4gaWd1YWwgZW4gc2V0LnNlZWQgbyBzZSBwdWRlbiBkZWphciBpZ3VhbGVzLg0KDQpvcHRpbWl6YWNpb24gPC0gY2x1c0dhcChCRDEsIEZVTj1rbWVhbnMsIG5zdGFydD0yNSwgSy5tYXg9IDEwLCBCID0gNTApDQpwbG90KG9wdGltaXphY2lvbix4bGFiID0gIk51bWVybyBkZSBjbHVzdGVycyBrIikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJDb2xvcjojRjA1RjMyIj4gQ29uY2x1c2nDs24geSBBcHJlbmRpemFqZSA8L3NwYW4+DQoNCjxzdHlsZT4NCmRpdi5ibHVlIHsgYmFja2dyb3VuZC1jb2xvcjpiZWlnZTsgYm9yZGVyLXJhZGl1czogNXB4OyBwYWRkaW5nOiAyMHB4O30NCjwvc3R5bGU+DQo8ZGl2IGNsYXNzID0gImJsdWUiPg0KDQpQYXJhIGVzdGUgcHJvZ3JhbWEsIGRlIGFycmVzdG9zIGxhIHJlY29tZW5kYWNpw7NuIGRlIGxhIG9wdGltaXphY2nDs24gZW4gSyBub3MgZGlvIGVsIGRhdG8gZGUgZWxlZ2lyIDQgY2x1c3RlcnMgcGFyYSBvYnRlbmVyIGRhdG9zIG3DoXMgZXhhY3RvcywgZXMgcG9yIGVzbyBxdWUgbnVlc3Ryb3MgY2x1c3RlcnMgc2UgZGl2aWRpZXJvbiBlbiA0IHBhcnRlcyB5IHBvZGVtb3MgdmVyIHF1ZSBlbiBsYSBwYXJ0ZSBpenF1aWVyZGEgaW5mZXJpb3Igc29uIGxvcyBsdWdhcmVzIG3DoXMgcGVsaWdyb3NvcyBhZ3J1cGFkb3MgZW4gZWwgbWlzbW8gY2x1c3RlciBkZSBjb2xvciBuZWdybyBtaWVudHJhcyBxdWUgZW4gbGEgZGVyZWNoYSBzdXBlcmlvciBwb2RlbW9zIHZlciBsb3MgbHVnYXJlcyBtw6FzIHNlZ3Vyb3MgZW4gY29sb3IgdmVyZGUuICANCg0KRXN0YSBzZWdtZW50YWNpw7NuIG5vcyBzaXJ2ZSBwYXJhIHNhYmVyIGRlbnRybyBkZSBudWVzdHJvIHBsYW4gZGUgZWplY3VjacOzbiBxdWUgY2l1ZGFkZXMgc29uIGxhcyBxdWUgbmVjZXNpdGFyw61hbiBlc2EgaW55ZWNjacOzbiBkZSBjYXBpdGFsIHBhcmEgZm9tZW50YXIgbGEgcHJvdGVjY2nDs24gZGUgc3VzIGNpdWRhZGFub3MgeSBldml0YXIgbcOhcyBzaW5pZXN0cm9zLiANCg0KSGFibGFuZG8gZGVsIG1vZGVsbyBkZSBjbHVzdGVycywgY29tbyBjb25zdGF0ZSBlbiBlbCB0cmFiYWpvIGRlIHN1cGVybWVyY2Fkb3MgZXN0byBwZXJzb25hbG1lbnRlIG1lIHNlcnZpcsOhIHBhcmEgaGFjZXIgcGxhbmVzIGRlIG1lcmNhZG90ZWNuaWEgY29uIHBvY2FzIGzDrW5lYXMgZGUgY8OzZGlnbyB5IGJhc8OhbmRvbm9zIGVuIGRhdG9zIHByZWNpc29zIHF1ZSBzZSBub3MgZGFuIGRlbnRybyBkZSBsYXMgYmFzZXMgZGUgZGF0b3MuIA0KPC9kaXY+DQo=