Arvores de Regressão - Random Forest
Bibliotecas
Avaliando, selecionando dados
Treino e Teste com todas as variáveis
## Vamos criar os conjuntos de treino teste e desenvolver a arvore
## com todas as variáveis.
library(caret)
set.seed(2025)
indice <- createDataPartition(dados$medv, times=1, p=0.75, list=FALSE)
conj_treino <- dados[indice,]
conj_teste <- dados[-indice,]
head(conj_treino) crim zn indus chas nox rm age dis rad tax ptratio black lstat
2 0.02731 0.0 7.07 0 0.469 6.421 78.9 4.9671 2 242 17.8 396.90 9.14
6 0.02985 0.0 2.18 0 0.458 6.430 58.7 6.0622 3 222 18.7 394.12 5.21
7 0.08829 12.5 7.87 0 0.524 6.012 66.6 5.5605 5 311 15.2 395.60 12.43
8 0.14455 12.5 7.87 0 0.524 6.172 96.1 5.9505 5 311 15.2 396.90 19.15
10 0.17004 12.5 7.87 0 0.524 6.004 85.9 6.5921 5 311 15.2 386.71 17.10
11 0.22489 12.5 7.87 0 0.524 6.377 94.3 6.3467 5 311 15.2 392.52 20.45
medv
2 21.6
6 28.7
7 22.9
8 27.1
10 18.9
11 15.0head(conj_teste) crim zn indus chas nox rm age dis rad tax ptratio black
1 0.00632 18.0 2.31 0 0.538 6.575 65.2 4.0900 1 296 15.3 396.90
3 0.02729 0.0 7.07 0 0.469 7.185 61.1 4.9671 2 242 17.8 392.83
4 0.03237 0.0 2.18 0 0.458 6.998 45.8 6.0622 3 222 18.7 394.63
5 0.06905 0.0 2.18 0 0.458 7.147 54.2 6.0622 3 222 18.7 396.90
9 0.21124 12.5 7.87 0 0.524 5.631 100.0 6.0821 5 311 15.2 386.63
19 0.80271 0.0 8.14 0 0.538 5.456 36.6 3.7965 4 307 21.0 288.99
lstat medv
1 4.98 24.0
3 4.03 34.7
4 2.94 33.4
5 5.33 36.2
9 29.93 16.5
19 11.69 20.2Criando um grid de parametros
grid_params <- expand.grid(
mtry = c(2, 4, 6),
min.node.size = c(1, 5),
splitrule = c("variance", "extratrees"),
num.trees = c(100)
)
nrow(grid_params)[1] 12head(grid_params) mtry min.node.size splitrule num.trees
1 2 1 variance 100
2 4 1 variance 100
3 6 1 variance 100
4 2 5 variance 100
5 4 5 variance 100
6 6 5 variance 100Validação cruzada com rsample
Ajuste do modelo Random Forest com cada combinação
avaliacoes <- grid_params %>%
mutate(
media_rmse = pmap_dbl(list(mtry, min.node.size, splitrule, num.trees),
function(mtry, min.node.size, splitrule, num.trees) {
rmse_fold <- map_dbl(folds$splits, function(split) {
treino <- analysis(split)
teste <- assessment(split)
modelo <- ranger(
medv ~ .,
data = treino,
mtry = mtry,
min.node.size = min.node.size,
splitrule = splitrule,
num.trees = num.trees,
seed = 2025
)
pred <- predict(modelo, data = teste)$predictions
metric <- yardstick::rmse_vec(truth = teste$medv, estimate = pred)
return(metric)
})
mean(rmse_fold)
}
)
)
avaliacoes %>% arrange(media_rmse) %>% head() mtry min.node.size splitrule num.trees media_rmse
1 6 1 variance 100 3.140727
2 6 5 variance 100 3.174609
3 4 1 variance 100 3.177201
4 6 1 extratrees 100 3.192652
5 4 5 variance 100 3.235676
6 4 1 extratrees 100 3.249829Melhor combinação de parâmetros
Ajuste do modelo final
modelo_final <- ranger(
medv ~ .,
data = conj_treino,
mtry = melhor_param$mtry,
min.node.size = melhor_param$min.node.size,
splitrule = melhor_param$splitrule,
num.trees = melhor_param$num.trees,
seed = 2025,
importance = "permutation"
)
modelo_finalRanger result
Call:
ranger(medv ~ ., data = conj_treino, mtry = melhor_param$mtry, min.node.size = melhor_param$min.node.size, splitrule = melhor_param$splitrule, num.trees = melhor_param$num.trees, seed = 2025, importance = "permutation")
Type: Regression
Number of trees: 100
Sample size: 381
Number of independent variables: 13
Mtry: 6
Target node size: 1
Variable importance mode: permutation
Splitrule: 1
OOB prediction error (MSE): 10.99587
R squared (OOB): 0.8584414 Avaliação no conjunto de teste
pred <- predict(modelo_final, data = conj_teste)$predictions
# Métricas de desempenho
postResample(pred, conj_teste$medv) RMSE Rsquared MAE
3.2494760 0.9077779 2.3676144 Importância das variáveis
# Converter a importância em tibble ordenada
df_importancia <- importance(modelo_final) %>%
enframe(name = "Variável", value = "Importância") %>%
arrange(desc(Importância))
# Gráfico de barras da importância das variáveis
ggplot(df_importancia, aes(x = reorder(Variável, Importância), y = Importância)) +
geom_col(fill = "steelblue") +
coord_flip() +
labs(title = "Importância das Variáveis (Permutação)",
x = "Variável",
y = "Importância") +
theme_minimal()
Comparação com outro modelo (Regressão Linear)
ctrl <- trainControl(method = "cv", number = 5)
model_lm <- train(
medv ~ ., data = conj_treino,
method = "lm",
trControl = ctrl
)
pred_lm <- predict(model_lm, newdata = conj_teste)
postResample(pred_lm, conj_teste$medv) RMSE Rsquared MAE
5.5535662 0.7120235 3.8617314 Grafico de comparação
# Gráfico de comparação
ggplot() +
geom_point(aes(x = conj_teste$medv, y = pred), color = "blue", alpha = 0.5) +
geom_point(aes(x = conj_teste$medv, y = pred_lm), color = "red", alpha = 0.5) +
labs(title = "Comparação de Previsões: Random Forest (azul) vs Regressão Linear (vermelho)", x = "Valores Reais (medv)", y = "Previsões") +
theme_minimal()
Analisando com o LIME
# Treinamento com ranger precisa ser refeito em formato compatível com lime
library(lime)
# Treinando modelo com train() + ranger para compatibilidade com LIME
set.seed(2025)
tune_grid <- data.frame(
mtry = melhor_param$mtry,
splitrule = as.character(melhor_param$splitrule),
min.node.size = melhor_param$min.node.size
)
modelo_caret <- train(
medv ~ .,
data = conj_treino,
method = "ranger",
trControl = trainControl(method = "none"),
tuneGrid = tune_grid
)
# Preparar explicador LIME
explainer <- lime(conj_treino, modelo_caret, bin_continuous = FALSE)
# Aplicar LIME a 3 observações novas
explicacoes <- explain(
conj_teste[1:3, ],
explainer = explainer,
n_features = 6,
n_labels = 1
)
# Dados Analisados
conj_teste[1:3, c("medv", "lstat","rm", "nox","crim", "dis", "age", "indus", "ptratio", "tax")] medv lstat rm nox crim dis age indus ptratio tax
1 24.0 4.98 6.575 0.538 0.00632 4.0900 65.2 2.31 15.3 296
3 34.7 4.03 7.185 0.469 0.02729 4.9671 61.1 7.07 17.8 242
4 33.4 2.94 6.998 0.458 0.03237 6.0622 45.8 2.18 18.7 222# Visualizar explicações
plot_features(explicacoes)