USArrests

Teoría

La base de datos USArrests contiene estadísticas en arrestos por cada 100,000 residentes por agresión, asesinato y violación en cada uno de los 50 estados de US en 1973.

Instalar paquetes y llamara librerías

#install.packages("cluster")
library(cluster)
#install.packages("ggplot2")
library(ggplot2)
#install.packages("factoextra") # Visualizar Clusters
library(factoextra)

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

#install.packages("data.table") # Conjunto de datos grande
library(data.table)
#install.packages("tidyverse") # Conjunto de datos grande

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

Importar la base de datos

df <- USArrests

Escalar la base de datos

datos_escalados <- df 
datos_escalados <- scale(datos_escalados)

Generar los segmentos

grupos <- 4
segmentos <- kmeans(datos_escalados, grupos)

Asignar grupos a datos

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

Graficar los clusters

fviz_cluster(segmentos, data=df)

Optimizar la cantidad de grupos

set.seed(123)
optimizacion <- clusGap(datos_escalados, FUN=kmeans, nstart=1, K.max=10)
plot(optimizacion, 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 12.331579 259.31579 68.31579 29.21579       1
## 2       2  4.757143 123.42857 81.85714 16.07143       2
## 3       3  6.846154 149.00000 64.84615 20.65385       3
## 4       4  2.981818  73.63636 51.18182 11.40909       4

table(asignacion$cluster)

## 
##  1  2  3  4 
## 19  7 13 11

df2 <- df

Generar los segmentos

datos_escalados2 <- df2

datos_escalados2 <- scale(datos_escalados2)

grupos2 <- 2
segmentos2 <- kmeans(datos_escalados2, grupos2)

Asignar grupos a datos

asignacion2 <- cbind(df2, cluster2 = segmentos2$cluster)

Graficar los clusters

fviz_cluster(segmentos2, data=df2)

Optimizar la cantidad de grupos

set.seed(123)
optimizacion2 <- clusGap(datos_escalados2, FUN=kmeans, nstart=1, K.max=10)
plot(optimizacion2, xlab="Número de clusters k", main="Método de la Silueta")

#El k óptimo es el coeficiente de silueta más alto.

fviz_nbclust(df, kmeans, method="wss") + ggtitle("Método del codo")

#El k óptimo es el coeficiente de silueta del punto de inflexión.

Comparar segmentos

promedio2 <- aggregate(asignacion2, by=list(asignacion2$cluster2), FUN=mean)
promedio2

##   Group.1 Murder  Assault UrbanPop     Rape cluster2
## 1       1  4.870 114.4333 63.63333 15.94333        1
## 2       2 12.165 255.2500 68.40000 29.16500        2

table(asignacion2$cluster2)

## 
##  1  2 
## 30 20

asignacion2 <- asignacion2 %>%
  rename(clasificacion = cluster2) %>%
  mutate(clasificacion = ifelse(clasificacion == 1, "Seguro", "Inseguro"))

# Verificamos los cambios
head(asignacion2)

##            Murder Assault UrbanPop Rape clasificacion
## Alabama      13.2     236       58 21.2      Inseguro
## Alaska       10.0     263       48 44.5      Inseguro
## Arizona       8.1     294       80 31.0      Inseguro
## Arkansas      8.8     190       50 19.5        Seguro
## California    9.0     276       91 40.6      Inseguro
## Colorado      7.9     204       78 38.7      Inseguro

Cargar librerías

library(caret)
library(datasets)
library(ggplot2)
library(lattice)
library(DataExplorer)
library(kernlab)

Importar la base de datos

asignacion2$clasificacion <- as.factor(asignacion2$clasificacion)

Análisis Descriptivo

plot_missing(asignacion2)

plot_histogram(asignacion2)

plot_correlation(asignacion2)

Partir datos 80-20

set.seed(123)
renglones_entrenamiento <- createDataPartition(asignacion2$clasificacion, p=0.8, list=FALSE)
entrenamiento <- asignacion2[renglones_entrenamiento, ]
prueba <- asignacion2[-renglones_entrenamiento, ]

Modelo 1: SVM Lineal

modelo1 <- train(clasificacion ~ ., data=entrenamiento,
                 method = "svmLinear",
                 preProcess=c("scale", "center"),
                 trControl = trainControl(method = "cv", number=10),
                 tuneGrid = data.frame(C=1))

resultado_entrenamiento1 <- predict(modelo1, entrenamiento)
resultado_prueba1 <- predict(modelo1, prueba)

mcre1 <- confusionMatrix(resultado_entrenamiento1, entrenamiento$clasificacion)
mcrp1 <- confusionMatrix(resultado_prueba1, prueba$clasificacion)
mcre1

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro       16      0
##   Seguro          0     24
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9119, 1)
##     No Information Rate : 0.6        
##     P-Value [Acc > NIR] : 1.337e-09  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.4        
##          Detection Rate : 0.4        
##    Detection Prevalence : 0.4        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : Inseguro   
## 

mcrp1

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

Modelo 2: SVM Radial

modelo2 <- train(clasificacion ~ ., data=entrenamiento,
                 method = "svmRadial",
                 preProcess=c("scale", "center"),
                 trControl = trainControl(method = "cv", number=10),
                 tuneGrid = data.frame(sigma=1, C=1))

resultado_entrenamiento2 <- predict(modelo2, entrenamiento)
resultado_prueba2 <- predict(modelo2, prueba)

mcre2 <- confusionMatrix(resultado_entrenamiento2, entrenamiento$clasificacion)
mcrp2 <- confusionMatrix(resultado_prueba2, prueba$clasificacion)
mcre2

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro       16      0
##   Seguro          0     24
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9119, 1)
##     No Information Rate : 0.6        
##     P-Value [Acc > NIR] : 1.337e-09  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.4        
##          Detection Rate : 0.4        
##    Detection Prevalence : 0.4        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : Inseguro   
## 

mcrp2

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

Modelo 3: SVM Polynomial

modelo3 <- train(clasificacion ~ ., data=entrenamiento,
                 method = "svmPoly",
                 preProcess=c("scale", "center"),
                 trControl = trainControl(method = "cv", number=10),
                 tuneGrid = data.frame(degree=1, scale=1, C=1))

resultado_entrenamiento3 <- predict(modelo3, entrenamiento)
resultado_prueba3 <- predict(modelo3, prueba)

mcre3 <- confusionMatrix(resultado_entrenamiento3, entrenamiento$clasificacion)
mcrp3 <- confusionMatrix(resultado_prueba3, prueba$clasificacion)
mcre3

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro       16      0
##   Seguro          0     24
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9119, 1)
##     No Information Rate : 0.6        
##     P-Value [Acc > NIR] : 1.337e-09  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.4        
##          Detection Rate : 0.4        
##    Detection Prevalence : 0.4        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : Inseguro   
## 

mcrp3

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

Modelo 4: Árbol de decisión

modelo4 <- train(clasificacion ~ ., data=entrenamiento,
                 method = "rpart",
                 preProcess=c("scale", "center"),
                 trControl = trainControl(method = "cv", number=10),
                 tuneLength = 10)

resultado_entrenamiento4 <- predict(modelo4, entrenamiento)
resultado_prueba4 <- predict(modelo4, prueba)

mcre4 <- confusionMatrix(resultado_entrenamiento4, entrenamiento$clasificacion)
mcrp4 <- confusionMatrix(resultado_prueba4, prueba$clasificacion)
mcre4

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro       16      1
##   Seguro          0     23
##                                           
##                Accuracy : 0.975           
##                  95% CI : (0.8684, 0.9994)
##     No Information Rate : 0.6             
##     P-Value [Acc > NIR] : 3.698e-08       
##                                           
##                   Kappa : 0.9485          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 1.0000          
##             Specificity : 0.9583          
##          Pos Pred Value : 0.9412          
##          Neg Pred Value : 1.0000          
##              Prevalence : 0.4000          
##          Detection Rate : 0.4000          
##    Detection Prevalence : 0.4250          
##       Balanced Accuracy : 0.9792          
##                                           
##        'Positive' Class : Inseguro        
## 

mcrp4

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro        3      1
##   Seguro          1      5
##                                           
##                Accuracy : 0.8             
##                  95% CI : (0.4439, 0.9748)
##     No Information Rate : 0.6             
##     P-Value [Acc > NIR] : 0.1673          
##                                           
##                   Kappa : 0.5833          
##                                           
##  Mcnemar's Test P-Value : 1.0000          
##                                           
##             Sensitivity : 0.7500          
##             Specificity : 0.8333          
##          Pos Pred Value : 0.7500          
##          Neg Pred Value : 0.8333          
##              Prevalence : 0.4000          
##          Detection Rate : 0.3000          
##    Detection Prevalence : 0.4000          
##       Balanced Accuracy : 0.7917          
##                                           
##        'Positive' Class : Inseguro        
## 

Modelo 5: Redes Neuronales

modelo5 <- train(clasificacion ~ ., data=entrenamiento,
                 method = "nnet",
                 preProcess=c("scale", "center"),
                 trControl = trainControl(method = "cv", number=10),
                 trace=FALSE)

resultado_entrenamiento5 <- predict(modelo5, entrenamiento)
resultado_prueba5 <- predict(modelo5, prueba)

mcre5 <- confusionMatrix(resultado_entrenamiento5, entrenamiento$clasificacion)
mcrp5 <- confusionMatrix(resultado_prueba5, prueba$clasificacion)
mcre5

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro       16      0
##   Seguro          0     24
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9119, 1)
##     No Information Rate : 0.6        
##     P-Value [Acc > NIR] : 1.337e-09  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.4        
##          Detection Rate : 0.4        
##    Detection Prevalence : 0.4        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : Inseguro   
## 

mcrp5

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

Modelo 6: Bosques Aleatorios

modelo6 <- train(clasificacion ~ ., data=entrenamiento,
                 method = "rf",
                 preProcess=c("scale", "center"),
                 trControl = trainControl(method = "cv", number=10),
                 tuneGrid = expand.grid(mtry = c(2,4,6)))

resultado_entrenamiento6 <- predict(modelo6, entrenamiento)
resultado_prueba6 <- predict(modelo6, prueba)

mcre6 <- confusionMatrix(resultado_entrenamiento6, entrenamiento$clasificacion)
mcrp6 <- confusionMatrix(resultado_prueba6, prueba$clasificacion)
mcre6

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro       16      0
##   Seguro          0     24
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9119, 1)
##     No Information Rate : 0.6        
##     P-Value [Acc > NIR] : 1.337e-09  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.4        
##          Detection Rate : 0.4        
##    Detection Prevalence : 0.4        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : Inseguro   
## 

mcrp6

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Inseguro Seguro
##   Inseguro        4      1
##   Seguro          0      5
##                                          
##                Accuracy : 0.9            
##                  95% CI : (0.555, 0.9975)
##     No Information Rate : 0.6            
##     P-Value [Acc > NIR] : 0.04636        
##                                          
##                   Kappa : 0.8            
##                                          
##  Mcnemar's Test P-Value : 1.00000        
##                                          
##             Sensitivity : 1.0000         
##             Specificity : 0.8333         
##          Pos Pred Value : 0.8000         
##          Neg Pred Value : 1.0000         
##              Prevalence : 0.4000         
##          Detection Rate : 0.4000         
##    Detection Prevalence : 0.5000         
##       Balanced Accuracy : 0.9167         
##                                          
##        'Positive' Class : Inseguro       
## 

Resumen de resultados

resultados <- data.frame(
  "SVM Lineal" = c(mcre1$overall["Accuracy"], mcrp1$overall["Accuracy"]),
  "SVM Radial" = c(mcre2$overall["Accuracy"], mcrp2$overall["Accuracy"]),
  "SVM Polynomial" = c(mcre3$overall["Accuracy"], mcrp3$overall["Accuracy"]),
  "Árbol de decisión" = c(mcre4$overall["Accuracy"], mcrp4$overall["Accuracy"]),
  "Redes Neuronales" = c(mcre5$overall["Accuracy"], mcrp5$overall["Accuracy"]),
  "Bosques Aleatorios" = c(mcre6$overall["Accuracy"], mcrp6$overall["Accuracy"])
)
rownames(resultados) <- c("Precisión de Entrenamiento", "Precisión de Prueba")
resultados

##                            SVM.Lineal SVM.Radial SVM.Polynomial
## Precisión de Entrenamiento          1          1              1
## Precisión de Prueba                 1          1              1
##                            Árbol.de.decisión Redes.Neuronales
## Precisión de Entrenamiento             0.975                1
## Precisión de Prueba                    0.800                1
##                            Bosques.Aleatorios
## Precisión de Entrenamiento                1.0
## Precisión de Prueba                       0.9