Neste documento, aplicamos uma Floresta Aleatória para prever o estado físico de vítimas em acidentes, usando uma base de dados com múltiplas variáveis categóricas e numéricas.
Dada a distribuição desbalanceada da variável dependente, utilizamos o método ROSE (Random Over-Sampling Examples) para gerar uma amostra de treino balanceada.
ROSE: Técnica que gera observações sintéticas da classe minoritária e reduz observações da classe majoritária de forma probabilística. Ao criar dados sintéticos e realizar undersampling proporcional, ROSE ajuda algoritmos de classificação a não se tornarem enviesados para a classe majoritária.
Lunardon, N., Menardi, G., & Torelli, N. (2014). ROSE: A Package for Binary Imbalanced Learning. R Journal, 6(1), 79–89. https://journal.r-project.org/archive/2014/RJ-2014-037/index.html
library(dplyr)
library(caret)
library(randomForest)
library(ROSE)
# Carregar base
database <- read.csv("DadosVítimas_v3.csv", header = TRUE, sep = ";")
database <- na.omit(database)
# Agrupar categorias da variável dependente: 1+2 → 1, 3+4 → 2
database$estado_fisico_bin <- ifelse(database$estado_fisico_ord %in% c(1,2), 1, 2)
database$estado_fisico_bin <- as.factor(database$estado_fisico_bin)
# Listar variáveis categóricas
fatores <- c("km_agrupado_132", "km_agrupado_136", "km_agrupado_488", "km_agrupado_490",
"km_agrupado_492", "km_agrupado_494", "km_agrupado_496", "km_agrupado_498",
"km_agrupado_500", "km_agrupado_502", "km_agrupado_504", "km_agrupado_506",
"km_agrupado_508", "km_agrupado_510", "km_agrupado_512", "km_agrupado_514",
"km_agrupado_516", "km_agrupado_518", "km_agrupado_520",
"categoria_veiculo_leve", "categoria_veiculo_moto", "categoria_veiculo_nao_motorizado",
"categoria_veiculo_outros", "categoria_veiculo_passageiros", "categoria_veiculo_pesado",
"idade_categoria_adolescente", "idade_categoria_adulto", "idade_categoria_crianca",
"idade_categoria_idoso", "idade_categoria_ignorado", "idade_categoria_jovem_adulto",
"fator_causal_ambiente", "fator_causal_humano", "fator_causal_outros",
"fator_causal_veicular", "fator_causal_via", "data_inversa", "sexo")
# Converter para factor
database[fatores] <- lapply(database[fatores], as.factor)
set.seed(200)
trainIndex <- createDataPartition(database$estado_fisico_bin, p = 0.8, list = FALSE)
Train <- database[trainIndex, ]
Valid <- database[-trainIndex, ]
cat("Distribuição original (treino):\n")
## Distribuição original (treino):
table(Train$estado_fisico_bin)
##
## 1 2
## 2662 374
Train_clean <- Train %>%
select(where(is.factor) | where(is.numeric)) %>%
mutate(estado_fisico_bin = Train$estado_fisico_bin)
# Garantir nomes únicos
names(Train_clean) <- make.names(names(Train_clean), unique = TRUE)
set.seed(123)
Train_rose <- ROSE(estado_fisico_bin ~ ., data = Train_clean, seed = 1)$data
cat("Distribuição após ROSE:\n")
## Distribuição após ROSE:
table(Train_rose$estado_fisico_bin)
##
## 1 2
## 1581 1455
set.seed(200)
modelFA_rose <- randomForest(
estado_fisico_bin ~ km_agrupado_132 + km_agrupado_136 + km_agrupado_488 + km_agrupado_490 + km_agrupado_492 + km_agrupado_494 + km_agrupado_496 + km_agrupado_498 + km_agrupado_500 + km_agrupado_502 + km_agrupado_504 + km_agrupado_506 + km_agrupado_508 + km_agrupado_510 + km_agrupado_512 + km_agrupado_514 + km_agrupado_516 + km_agrupado_518 + km_agrupado_520 + categoria_veiculo_leve + categoria_veiculo_moto + categoria_veiculo_nao_motorizado + categoria_veiculo_outros + categoria_veiculo_passageiros + categoria_veiculo_pesado + idade_categoria_adolescente + idade_categoria_adulto + idade_categoria_crianca + idade_categoria_idoso + idade_categoria_ignorado + idade_categoria_jovem_adulto + fator_causal_ambiente + fator_causal_humano + fator_causal_outros + fator_causal_veicular + fator_causal_via + data_inversa + sexo,
data = Train_rose,
ntree = 2000,
importance = TRUE
)
varImpPlot(modelFA_rose, main = "Floresta Aleatória - ROSE")
pred_train <- predict(modelFA_rose, Train_rose, type = "class")
conf_train <- confusionMatrix(pred_train, Train_rose$estado_fisico_bin)
conf_train
## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 2
## 1 1270 184
## 2 311 1271
##
## Accuracy : 0.837
## 95% CI : (0.8233, 0.8499)
## No Information Rate : 0.5208
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6745
##
## Mcnemar's Test P-Value : 1.485e-08
##
## Sensitivity : 0.8033
## Specificity : 0.8735
## Pos Pred Value : 0.8735
## Neg Pred Value : 0.8034
## Prevalence : 0.5208
## Detection Rate : 0.4183
## Detection Prevalence : 0.4789
## Balanced Accuracy : 0.8384
##
## 'Positive' Class : 1
##
pred_test <- predict(modelFA_rose, newdata = Valid, type = "class")
conf_test <- confusionMatrix(pred_test, Valid$estado_fisico_bin)
conf_test
## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 2
## 1 514 18
## 2 151 75
##
## Accuracy : 0.777
## 95% CI : (0.7457, 0.8062)
## No Information Rate : 0.8773
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.3587
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.7729
## Specificity : 0.8065
## Pos Pred Value : 0.9662
## Neg Pred Value : 0.3319
## Prevalence : 0.8773
## Detection Rate : 0.6781
## Detection Prevalence : 0.7018
## Balanced Accuracy : 0.7897
##
## 'Positive' Class : 1
##
O método ROSE permitiu balancear a base de treino, criando dados
sintéticos da classe minoritária e evitando que a Floresta Aleatória se
concentrasse na classe majoritária.
A avaliação na base de validação original mostra a capacidade do modelo
em generalizar para dados não balanceados.