USArrests y ML

Contexto

La base de datos **USArrests* conteine estadisticas en arrestos por cada 100,000 residesntes por agresión, asesinato y violación en cada uno de los 50 estados de EE:UU. En 1973.

Paquetes y librerias

library("cluster") #Para agrupamientos
library("ggplot2") #Para graficar
library("factoextra") # Visualizar Clusters

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

library("data.table")# Para tabajar con conjutnos de datos grandes
library("tidyverse")

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.4     ✔ tibble    3.2.1
## ✔ purrr     1.0.4     ✔ tidyr     1.3.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between()     masks data.table::between()
## ✖ dplyr::filter()      masks stats::filter()
## ✖ dplyr::first()       masks data.table::first()
## ✖ lubridate::hour()    masks data.table::hour()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ dplyr::lag()         masks stats::lag()
## ✖ dplyr::last()        masks data.table::last()
## ✖ lubridate::mday()    masks data.table::mday()
## ✖ lubridate::minute()  masks data.table::minute()
## ✖ lubridate::month()   masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second()  masks data.table::second()
## ✖ purrr::transpose()   masks data.table::transpose()
## ✖ lubridate::wday()    masks data.table::wday()
## ✖ lubridate::week()    masks data.table::week()
## ✖ lubridate::yday()    masks data.table::yday()
## ✖ lubridate::year()    masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library("dplyr")
library("caret")

## Cargando paquete requerido: lattice
## 
## Adjuntando el paquete: 'caret'
## 
## The following object is masked from 'package:purrr':
## 
##     lift

Resumen estadistico

df <- USArrests
summary(df)

##      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

Escalar la base de datos

datos_escalados<- scale(df)

Generar los segmentos

grupos <- 4 # Incio con cualquier valor , luego verifíco
segmentos <- kmeans(datos_escalados, grupos)

Asignar grupos a los datos

asignacion<- cbind(df, cluster= segmentos$cluster)

Graficar clusters

fviz_cluster(segmentos, data=df)

## Optimizar la cantidad de grupos

En base a los resultados se procedió con la cantidad de 4 clusters.

#LA cantidad óptima de grupos corresponde al puntos más alto de la gráfica
set.seed(123)
op<- clusGap(datos_escalados, FUN= kmeans, nstart=1, K.max =10)
plot(op, xlab= "Número de clusters k")

## Comparar segmentos

promedio <- aggregate(asignacion, by=list(asignacion$cluster), FUN=mean)
promedio

##   Group.1 Murder Assault UrbanPop   Rape cluster
## 1       1  2.680   70.10     51.0 10.910       1
## 2       2  6.880  136.50     60.6 19.330       2
## 3       3  5.050  136.70     79.3 17.590       3
## 4       4 12.165  255.25     68.4 29.165       4

cuenta <- asignacion %>% count(cluster)
cuenta

##   cluster  n
## 1       1 10
## 2       2 10
## 3       3 10
## 4       4 20

Tabla de asignación con clusters

# Agregar la columna de estados a la tabla de asignación
asignacion <- asignacion %>% mutate(State = rownames(USArrests))

# Filtrar solo columnas numéricas para calcular el promedio
numeric_vars <- asignacion %>% select_if(is.numeric)

# Calcular el promedio de cada variable cuantitativa por cluster
promedio <- numeric_vars %>%
  group_by(cluster) %>%
  summarise(across(everything(), mean, na.rm = TRUE))

## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `across(everything(), mean, na.rm = TRUE)`.
## ℹ In group 1: `cluster = 1`.
## Caused by warning:
## ! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
## Supply arguments directly to `.fns` through an anonymous function instead.
## 
##   # Previously
##   across(a:b, mean, na.rm = TRUE)
## 
##   # Now
##   across(a:b, \(x) mean(x, na.rm = TRUE))

# Crear pesos basados en el crimen más alto (Murder tiene el mayor peso)
pesos <- c(Murder = 0.4, Assault = 0.3, UrbanPop = 0.1, Rape = 0.2)

# Calcular el promedio ponderado de crimen por cluster
promedio <- promedio %>%
  mutate(
    CrimeScore = (Murder * pesos["Murder"]) + 
                 (Assault * pesos["Assault"]) + 
                 (UrbanPop * pesos["UrbanPop"]) + 
                 (Rape * pesos["Rape"])
  )

# Asignar categorías de seguridad
promedio <- promedio %>%
  mutate(Seguridad = case_when(
    CrimeScore <= quantile(CrimeScore, 0.25, na.rm = TRUE) ~ "Más Seguro",
    CrimeScore <= quantile(CrimeScore, 0.50, na.rm = TRUE) ~ "Seguro",
    CrimeScore <= quantile(CrimeScore, 0.75, na.rm = TRUE) ~ "Inseguro",
    TRUE ~ "Más Inseguro"
  ))



# Unir la tabla de seguridad con la tabla de asignación
asignacion <- asignacion %>% left_join(select(promedio, cluster, Seguridad), by = "cluster")

# Reordenar columnas para que Seguridad y State sean las primeras
asignacion <- asignacion %>% select(State, Seguridad, everything(), -cluster)

# Mostrar resultados
list(asignacion = asignacion, cuenta = cuenta)

## $asignacion
##             State    Seguridad Murder Assault UrbanPop Rape
## 1         Alabama Más Inseguro   13.2     236       58 21.2
## 2          Alaska Más Inseguro   10.0     263       48 44.5
## 3         Arizona Más Inseguro    8.1     294       80 31.0
## 4        Arkansas       Seguro    8.8     190       50 19.5
## 5      California Más Inseguro    9.0     276       91 40.6
## 6        Colorado Más Inseguro    7.9     204       78 38.7
## 7     Connecticut     Inseguro    3.3     110       77 11.1
## 8        Delaware     Inseguro    5.9     238       72 15.8
## 9         Florida Más Inseguro   15.4     335       80 31.9
## 10        Georgia Más Inseguro   17.4     211       60 25.8
## 11         Hawaii     Inseguro    5.3      46       83 20.2
## 12          Idaho   Más Seguro    2.6     120       54 14.2
## 13       Illinois Más Inseguro   10.4     249       83 24.0
## 14        Indiana       Seguro    7.2     113       65 21.0
## 15           Iowa   Más Seguro    2.2      56       57 11.3
## 16         Kansas       Seguro    6.0     115       66 18.0
## 17       Kentucky       Seguro    9.7     109       52 16.3
## 18      Louisiana Más Inseguro   15.4     249       66 22.2
## 19          Maine   Más Seguro    2.1      83       51  7.8
## 20       Maryland Más Inseguro   11.3     300       67 27.8
## 21  Massachusetts     Inseguro    4.4     149       85 16.3
## 22       Michigan Más Inseguro   12.1     255       74 35.1
## 23      Minnesota   Más Seguro    2.7      72       66 14.9
## 24    Mississippi Más Inseguro   16.1     259       44 17.1
## 25       Missouri Más Inseguro    9.0     178       70 28.2
## 26        Montana       Seguro    6.0     109       53 16.4
## 27       Nebraska       Seguro    4.3     102       62 16.5
## 28         Nevada Más Inseguro   12.2     252       81 46.0
## 29  New Hampshire   Más Seguro    2.1      57       56  9.5
## 30     New Jersey     Inseguro    7.4     159       89 18.8
## 31     New Mexico Más Inseguro   11.4     285       70 32.1
## 32       New York Más Inseguro   11.1     254       86 26.1
## 33 North Carolina Más Inseguro   13.0     337       45 16.1
## 34   North Dakota   Más Seguro    0.8      45       44  7.3
## 35           Ohio     Inseguro    7.3     120       75 21.4
## 36       Oklahoma       Seguro    6.6     151       68 20.0
## 37         Oregon       Seguro    4.9     159       67 29.3
## 38   Pennsylvania     Inseguro    6.3     106       72 14.9
## 39   Rhode Island     Inseguro    3.4     174       87  8.3
## 40 South Carolina Más Inseguro   14.4     279       48 22.5
## 41   South Dakota   Más Seguro    3.8      86       45 12.8
## 42      Tennessee Más Inseguro   13.2     188       59 26.9
## 43          Texas Más Inseguro   12.7     201       80 25.5
## 44           Utah     Inseguro    3.2     120       80 22.9
## 45        Vermont   Más Seguro    2.2      48       32 11.2
## 46       Virginia       Seguro    8.5     156       63 20.7
## 47     Washington     Inseguro    4.0     145       73 26.2
## 48  West Virginia   Más Seguro    5.7      81       39  9.3
## 49      Wisconsin   Más Seguro    2.6      53       66 10.8
## 50        Wyoming       Seguro    6.8     161       60 15.6
## 
## $cuenta
##   cluster  n
## 1       1 10
## 2       2 10
## 3       3 10
## 4       4 20

Modelo ML

# Fijar semilla para reproducibilidad
set.seed(123)

# Dividir los datos en entrenamiento y prueba
r_train <- createDataPartition(asignacion$Seguridad, p=0.8, list=FALSE)
train <- asignacion[r_train, ]
test <- asignacion[-r_train, ]

# Guardar la variable 'State' antes de eliminarla
train_states <- train$State
test_states <- test$State

# Eliminar 'State' antes de entrenar el modelo
train <- train %>% select(-State)
test <- test %>% select(-State)

# Asegurar que 'Seguridad' en train y test sea factor con los mismos niveles
train$Seguridad <- as.factor(train$Seguridad)
test$Seguridad <- as.factor(test$Seguridad)

Entrenamiento

# Entrenar el modelo de red neuronal
modelo <- train(
  Seguridad ~ ., 
  data = train, 
  method = "nnet",  # Puedes cambiarlo a otro método si lo deseas
  preProcess = c("scale", "center"),
  trControl = trainControl(method = "cv", number = 10),  
  trace=FALSE
)

# Realizar predicciones en los conjuntos de entrenamiento y prueba
resultado_train <- predict(modelo, train)
resultado_test <- predict(modelo, test)

# Convertir las predicciones en factor con los mismos niveles que 'Seguridad'
resultado_train <- factor(resultado_train, levels = levels(train$Seguridad))
resultado_test <- factor(resultado_test, levels = levels(test$Seguridad))

Resultados

# Evaluar desempeño del modelo
mcf <- confusionMatrix(resultado_train, train$Seguridad)
print(mcf)

## Confusion Matrix and Statistics
## 
##               Reference
## Prediction     Inseguro Más Inseguro Más Seguro Seguro
##   Inseguro            8            0          0      0
##   Más Inseguro        0           16          0      0
##   Más Seguro          0            0          8      0
##   Seguro              0            0          0      8
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9119, 1)
##     No Information Rate : 0.4        
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: Inseguro Class: Más Inseguro Class: Más Seguro
## Sensitivity                      1.0                 1.0               1.0
## Specificity                      1.0                 1.0               1.0
## Pos Pred Value                   1.0                 1.0               1.0
## Neg Pred Value                   1.0                 1.0               1.0
## Prevalence                       0.2                 0.4               0.2
## Detection Rate                   0.2                 0.4               0.2
## Detection Prevalence             0.2                 0.4               0.2
## Balanced Accuracy                1.0                 1.0               1.0
##                      Class: Seguro
## Sensitivity                    1.0
## Specificity                    1.0
## Pos Pred Value                 1.0
## Neg Pred Value                 1.0
## Prevalence                     0.2
## Detection Rate                 0.2
## Detection Prevalence           0.2
## Balanced Accuracy              1.0

mcf2 <- confusionMatrix(resultado_test, test$Seguridad)
print(mcf2)

## Confusion Matrix and Statistics
## 
##               Reference
## Prediction     Inseguro Más Inseguro Más Seguro Seguro
##   Inseguro            2            0          0      0
##   Más Inseguro        0            4          0      0
##   Más Seguro          0            0          2      0
##   Seguro              0            0          0      2
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.6915, 1)
##     No Information Rate : 0.4        
##     P-Value [Acc > NIR] : 0.0001049  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: Inseguro Class: Más Inseguro Class: Más Seguro
## Sensitivity                      1.0                 1.0               1.0
## Specificity                      1.0                 1.0               1.0
## Pos Pred Value                   1.0                 1.0               1.0
## Neg Pred Value                   1.0                 1.0               1.0
## Prevalence                       0.2                 0.4               0.2
## Detection Rate                   0.2                 0.4               0.2
## Detection Prevalence             0.2                 0.4               0.2
## Balanced Accuracy                1.0                 1.0               1.0
##                      Class: Seguro
## Sensitivity                    1.0
## Specificity                    1.0
## Pos Pred Value                 1.0
## Neg Pred Value                 1.0
## Prevalence                     0.2
## Detection Rate                 0.2
## Detection Prevalence           0.2
## Balanced Accuracy              1.0

# Crear un dataframe con las predicciones y los estados originales
predicciones <- data.frame(State = test_states, Prediccion = resultado_test)

# Mostrar las primeras filas de las predicciones con los estados
head(predicciones)

##           State   Prediccion
## 1        Alaska Más Inseguro
## 2       Florida Más Inseguro
## 3 Massachusetts     Inseguro
## 4   Mississippi Más Inseguro
## 5 New Hampshire   Más Seguro
## 6    New Jersey     Inseguro

# Guardar el modelo pre-entrenado en un archivo RDS
saveRDS(modelo, file = "modelo.rds")