USArrests
Rodrigo Angulo
2025-02-21
Contexto
La base de datos USArrests contiene estadisticas en arrestos por cada 100,000 residentes por agresion, asesinato y violacion en cada uno de los 50 estados de EE.UU en 1973.
Llamar librerias e instalar paquetes
#install.packages("cluster") #para agrupar
library(cluster)
#install.packages("ggplot2") #para graficar
library(ggplot2)
#install.packages("factoextra") #Visualizar Clusters
library(factoextra)
#install.packages("data.table") #conjunto de datos grandes
library(data.table)
#install.packages("tidyverse")
library(tidyverse)
#install.packages("caret") #algoritmo de aprendizaje automatico
library(caret)
#install.packages("ggplot2") #graficas con mejor diseño
library(ggplot2)
#install.packages("lattice") #crear graficas
library(lattice)
#install.packages("DataExplorer") #analisis descriptivo
library(DataExplorer)
#install.packages("kernlab")
library(kernlab)Importar la base de datos
df <- USArrestseliminar urbanpop
datosnew <- df
datosnew <- subset(datosnew, select= -UrbanPop)
datosnew <- scale(datosnew)genera los segmentos
grupos <- 3
segmentos <- kmeans(datosnew, grupos)Asignar los grupos a los datos
asignacion <- cbind(datosnew, cluster = segmentos$cluster)Graficar los clusters
fviz_cluster(segmentos, data = datosnew)
set.seed(123)
optimizacion <- clusGap(datosnew, FUN=kmeans, nstart=1, K.max=7)
plot(optimizacion, xlab="Número de clusters k", main="Metodo de la silueta") #El k optimo es el coeficiente de silueta maximo
fviz_nbclust(datosnew, kmeans, method = "wss") + ggtitle("Método del codo") #el k optimo es el coeficiente del punto de inflexion
promedio <- aggregate(cbind(Murder, Assault, Rape) ~ cluster, data=asignacion, FUN=mean)
promedio## cluster Murder Assault Rape
## 1 1 -0.2754591 -0.299928 -0.1233698
## 2 2 -1.0812577 -1.077921 -1.0070054
## 3 3 1.0431796 1.062614 0.8523875df$Seguridad <- factor(segmentos$cluster, levels = c(1,2,3), labels = c("Seguro", "Medio Seguro", "Inseguro"))set.seed(123)
renglones_entrenamiento <- createDataPartition(df$Seguridad, p=0.8, list=FALSE)
entrenamiento <- df[renglones_entrenamiento, ]
prueba <- df[-renglones_entrenamiento, ]#SVMlinear
control <- trainControl(method="cv", number=10)
modelo1 <- train(Seguridad ~ ., data=entrenamiento,
method="svmLinear",
preProcess=c("scale","center"),
trControl=control,
tuneGrid = data.frame(C=1)
)
resultado_entrenamiento1 <- predict(modelo1, entrenamiento)
resultado_prueba1 <- predict(modelo1, prueba)
mcre1 <- confusionMatrix(resultado_entrenamiento1, entrenamiento$Seguridad)
mcrp1 <- confusionMatrix(resultado_prueba1, prueba$Seguridad)
mcre1## Confusion Matrix and Statistics
##
## Reference
## Prediction Seguro Medio Seguro Inseguro
## Seguro 14 1 0
## Medio Seguro 0 11 0
## Inseguro 0 0 16
##
## Overall Statistics
##
## Accuracy : 0.9762
## 95% CI : (0.8743, 0.9994)
## No Information Rate : 0.381
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.964
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Seguro Class: Medio Seguro Class: Inseguro
## Sensitivity 1.0000 0.9167 1.000
## Specificity 0.9643 1.0000 1.000
## Pos Pred Value 0.9333 1.0000 1.000
## Neg Pred Value 1.0000 0.9677 1.000
## Prevalence 0.3333 0.2857 0.381
## Detection Rate 0.3333 0.2619 0.381
## Detection Prevalence 0.3571 0.2619 0.381
## Balanced Accuracy 0.9821 0.9583 1.000mcrp1## Confusion Matrix and Statistics
##
## Reference
## Prediction Seguro Medio Seguro Inseguro
## Seguro 2 0 0
## Medio Seguro 0 2 0
## Inseguro 1 0 3
##
## Overall Statistics
##
## Accuracy : 0.875
## 95% CI : (0.4735, 0.9968)
## No Information Rate : 0.375
## P-Value [Acc > NIR] : 0.005605
##
## Kappa : 0.8095
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Seguro Class: Medio Seguro Class: Inseguro
## Sensitivity 0.6667 1.00 1.000
## Specificity 1.0000 1.00 0.800
## Pos Pred Value 1.0000 1.00 0.750
## Neg Pred Value 0.8333 1.00 1.000
## Prevalence 0.3750 0.25 0.375
## Detection Rate 0.2500 0.25 0.375
## Detection Prevalence 0.2500 0.25 0.500
## Balanced Accuracy 0.8333 1.00 0.900#Arboles de decision
control <- trainControl(method="cv", number=10)
grid <- expand.grid(cp = seq(0.001, 0.02, by = 0.001))
# Entrenar el modelo de Árbol de Decisión con hiperparámetros optimizados
modelo_arbol <- train(Seguridad ~ ., data=entrenamiento,
method="rpart",
preProcess=c("scale","center"),
trControl = control,
tuneGrid = grid)
resultado_entrenamiento_arbol <- predict(modelo_arbol, entrenamiento)
resultado_prueba_arbol <- predict(modelo_arbol, prueba)
mcre_arbol <- confusionMatrix(resultado_entrenamiento_arbol, entrenamiento$Seguridad)
mcrp_arbol <- confusionMatrix(resultado_prueba_arbol, prueba$Seguridad)
mcre_arbol## Confusion Matrix and Statistics
##
## Reference
## Prediction Seguro Medio Seguro Inseguro
## Seguro 12 1 0
## Medio Seguro 0 11 0
## Inseguro 2 0 16
##
## Overall Statistics
##
## Accuracy : 0.9286
## 95% CI : (0.8052, 0.985)
## No Information Rate : 0.381
## P-Value [Acc > NIR] : 1.286e-13
##
## Kappa : 0.8916
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Seguro Class: Medio Seguro Class: Inseguro
## Sensitivity 0.8571 0.9167 1.0000
## Specificity 0.9643 1.0000 0.9231
## Pos Pred Value 0.9231 1.0000 0.8889
## Neg Pred Value 0.9310 0.9677 1.0000
## Prevalence 0.3333 0.2857 0.3810
## Detection Rate 0.2857 0.2619 0.3810
## Detection Prevalence 0.3095 0.2619 0.4286
## Balanced Accuracy 0.9107 0.9583 0.9615mcrp_arbol## Confusion Matrix and Statistics
##
## Reference
## Prediction Seguro Medio Seguro Inseguro
## Seguro 2 1 0
## Medio Seguro 1 1 0
## Inseguro 0 0 3
##
## Overall Statistics
##
## Accuracy : 0.75
## 95% CI : (0.3491, 0.9681)
## No Information Rate : 0.375
## P-Value [Acc > NIR] : 0.03602
##
## Kappa : 0.619
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Seguro Class: Medio Seguro Class: Inseguro
## Sensitivity 0.6667 0.5000 1.000
## Specificity 0.8000 0.8333 1.000
## Pos Pred Value 0.6667 0.5000 1.000
## Neg Pred Value 0.8000 0.8333 1.000
## Prevalence 0.3750 0.2500 0.375
## Detection Rate 0.2500 0.1250 0.375
## Detection Prevalence 0.3750 0.2500 0.375
## Balanced Accuracy 0.7333 0.6667 1.000#Redes neuronales
control <- trainControl(method="cv", number=10)
modelo_nn <- train(Seguridad ~ ., data=entrenamiento,
method = "nnet",
preProcess = c("scale", "center"),
trControl = control,
tuneLength = 10,
trace = FALSE)
resultado_entrenamiento_nn <- predict(modelo_nn, entrenamiento)
resultado_prueba_nn <- predict(modelo_nn, prueba)
mcre_nn <- confusionMatrix(resultado_entrenamiento_nn, entrenamiento$Seguridad)
mcrp_nn <- confusionMatrix(resultado_prueba_nn, prueba$Seguridad)
mcre_nn## Confusion Matrix and Statistics
##
## Reference
## Prediction Seguro Medio Seguro Inseguro
## Seguro 14 0 0
## Medio Seguro 0 12 0
## Inseguro 0 0 16
##
## Overall Statistics
##
## Accuracy : 1
## 95% CI : (0.9159, 1)
## No Information Rate : 0.381
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Seguro Class: Medio Seguro Class: Inseguro
## Sensitivity 1.0000 1.0000 1.000
## Specificity 1.0000 1.0000 1.000
## Pos Pred Value 1.0000 1.0000 1.000
## Neg Pred Value 1.0000 1.0000 1.000
## Prevalence 0.3333 0.2857 0.381
## Detection Rate 0.3333 0.2857 0.381
## Detection Prevalence 0.3333 0.2857 0.381
## Balanced Accuracy 1.0000 1.0000 1.000mcrp_nn## Confusion Matrix and Statistics
##
## Reference
## Prediction Seguro Medio Seguro Inseguro
## Seguro 2 0 0
## Medio Seguro 0 2 0
## Inseguro 1 0 3
##
## Overall Statistics
##
## Accuracy : 0.875
## 95% CI : (0.4735, 0.9968)
## No Information Rate : 0.375
## P-Value [Acc > NIR] : 0.005605
##
## Kappa : 0.8095
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Seguro Class: Medio Seguro Class: Inseguro
## Sensitivity 0.6667 1.00 1.000
## Specificity 1.0000 1.00 0.800
## Pos Pred Value 1.0000 1.00 0.750
## Neg Pred Value 0.8333 1.00 1.000
## Prevalence 0.3750 0.25 0.375
## Detection Rate 0.2500 0.25 0.375
## Detection Prevalence 0.2500 0.25 0.500
## Balanced Accuracy 0.8333 1.00 0.900