USArrests

Contexto

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 EE.UU en 1973.

Instalar Paquetes y llamar librerías

#install.packages("caret")#algoritmos de aprendizaje automatico
library(caret)
#install.packages("datasets")#para usar la base de datos "Iris"
library(datasets)
#install.packages("ggplot2") #gráficas con mejor diseño
library(ggplot2)
#install.packages("lattice") #Crear gráficos
library(lattice)
#install.packages("DataExplorer") #Análisis Descriptivo
library(DataExplorer)
#install.packages("kernlab") #métodos de aprendizaje automatico
library(kernlab)
#install.packages("randomForest")
library(randomForest)
#install.packages("cluster") # Para agrupamientos
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)
library(rnaturalearth)
library(rnaturalearthdata)
library(sf)

Importar base de datos

df <- data.frame(USArrests)

#create_report(df)
plot_missing(df)

plot_histogram(df)

plot_correlation(df)

datos_escalados <- df
datos_escalados <-scale(df)
datos_escalados <- subset(datos_escalados)

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

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

fviz_cluster(segmentos, data = df)

set.seed(123)
optimizacion <-clusGap(datos_escalados,FUN=kmeans,nstart=1,K.max=10)
plot(optimizacion, xlab="Número de clusters K", main= "Metodo de la silueta")

#el k optimo es el coeficiente de silueta maximo
fviz_nbclust(df,kmeans,method="wss") +
  ggtitle("Metodo del codo")

#el K óptimo es el coeficiente de la silueta del punto de inflación

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

##   Group.1   Murder   Assault UrbanPop     Rape cluster
## 1       1  3.60000  78.53846 52.07692 12.17692       1
## 2       2 10.81538 257.38462 76.00000 33.19231       2
## 3       3  5.65625 138.87500 73.87500 18.78125       3
## 4       4 13.93750 243.62500 53.75000 21.41250       4

table(asignacion$cluster)

## 
##  1  2  3  4 
## 13 13 16  8

asignacion$cluster <- as.factor(asignacion$cluster)

Partir los datos 80-20

set.seed(123)
renglones_entrenamiento <- createDataPartition(asignacion$cluster, p=0.8, list=FALSE) # el 80% de los datos iran a entrenamiento
entrenamiento <-asignacion[renglones_entrenamiento, ]
prueba <-asignacion[-renglones_entrenamiento, ] #le restamos los datos de entrenamiento

modelo1 <- train(cluster ~ ., data = asignacion, 
                 method="svmLinear", #cambiar
                 preProcess=c("scale","center"),
                 trControl = trainControl(method= "cv", number=10),
                 tuneGrid= data.frame(C=1) #cambiar hiperparámetros 
                 )

resultados_entrenamiento1 <-predict(modelo1,asignacion)
resultado_prueba1 <- predict(modelo1, prueba)

#Matriz de Confusión del Resultado del Entrenamiento 
mcre1 <- confusionMatrix(resultados_entrenamiento1, asignacion$cluster)
mcre1

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  1  2  3  4
##          1 13  0  0  0
##          2  0 13  0  0
##          3  0  0 16  0
##          4  0  0  0  8
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9289, 1)
##     No Information Rate : 0.32       
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: 1 Class: 2 Class: 3 Class: 4
## Sensitivity              1.00     1.00     1.00     1.00
## Specificity              1.00     1.00     1.00     1.00
## Pos Pred Value           1.00     1.00     1.00     1.00
## Neg Pred Value           1.00     1.00     1.00     1.00
## Prevalence               0.26     0.26     0.32     0.16
## Detection Rate           0.26     0.26     0.32     0.16
## Detection Prevalence     0.26     0.26     0.32     0.16
## Balanced Accuracy        1.00     1.00     1.00     1.00

#Matriz de Confusión del Resultado de la Prueba 
mcrp1 <- confusionMatrix(resultado_prueba1, prueba$cluster)
mcrp1

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 1 2 3 4
##          1 2 0 0 0
##          2 0 2 0 0
##          3 0 0 3 0
##          4 0 0 0 1
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.6306, 1)
##     No Information Rate : 0.375      
##     P-Value [Acc > NIR] : 0.0003911  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: 1 Class: 2 Class: 3 Class: 4
## Sensitivity              1.00     1.00    1.000    1.000
## Specificity              1.00     1.00    1.000    1.000
## Pos Pred Value           1.00     1.00    1.000    1.000
## Neg Pred Value           1.00     1.00    1.000    1.000
## Prevalence               0.25     0.25    0.375    0.125
## Detection Rate           0.25     0.25    0.375    0.125
## Detection Prevalence     0.25     0.25    0.375    0.125
## Balanced Accuracy        1.00     1.00    1.000    1.000