Introdução

Esta análise utiliza o conjunto de dados Pinguins estendido. Temos como objetivo da análise: prever o sexo dos pinguins. Utilizaremos o método de classificação

Preparação dos Dados

# Carregar os dados
data("penguins")

# Inspecionar os dados
glimpse(penguins)

## Rows: 344
## Columns: 7
## $ species           <fct> Adelie, Adelie, Adelie, Adelie, Adelie, Adelie, Adel…
## $ island            <fct> Torgersen, Torgersen, Torgersen, Torgersen, Torgerse…
## $ bill_length_mm    <dbl> 39.1, 39.5, 40.3, NA, 36.7, 39.3, 38.9, 39.2, 34.1, …
## $ bill_depth_mm     <dbl> 18.7, 17.4, 18.0, NA, 19.3, 20.6, 17.8, 19.6, 18.1, …
## $ flipper_length_mm <int> 181, 186, 195, NA, 193, 190, 181, 195, 193, 190, 186…
## $ body_mass_g       <int> 3750, 3800, 3250, NA, 3450, 3650, 3625, 4675, 3475, …
## $ sex               <fct> male, female, female, NA, female, male, female, male…

# Remover linhas com valores ausentes
penguins <- penguins %>% drop_na()

# Converter a variável de resposta 'sex' em fator
penguins <- penguins %>% mutate(sex = as.factor(sex))

Código do modelo e treinamento

# Dividir os dados em treino e teste
set.seed(123)
data_split <- initial_split(penguins, prop = 0.8, strata = sex)
train_data <- training(data_split)
test_data <- testing(data_split)

Definir a receita (recipe)

A recipe permite o pré-processamento dos dados antes de treinar o modelo.

# Definir a receita
penguins_recipe <- recipe(sex ~ ., data = train_data) %>%
  step_normalize(all_numeric_predictors()) %>%
  step_dummy(all_nominal_predictors())

Especificar o modelo

Vamos especificar um modelo de árvore de decisão. Neste caso usaremos Classificação.

# Especificar o modelo
decision_tree_spec <- decision_tree() %>%
  set_engine("rpart") %>%
  set_mode("classification")

Criar um workflow

Esse passo usamos para combinar a receita e o modelo

# Criar o workflow
penguins_workflow <- workflow() %>%
  add_recipe(penguins_recipe) %>%
  add_model(decision_tree_spec)

Iremos treinar o modelo

Nesse caso usaremos os dados de treino.

# Treinar o modelo
penguins_fit <- penguins_workflow %>%
  fit(data = train_data)

Avaliar o modelo

Avaliamos o desempenho do modelo nos dados de teste.

# Fazer previsões
penguins_predictions <- predict(penguins_fit, test_data) %>%
  bind_cols(test_data)

# Avaliar o modelo
penguins_metrics <- penguins_predictions %>%
  metrics(truth = sex, estimate = .pred_class)

# Ver as métricas de avaliação
print(penguins_metrics)

## # A tibble: 2 × 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.836
## 2 kap      binary         0.671

Ajustar hiperparâmentros

Para melhorar o desempenho do modelo, resolvemos ajustar os hiperparâmetros usando tune_grid.

# Especificar o modelo com parâmetros ajustáveis
tune_spec <- decision_tree(cost_complexity = tune()) %>%
  set_engine("rpart") %>%
  set_mode("classification")

# Atualizar o workflow
tune_workflow <- workflow() %>%
  add_recipe(penguins_recipe) %>%
  add_model(tune_spec)

# Definir o controle do ajuste
set.seed(123)
tune_res <- tune_grid(
  tune_workflow,
  resamples = vfold_cv(train_data, v = 5, strata = sex),
  grid = 10
)

# Ver os resultados do ajuste
print(tune_res)

## # Tuning results
## # 5-fold cross-validation using stratification 
## # A tibble: 5 × 4
##   splits           id    .metrics          .notes          
##   <list>           <chr> <list>            <list>          
## 1 <split [212/54]> Fold1 <tibble [30 × 5]> <tibble [0 × 3]>
## 2 <split [212/54]> Fold2 <tibble [30 × 5]> <tibble [0 × 3]>
## 3 <split [213/53]> Fold3 <tibble [30 × 5]> <tibble [0 × 3]>
## 4 <split [213/53]> Fold4 <tibble [30 × 5]> <tibble [0 × 3]>
## 5 <split [214/52]> Fold5 <tibble [30 × 5]> <tibble [0 × 3]>

# Selecionar os melhores parâmetros
best_tree <- select_best(tune_res, metric = "accuracy")

# Finalizar o modelo com os melhores parâmetros
final_workflow <- finalize_workflow(tune_workflow, best_tree)

# Treinar o modelo final
final_fit <- final_workflow %>%
  fit(data = train_data)

# Avaliar o modelo final
final_predictions <- predict(final_fit, test_data) %>%
  bind_cols(test_data)

final_metrics <- final_predictions %>%
  metrics(truth = sex, estimate = .pred_class)

# Ver as métricas de avaliação final
print(final_metrics)

## # A tibble: 2 × 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.851
## 2 kap      binary         0.701

• Os valores do Kappa de Cohen variam de -1 a 1:

1 indica uma concordância perfeita entre os observadores. 0 indica que a concordância é equivalente ao acaso. Valores negativos indicam uma concordância menor do que o esperado pelo acaso.

Conclusão

# Obter a acurácia final
accuracy <- final_metrics %>% filter(.metric == "accuracy")

# Printar a acurácia
print(accuracy)

## # A tibble: 1 × 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.851

Matriz de Confusão

# Matriz de Confusão
penguins_predictions %>%
  conf_mat(truth = sex, estimate = .pred_class) %>%
  autoplot(type = "heatmap")

# Importância das variáveis (se aplicável)
library(vip)

## 
## Anexando pacote: 'vip'

## O seguinte objeto é mascarado por 'package:utils':
## 
##     vi

final_fit %>%
  extract_fit_parsnip() %>%
  vip()