Accidentes Tránsito

Contexto

Este análisis explora los patrones de los accidentes de tránsito en México, reduciendo las variables numéricas con PCA y agrupándolas con clustering para identificar tendencias clave en días, condiciones y severidad.

Paso 1. Instalar paquetes y llamar librerías

# install.packages("cluster")  #Analisis de Agrupamiento
library(cluster)
# install.packages("ggplot2") #Graficar
library(ggplot2)
# install.packages("data.table") #Manejo de muchos datos
library(data.table)
# install.packages("factoextra") #Gráfica optimización de numeros cluster
library(factoextra)

Paso 2. Obtener los datos

accidentes <- read.csv("/Users/mariajoseflores/Downloads/sct_70_accidentes_dia.csv")

Paso 3. Entender los datos

# Paso 3. Entender los datos
summary(accidentes)

##  entidad_federativa  accidentes            lunes            martes      
##  Length:64          Length:64          Min.   :  1.00   Min.   :  1.00  
##  Class :character   Class :character   1st Qu.:  7.75   1st Qu.:  6.00  
##  Mode  :character   Mode  :character   Median : 21.00   Median : 19.00  
##                                        Mean   : 31.02   Mean   : 25.16  
##                                        3rd Qu.: 45.00   3rd Qu.: 35.50  
##                                        Max.   :176.00   Max.   :156.00  
##    miercoles          jueves          viernes           sabado      
##  Min.   :  0.00   Min.   :  0.00   Min.   :  1.00   Min.   :  0.00  
##  1st Qu.:  6.00   1st Qu.:  6.00   1st Qu.:  7.00   1st Qu.: 10.75  
##  Median : 16.00   Median : 16.00   Median : 21.00   Median : 26.00  
##  Mean   : 25.34   Mean   : 28.06   Mean   : 30.27   Mean   : 38.89  
##  3rd Qu.: 37.75   3rd Qu.: 38.75   3rd Qu.: 45.50   3rd Qu.: 59.25  
##  Max.   :184.00   Max.   :169.00   Max.   :190.00   Max.   :207.00  
##     domingo          luz_dia       luz_crepusculo     luz_noche     
##  Min.   :  3.00   Min.   :  4.00   Min.   : 0.000   Min.   :  7.00  
##  1st Qu.: 11.75   1st Qu.: 32.75   1st Qu.: 2.000   1st Qu.: 23.00  
##  Median : 29.50   Median : 78.00   Median : 5.000   Median : 69.50  
##  Mean   : 41.20   Mean   :116.92   Mean   : 8.203   Mean   : 93.98  
##  3rd Qu.: 64.75   3rd Qu.:165.75   3rd Qu.:13.250   3rd Qu.:141.25  
##  Max.   :208.00   Max.   :704.00   Max.   :32.000   Max.   :552.00  
##  luz_alumbrado_publico
##  Min.   :0.0000       
##  1st Qu.:0.0000       
##  Median :0.0000       
##  Mean   :0.8281       
##  3rd Qu.:1.0000       
##  Max.   :8.0000

str(accidentes)

## 'data.frame':    64 obs. of  13 variables:
##  $ entidad_federativa   : chr  "Aguascalientes" "Aguascalientes" "Baja California" "Baja California" ...
##  $ accidentes           : chr  "accidentes" "accidentes mortales" "accidentes" "accidentes mortales" ...
##  $ lunes                : num  34 6 50 8 18 6 27 1 100 13 ...
##  $ martes               : num  20 4 37 6 29 6 32 5 80 7 ...
##  $ miercoles            : num  16 5 36 6 23 5 29 4 96 16 ...
##  $ jueves               : num  23 2 41 6 19 4 17 3 107 12 ...
##  $ viernes              : num  20 3 55 8 35 6 29 1 90 12 ...
##  $ sabado               : num  33 8 75 14 35 9 24 4 108 9 ...
##  $ domingo              : num  33 8 83 16 42 6 37 8 95 10 ...
##  $ luz_dia              : num  91 13 207 37 102 19 98 11 358 36 ...
##  $ luz_crepusculo       : num  4 0 15 5 13 3 3 1 23 2 ...
##  $ luz_noche            : num  84 23 151 22 78 19 94 14 294 41 ...
##  $ luz_alumbrado_publico: num  0 0 4 0 8 1 0 0 1 0 ...

Paso 4. Escalar los datos

# Seleccionar solo las columnas numéricas
num_cols_log <- sapply(accidentes, is.numeric)
accidentes_num <- accidentes[, num_cols_log, drop = FALSE]

# Manejo de NA
accidentes_num <- na.omit(accidentes_num)

# Escalar los datos
datos_escalados <- scale(accidentes_num)

# ---- GRAFICA ÚNICA: PCA (PC1 vs PC2) ----
pca <- prcomp(datos_escalados, scale. = TRUE)

pca_df <- data.frame(PC1 = pca$x[,1],
                     PC2 = pca$x[,2])

ggplot(pca_df, aes(PC1, PC2)) +
  geom_point(alpha = 0.6, color = "steelblue") +
  labs(title = "Accidentes - Proyección PCA",
       x = "Componente Principal 1",
       y = "Componente Principal 2") +
  theme_minimal()

Paso 6. Generar los grupos

grupos1 <-3
clusters1 <- kmeans(datos_escalados, grupos1)
clusters1

## K-means clustering with 3 clusters of sizes 5, 17, 42
## 
## Cluster means:
##        lunes     martes  miercoles     jueves    viernes     sabado    domingo
## 1  2.3087830  2.4826763  2.5122909  2.4842891  2.4773887  2.3827179  2.1765817
## 2  0.6993969  0.5690535  0.5231419  0.5994074  0.5842939  0.6997532  0.7800705
## 3 -0.5579443 -0.5258879 -0.5108302 -0.5383660 -0.5314271 -0.5668904 -0.5748597
##      luz_dia luz_crepusculo  luz_noche luz_alumbrado_publico
## 1  2.3888862      2.3499250  2.4501987             0.8186018
## 2  0.6574690      0.7379218  0.6275231             0.6953300
## 3 -0.5505096     -0.5784356 -0.5456877            -0.3788957
## 
## Clustering vector:
##  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
##  3  3  2  3  2  3  3  3  1  3  2  3  3  3  3  3  3  3  3  3  1  3  1  3  2  3 
## 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
##  2  3  2  3  2  3  3  3  3  3  1  3  2  3  2  3  2  3  3  3  2  3  2  3  2  3 
## 53 54 55 56 57 58 59 60 61 62 63 64 
##  2  3  2  3  2  3  1  3  3  3  2  3 
## 
## Within cluster sum of squares by cluster:
## [1] 70.97948 66.83573 50.07200
##  (between_SS / total_SS =  72.9 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Paso 7. Optimizar números los grupos

set.seed(123)
optimizacion <- clusGap(accidentes_num, FUN=kmeans, nstar= 1, K.max=10)
# El K.max normalmente es 10. en este ejercicio al ser 8 datos se dejó en 7
plot(optimizacion, xlab= "Número clusters k")

# Se selecciona como óptimo de clusters

Paso 8. Graficar los grupos

fviz_cluster(clusters1, data=datos_escalados)

# Paso 9. Agregar clusters a la base de dsatos

accidentes_num <- cbind(accidentes_num, clusters1$cluster)
head(accidentes_num)

##   lunes martes miercoles jueves viernes sabado domingo luz_dia luz_crepusculo
## 1    34     20        16     23      20     33      33      91              4
## 2     6      4         5      2       3      8       8      13              0
## 3    50     37        36     41      55     75      83     207             15
## 4     8      6         6      6       8     14      16      37              5
## 5    18     29        23     19      35     35      42     102             13
## 6     6      6         5      4       6      9       6      19              3
##   luz_noche luz_alumbrado_publico clusters1$cluster
## 1        84                     0                 3
## 2        23                     0                 3
## 3       151                     4                 2
## 4        22                     0                 3
## 5        78                     8                 2
## 6        19                     1                 3