Arvores de Regressão - Random Forest

Author

Ricardo Accioly

Published

June 3, 2025

Bibliotecas

Avaliando, selecionando dados

data("Boston")
names(Boston)
 [1] "crim"    "zn"      "indus"   "chas"    "nox"     "rm"      "age"    
 [8] "dis"     "rad"     "tax"     "ptratio" "black"   "lstat"   "medv"   
dados <- Boston 

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(21)
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
1 0.00632 18.0  2.31    0 0.538 6.575 65.2 4.0900   1 296    15.3 396.90  4.98
3 0.02729  0.0  7.07    0 0.469 7.185 61.1 4.9671   2 242    17.8 392.83  4.03
4 0.03237  0.0  2.18    0 0.458 6.998 45.8 6.0622   3 222    18.7 394.63  2.94
5 0.06905  0.0  2.18    0 0.458 7.147 54.2 6.0622   3 222    18.7 396.90  5.33
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
  medv
1 24.0
3 34.7
4 33.4
5 36.2
6 28.7
7 22.9
head(conj_teste)
      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
10 0.17004 12.5  7.87    0 0.524 6.004 85.9 6.5921   5 311    15.2 386.71 17.10
12 0.11747 12.5  7.87    0 0.524 6.009 82.9 6.2267   5 311    15.2 396.90 13.27
16 0.62739  0.0  8.14    0 0.538 5.834 56.5 4.4986   4 307    21.0 395.62  8.47
19 0.80271  0.0  8.14    0 0.538 5.456 36.6 3.7965   4 307    21.0 288.99 11.69
23 1.23247  0.0  8.14    0 0.538 6.142 91.7 3.9769   4 307    21.0 396.90 18.72
   medv
2  21.6
10 18.9
12 18.9
16 19.9
19 20.2
23 15.2

Criando 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] 12
head(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       100

Validação cruzada com rsample

set.seed(2025)
folds <- vfold_cv(Boston, v = 5)

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 = 123
          )
          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.138929
2    6             5   variance       100   3.180183
3    4             1   variance       100   3.182037
4    6             1 extratrees       100   3.223310
5    4             5   variance       100   3.223342
6    6             5 extratrees       100   3.292367

Melhor combinação de parâmetros

melhor_param <- avaliacoes %>% arrange(media_rmse) %>% slice(1)
melhor_param
  mtry min.node.size splitrule num.trees media_rmse
1    6             1  variance       100   3.138929

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_final
Ranger 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):       12.75977 
R squared (OOB):                  0.8445772 

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 
4.0052763 0.8341371 2.2677500 

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.9426142 0.6315418 3.9610503 

Grafico de comparação

# Gráfico de comparação
graf_comparacao <- 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 vs Regressão Linear",
       x = "Valores Reais (medv)", y = "Previsões") +
  theme_minimal()
graf_comparacao

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 = 5,
  n_labels = 1
)

# Dados Analisados
conj_teste[1:3, c("medv", "rm", "ptratio", "nox", "dis", "lstat", "tax")]
   medv    rm ptratio   nox    dis lstat tax
2  21.6 6.421    17.8 0.469 4.9671  9.14 242
10 18.9 6.004    15.2 0.524 6.5921 17.10 311
12 18.9 6.009    15.2 0.524 6.2267 13.27 311
# Visualizar explicações
plot_features(explicacoes)