Titanic_LM
Iraelson
16 outubro, 2025
1 Problema/Contexto
Este projeto usa o conjunto de dados “Titanic” (versões públicas amplamente difundidas em plataformas como Kaggle/OpenML) para formular um problema de classificação binária: prever se um passageiro sobreviveu (1) ou não sobreviveu (0) com base em atributos demográficos e de viagem. As variáveis tipicamente disponíveis incluem, entre outras: Pclass (classe do bilhete: 1ª, 2ª, 3ª), Sex, Age, SibSp (nº de irmãos/cônjuges a bordo), Parch (nº de pais/filhos a bordo), Fare (tarifa), Embarked (porto de embarque), além de campos como Ticket e Cabin. Esta base é amplamente utilizada para ensino e benchmarking de técnicas de aprendizado de máquina supervisionado.
Os principais desafios analíticos incluem (i) dados ausentes — especialmente em Age e Cabin — exigindo estratégias de imputação/documentação; (ii) codificação de variáveis categóricas (Sex, Embarked, Pclass), (iii) possível desequilíbrio moderado entre classes, e (iv) risco de vazamento ao usar campos pouco informativos ou com padrão de ausência correlacionado ao desfecho (ex.: Cabin). O objetivo final é comparar classificadores (Árvore de Decisão, k-NN, Naive Bayes, Redes Neurais, SVM e Random Forest), justificar a escolha do melhor modelo segundo métricas apropriadas e discutir os resultados obtidos.
2 Descrição e origem dos dados, Pacotes e análise exploratória básica
2.1 Descrição dos dados
2.1.1 Contexto dos Dados
O conjunto “Titanic” contém informações de passageiros do RMS Titanic e a variável-alvo Survived (0 = não sobreviveu, 1 = sobreviveu). As versões usadas em aprendizado de máquina são “linha-a-linha” (cada linha = um passageiro) e incluem, tipicamente, os campos: PassengerId (“id”, essa variável não terá serventia para essas análises), Survived (alvo), Pclass (classe 1–3), Name, Sex, Age, SibSp (irmãos/cônjuges a bordo), Parch (pais/filhos a bordo), Ticket, Fare, Cabin (cabine, com muitos ausentes), Embarked (porto: C/Q/S). Esses nomes e tipos aparecem na documentação dos datasets titanic_train/titanic_test do pacote titanic, que são cópias em formato ML da competição do Kaggle.
2.1.2 Tamanho dos arquivos
train.csv: 891 linhas × 12 colunas (inclui a variável-alvo Survived). Idades faltantes em 177 registros, Cabin ausente na maioria (~687), e Embarked faltante em 2 registros.
test.csv: 418 linhas × 11 colunas (não contém Survived). Em geral há 1 valor faltante em Fare e muitos faltantes em Cabin; Age também traz ausências.
2.1.3 Dicionário de variáveis (train/test)
PassengerId — identificador do passageiro. (Foi retirado da base de dados)
Survived — alvo (0 = não sobreviveu; 1 = sobreviveu) [apenas em train].
Pclass — classe do bilhete (1ª, 2ª, 3ª).
Name — nome completo.
Sex — sexo (male/female).
Age — idade (anos); contém faltantes.
SibSp — nº de irmãos/cônjuges a bordo.
Parch — nº de pais/filhos a bordo.
Ticket — número do bilhete.
Fare — tarifa paga (pode ter 1 faltante no test).
Cabin — cabine (muitos faltantes).
Embarked — porto de embarque (C = Cherbourg, Q = Queenstown, S = Southampton).
2.1.4 Origem dos dados
Os dados foram obtidos no Kaggle (plataforma online da Google voltada
para ciência de dados e machine learning).
Nome da base de dados: Titanic: Machine Learning from
Disaster.
Link oficial: https://www.kaggle.com/competitions/titanic
Observação: o pacote titanic do R traz cópias desses arquivos preparados para análise.
2.2 Análise Exploratória dos Dados
Nesta seção apresentarei o tratamento dos dados e uma análise
exploratória básica da base de treino do Titanic
(trainTitanic.csv).
O objetivo aqui é compreender a estrutura dos dados, identificar
problemas de qualidade (valores faltantes, outliers), e observar o
comportamento das variáveis em relação à variável resposta
Survived.
2.2.1 Instalação e carregamento dos pacotes necessários
Obs: Serão instalados e carregados nessa seção pacotes necessários para execução dos algoritmos.
# Excluir mensagens e erros do relatório final
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
# instala pacotes utilitários (dados, limpeza, EDA, relatório)
util_pkgs <- c(
"tidyverse", # dplyr, ggplot2, readr, etc.
"janitor", # limpar nomes/colunas
"skimr", # resumo rápido dos dados
"naniar", # NA/valores ausentes
"GGally", # ggpairs (matriz de gráficos)
"ggcorrplot", # correlações
"rpart.plot", # plot da árvore rpart
"vip", # feature importance
"pROC", # ROC/AUC (se quiser fora do yardstick)
"knitr", "rmarkdown" # relatório Rmd/knit
)
####Gerando a lista do que falta (to_install), instala se necessário, e depois carrega todos os pacotes pedidos.###
to_install <- setdiff(util_pkgs, rownames(installed.packages()))
if (length(to_install)) install.packages(to_install)
invisible(lapply(util_pkgs, require, character.only = TRUE))## Carregando pacotes exigidos: tidyverse## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.1 ✔ stringr 1.5.2
## ✔ ggplot2 4.0.0 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Carregando pacotes exigidos: janitor
##
##
## Anexando pacote: 'janitor'
##
##
## Os seguintes objetos são mascarados por 'package:stats':
##
## chisq.test, fisher.test
##
##
## Carregando pacotes exigidos: skimr
##
## Carregando pacotes exigidos: naniar
##
##
## Anexando pacote: 'naniar'
##
##
## O seguinte objeto é mascarado por 'package:skimr':
##
## n_complete
##
##
## Carregando pacotes exigidos: GGally
##
## Carregando pacotes exigidos: ggcorrplot
##
## Carregando pacotes exigidos: rpart.plot
##
## Carregando pacotes exigidos: rpart
##
## Carregando pacotes exigidos: vip
##
##
## Anexando pacote: 'vip'
##
##
## O seguinte objeto é mascarado por 'package:utils':
##
## vi
##
##
## Carregando pacotes exigidos: pROC
##
## Type 'citation("pROC")' for a citation.
##
##
## Anexando pacote: 'pROC'
##
##
## Os seguintes objetos são mascarados por 'package:stats':
##
## cov, smooth, var
##
##
## Carregando pacotes exigidos: knitr
##
## Carregando pacotes exigidos: rmarkdownO código acima configura o relatório para rodar de forma limpa e garantir que todas as bibliotecas necessárias estejam disponíveis. Primeiro, ele ajusta as opções do knitr para que mensagens e avisos não apareçam no documento final, deixando apenas o código e os resultados. Depois, cria uma lista chamada util_pkgs com os principais pacotes usados no projeto (como tidyverse para manipulação e visualização de dados, janitor e naniar para limpeza e tratamento de valores ausentes, skimr para resumos estatísticos, GGally e ggcorrplot para gráficos, rpart.plot e vip para modelos e importância de variáveis, além de pROC, knitr e rmarkdown para relatórios). Em seguida, o código identifica quais pacotes ainda não estão instalados (setdiff compara os desejados com os já instalados) e instala apenas os que faltam. Por fim, carrega todos os pacotes listados com require, garantindo que fiquem prontos para uso sem exibir mensagens no relatório.
Ou seja: esse trecho prepara o ambiente do relatório, instalando e carregando automaticamente todos os pacotes essenciais de análise e visualização, enquanto limpa o output de mensagens e avisos para um resultado mais profissional.
# Excluir mensagens e erros do relatório final
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
####gerenciando automáticamente os pacotes: Definindo listas de pacotes (core_tidy, extra_pkgs, optional_meta); Usando a função ensure_pkg() para instalar e carregando cada pacote que não estiver disponível;Cria uma tabela status mostrando se cada pacote está instalado e carregado.##################################
ensure_pkg <- function(p){
if (!requireNamespace(p, quietly = TRUE)) {
install.packages(p, dependencies = TRUE, repos = "https://cloud.r-project.org")
}
suppressPackageStartupMessages( library(p, character.only = TRUE) )
}
core_tidy <- c("readr","dplyr","ggplot2","tidyr","stringr","forcats","purrr")
extra_pkgs <- c("janitor","skimr","naniar","GGally",
"rpart","rpart.plot","class","e1071","nnet","randomForest",
"caret","pROC","rmarkdown","knitr","scales")
optional_meta <- c("tidyverse")
pkgs <- c(core_tidy, extra_pkgs, optional_meta)
for(p in pkgs) ensure_pkg(p)
# Mostrar status
status <- data.frame(
pacote = pkgs,
instalado = vapply(pkgs, function(x) requireNamespace(x, quietly=TRUE), logical(1)),
carregado = vapply(pkgs, function(x) paste0("package:", x) %in% search(), logical(1))
)
print(status)## pacote instalado carregado
## readr readr TRUE TRUE
## dplyr dplyr TRUE TRUE
## ggplot2 ggplot2 TRUE TRUE
## tidyr tidyr TRUE TRUE
## stringr stringr TRUE TRUE
## forcats forcats TRUE TRUE
## purrr purrr TRUE TRUE
## janitor janitor TRUE TRUE
## skimr skimr TRUE TRUE
## naniar naniar TRUE TRUE
## GGally GGally TRUE TRUE
## rpart rpart TRUE TRUE
## rpart.plot rpart.plot TRUE TRUE
## class class TRUE TRUE
## e1071 e1071 TRUE TRUE
## nnet nnet TRUE TRUE
## randomForest randomForest TRUE TRUE
## caret caret TRUE TRUE
## pROC pROC TRUE TRUE
## rmarkdown rmarkdown TRUE TRUE
## knitr knitr TRUE TRUE
## scales scales TRUE TRUE
## tidyverse tidyverse TRUE TRUEEsse segundo chunk aprofunda a preparação do ambiente com um “gestor de pacotes” mais robusto e um relatório de auditoria. Ele começa repetindo as opções do knitr para manter o relatório limpo. Em seguida, define uma função (ensure_pkg) que, para cada pacote, verifica se está instalado e, se não estiver, instala com dependências a partir do CRAN; depois carrega silenciosamente, evitando as mensagens de inicialização. Logo após, organiza os pacotes em três grupos: um núcleo “tidy” para leitura/manipulação/visualização (readr, dplyr, ggplot2, tidyr, stringr, forcats, purrr), um conjunto “extra” com ferramentas de limpeza, diagnóstico, modelagem e relatório (janitor, skimr, naniar, GGally, rpart/rpart.plot, class, e1071, nnet, randomForest, caret, pROC, rmarkdown, knitr, scales) e um metapacote opcional (tidyverse). Esses vetores são combinados em uma lista única, percorrida para garantir instalação e carregamento de tudo de forma automática. Por fim, o chunk monta e imprime uma tabela de status com três colunas — nome do pacote, se está instalado e se está carregado — permitindo conferir rapidamente se o ambiente ficou completo e operacional antes das análises.
2.2.2 Importação, Checagem e Tipagem dos dados
# Arquivos locais (mesma pasta do .Rmd)
arq_train <- "trainTitanic.csv"
arq_test <- "testTitanic.csv"
# Leitura robusta
train_raw <- read_delim(
arq_train, delim = ";",
locale = locale(decimal_mark = ".", grouping_mark = ","),
na = c("", "NA"), show_col_types = FALSE
)
# Se existir o test:
test_raw <- tryCatch(
read_delim(arq_test, delim = ";",
locale = locale(decimal_mark = ".", grouping_mark = ","),
na = c("", "NA"), show_col_types = FALSE),
error = function(e) NULL
)
# Limpeza leve + tipagem (mantém seus nomes originais, só converte tipos)
train <- train_raw %>%
mutate(
Age = parse_number(as.character(Age)),
Fare = parse_number(as.character(Fare)),
Survived = suppressWarnings(as.integer(Survived)),
Pclass = suppressWarnings(as.integer(Pclass)),
Sex = as.factor(Sex),
Embarked = as.factor(Embarked)
)
if(!is.null(test_raw)){
test <- test_raw %>%
mutate(
Age = parse_number(as.character(Age)),
Fare = parse_number(as.character(Fare)),
Pclass = suppressWarnings(as.integer(Pclass)),
Sex = as.factor(Sex),
Embarked = as.factor(Embarked)
)
}
# Conferências rápidas
dim(train); head(train, 12)## [1] 889 8## # A tibble: 12 × 8
## Survived Pclass Sex Age SibSp Parch Fare Embarked
## <int> <int> <fct> <dbl> <dbl> <dbl> <dbl> <fct>
## 1 0 3 male 22 1 0 7.25 S
## 2 1 1 female 38 1 0 713. C
## 3 1 3 female 26 0 0 7.92 S
## 4 1 1 female 35 1 0 53.1 S
## 5 0 3 male 35 0 0 8.05 S
## 6 0 3 male 28 0 0 84.6 Q
## 7 0 1 male 54 0 0 519. S
## 8 0 3 male 2 3 1 21.1 S
## 9 1 3 female 27 0 2 111. S
## 10 1 2 female 14 1 0 301. C
## 11 1 3 female 4 1 1 16.7 S
## 12 1 1 female 58 0 0 26.6 Sglimpse(train)## Rows: 889
## Columns: 8
## $ Survived <int> 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0…
## $ Pclass <int> 3, 1, 3, 1, 3, 3, 1, 3, 3, 2, 3, 1, 3, 3, 3, 2, 3, 2, 3, 3, 2…
## $ Sex <fct> male, female, female, female, male, male, male, male, female,…
## $ Age <dbl> 22, 38, 26, 35, 35, 28, 54, 2, 27, 14, 4, 58, 20, 39, 14, 55,…
## $ SibSp <dbl> 1, 1, 0, 1, 0, 0, 0, 3, 0, 1, 1, 0, 0, 1, 0, 0, 4, 0, 1, 0, 0…
## $ Parch <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 1, 0, 0, 5, 0, 0, 1, 0, 0, 0, 0…
## $ Fare <dbl> 7.250, 712.833, 7.925, 53.100, 8.050, 84.583, 518.625, 21.075…
## $ Embarked <fct> S, C, S, S, S, Q, S, S, S, C, S, S, S, S, S, S, Q, S, S, C, S…Esse código acima cuida de localizar os arquivos (assumindo que estão na mesma pasta do Rmd), ler os dados com configuração de separador “;”, definir a localidade para interpretar corretamente ponto como decimal e vírgula como separador de milhar, e tratar “”“ (vazio) e “NA” como ausentes. Ele tenta ler tanto o conjunto de treino quanto o de teste; para o teste, usa um tryCatch que devolve NULL se o arquivo não existir, evitando que o knit quebre. Em seguida, aplica uma “tipagem leve” no train: converte Age e Fare para numéricos robustamente (extraindo números mesmo se houver caracteres mistos), força Survived e Pclass a inteiros (suprimindo avisos de conversão quando houver NAs), e transforma Sex e Embarked em fatores para análises categóricas. Se o conjunto test existir, repete a mesma padronização de tipos, exceto Survived (que não costuma existir no teste). Por fim, executa conferências rápidas: mostra dimensões da base, antecipa as primeiras linhas e exibe o glimpse, permitindo verificar tipos, presença de NAs e se a leitura/transformação ficou coerente antes de avançar para análises.
2.2.3 Resumo geral e valores faltantes
summary(train) # estatísticas básicas## Survived Pclass Sex Age SibSp
## Min. :0.0000 Min. :1.000 female:312 Min. : 0.42 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:2.000 male :577 1st Qu.:22.00 1st Qu.:0.0000
## Median :0.0000 Median :3.000 Median :28.00 Median :0.0000
## Mean :0.3825 Mean :2.312 Mean :29.32 Mean :0.5242
## 3rd Qu.:1.0000 3rd Qu.:3.000 3rd Qu.:35.00 3rd Qu.:1.0000
## Max. :1.0000 Max. :3.000 Max. :80.00 Max. :8.0000
## Parch Fare Embarked
## Min. :0.0000 Min. : 0.000 C:168
## 1st Qu.:0.0000 1st Qu.: 9.825 Q: 77
## Median :0.0000 Median : 26.550 S:644
## Mean :0.3825 Mean : 89.006
## 3rd Qu.:0.0000 3rd Qu.: 78.958
## Max. :6.0000 Max. :910.792skimr::skim(train) # resumo detalhado (conta NAs)| Name | train |
| Number of rows | 889 |
| Number of columns | 8 |
| _______________________ | |
| Column type frequency: | |
| factor | 2 |
| numeric | 6 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| Sex | 0 | 1 | FALSE | 2 | mal: 577, fem: 312 |
| Embarked | 0 | 1 | FALSE | 3 | S: 644, C: 168, Q: 77 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Survived | 0 | 1 | 0.38 | 0.49 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▅ |
| Pclass | 0 | 1 | 2.31 | 0.83 | 1.00 | 2.00 | 3.00 | 3.00 | 3.00 | ▃▁▃▁▇ |
| Age | 0 | 1 | 29.32 | 12.98 | 0.42 | 22.00 | 28.00 | 35.00 | 80.00 | ▂▇▃▁▁ |
| SibSp | 0 | 1 | 0.52 | 1.10 | 0.00 | 0.00 | 0.00 | 1.00 | 8.00 | ▇▁▁▁▁ |
| Parch | 0 | 1 | 0.38 | 0.81 | 0.00 | 0.00 | 0.00 | 0.00 | 6.00 | ▇▁▁▁▁ |
| Fare | 0 | 1 | 89.01 | 158.72 | 0.00 | 9.83 | 26.55 | 78.96 | 910.79 | ▇▁▁▁▁ |
# Resumo de variáveis com NAs (naniar)
naniar::miss_var_summary(train)## # A tibble: 8 × 3
## variable n_miss pct_miss
## <chr> <int> <num>
## 1 Survived 0 0
## 2 Pclass 0 0
## 3 Sex 0 0
## 4 Age 0 0
## 5 SibSp 0 0
## 6 Parch 0 0
## 7 Fare 0 0
## 8 Embarked 0 0Esse código acima produz um panorama rápido do conjunto de treino e mapeia faltantes. Ele começa com summary(train), que entrega estatísticas descritivas básicas: para variáveis numéricas (mínimo, quartis, mediana, média, máximo e contagem de NAs) e, para categóricas, frequências por nível. Em seguida, skimr::skim(train) aprofunda o diagnóstico: mostra o tipo de cada coluna, percentuais de completude, distribuição resumida (p. ex., histograma em texto para numéricas), contagem de valores únicos, comprimento médio de strings etc., servindo como um checklist de “saúde” do dataset. Por fim, naniar::miss_var_summary(train) organiza, em tabela, o número e a proporção de NAs por variável, ordenando das colunas mais problemáticas para as menos; isso facilita decidir onde imputar, excluir ou transformar antes de modelar.
2.2.4 Análises Univariadas
# Sobrevivência (variável resposta)
train %>%
count(Survived) %>%
mutate(prop = n/sum(n)) %>%
ggplot(aes(x = factor(Survived), y = n, fill = factor(Survived))) +
geom_col() +
geom_text(aes(label = n), vjust = -0.3) +
labs(x = "Sobreviveu (0 = não, 1 = sim)", y = "Frequência",
title = "Distribuição da variável Survived") +
guides(fill = "none")
O código acima cria um gráfico univariado que apresenta a distribuição da variável resposta Survived (0/1). O pipeline começa agregando a base (count(Survived)) para obter a frequência absoluta de cada valor e calcula também a proporção (mutate(prop = n/sum(n)), útil se quisermos exibir percentuais depois. Em seguida, faz um gráfico de colunas com ggplot: no eixo x, Survived tratado como fator (garante barras discretas para 0 e 1); no eixo y, a contagem n. O preenchimento (fill) também usa Survived, apenas para dar cor distinta às barras, mas a legenda é removida (guides(fill = “none”)) porque as categorias já estão legendadas no eixo x. O geom_text imprime o valor da contagem acima de cada barra (o vjust = -0,3 posiciona o rótulo um pouco acima do topo). Por fim, labs define título e rótulos de eixos (“0 = não, 1 = sim”), tornando o gráfico autoexplicativo. Em termos práticos, ele responde rapidamente “quantos e em que proporção sobreviveram vs. não sobreviveram” — e, se houver NAs (valores faltantes), serão ignorados nos gráficos.
# Sexo
train %>%
ggplot(aes(x = Sex, fill = Sex)) +
geom_bar() +
geom_text(aes(label = after_stat(count)),
stat = "count", vjust = -0.3) +
scale_y_continuous(expand = expansion(mult = c(0, .1))) +
labs(title = "Distribuição por Sexo", x = "Sexo", y = "Frequência") +
guides(fill = "none")
Este código acima exibe a distribuição de passageiros por sexo. Ele constrói um gráfico de barras onde o eixo x traz os níveis de Sex e a altura de cada barra representa a contagem observada em cada nível. Os rótulos numéricos no topo de cada barra são calculados diretamente a partir da estatística de contagem do próprio geome (por isso aparecem mesmo sem um count() prévio), o que deixa o pipeline mais enxuto. A escala do eixo y recebe uma pequena margem superior (expand) para que os rótulos não “cortem” no topo do painel, e a legenda de preenchimento é removida porque as categorias já estão claramente identificadas no eixo x. Em termos analíticos, este gráfico serve para checar desbalanceamento entre sexos (o que pode influenciar métricas de modelo e a leitura de taxas de sobrevivência mais adiante). Se houver valores ausentes em Sex, eles não entram por padrão nas barras; vale decidir antes se serão imputados, tratados como categoria própria ou filtrados.
# Classe
train %>%
ggplot(aes(x = factor(Pclass), fill = factor(Pclass))) +
geom_bar() +
geom_text(aes(label = after_stat(count)),
stat = "count", vjust = -0.3) +
scale_y_continuous(expand = expansion(mult = c(0, .1))) +
labs(x = "Classe da Passagem", title = "Distribuição por Classe", y = "Frequência") +
guides(fill = "none")
Este código acima apresenta a distribuição de passageiros por classe de passagem (Pclass), uma variável ordinal que representa o nível socioeconômico a bordo. O pipeline usa o ggplot com o eixo x definido pelas classes (convertidas para fator, garantindo categorias discretas 1, 2 e 3) e a contagem de passageiros no eixo y. O preenchimento (fill) diferencia as classes visualmente, embora a legenda seja removida (guides(fill = “none”)) porque o rótulo do eixo já identifica cada categoria. O geom_text adiciona os números absolutos no topo das barras, enquanto scale_y_continuous(expand = expansion(mult = c(0, .1))) deixa uma folga no topo do gráfico para que os valores não fiquem sobrepostos à borda. Analiticamente, essa visualização mostra o perfil de distribuição socioeconômica do conjunto de dados: normalmente a 3ª classe domina em número de passageiros, o que é importante porque influencia fortemente a taxa de sobrevivência (passageiros de 1ª classe tendem a ter maior probabilidade de sobreviver). Assim, o gráfico ajuda a perceber o desbalanceamento entre grupos e antecipa uma possível relação entre classe e sobrevivência a ser explorada nas análises bivariadas.
# Idade (Age)
train %>%
ggplot(aes(x = Age)) +
geom_histogram(
aes(y = after_stat(density)), # mapeamento vai em aes()
binwidth = 5, # fora de aes()
fill = "steelblue",
color = "red",
na.rm = TRUE
) +
geom_density(linewidth = 1.2, na.rm = TRUE) +
scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +
labs(title = "Distribuição da Idade",
x = "Idade (anos)", y = "Densidade")
Este código acima mostra a distribuição da idade graficamente. Ele constrói um histograma usando a idade no eixo x e a densidade no eixo y (em vez de contagem), o que permite sobrepor uma curva de densidade contínua para comparar a forma da distribuição. O histograma usa classes com largura fixa (binwidth = 5 anos), removendo valores ausentes para não distorcer as barras; a curva de densidade também ignora NAs. A escala do eixo y ganha uma pequena folga no topo para não cortar o desenho. Em termos interpretativos, observa-se rapidamente centralização (idade típica), dispersão (quão espalhada está a idade), e assimetria (cauda à direita é comum, indicando mais jovens e alguns valores altos). Picos secundários podem sugerir subgrupos (por exemplo, crianças vs. adultos). Esse diagnóstico é útil para decidir imputação de faltantes, transformações ou faixas etárias em modelos.
2.2.5 Análises Bivariadas
# Sexo x Sobrevivência
train %>%
ggplot(aes(x = Sex, fill = factor(Survived))) +
geom_bar(position = "fill") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Taxa de Sobrevivência por Sexo", y = "Proporção", x = "Sexo",
fill = "Survived")
Esse gráfico acima mostra a taxa de sobrevivência por sexo. Em vez de contagens absolutas, ele usa barras empilhadas normalizadas (position = “fill”), de modo que cada barra (uma para cada nível de Sex) vai de 0 a 1 e representa proporções. O preenchimento por Survived separa, dentro de cada sexo, a fração que sobreviveu vs. não sobreviveu; o eixo y é rotulado em percentuais para facilitar a leitura comparativa. Assim, você compara diretamente probabilidades condicionais de sobrevivência dado o sexo, independentemente do desbalanceamento no número de homens e mulheres. Em geral, a barra de “female” apresenta uma fatia de sobrevivência bem maior, refletindo a regra “women and children first” (mulheres e crianças primeiro) e possíveis diferenças de acesso a botes e cabines.
# Classe x Sobrevivência
train %>%
ggplot(aes(x = factor(Pclass), fill = factor(Survived))) +
geom_bar(position = "fill") +
scale_y_continuous(labels = scales::percent) +
labs(x = "Classe", y = "Proporção", title = "Taxa de Sobrevivência por Classe",
fill = "Survived")
Este gráfico acima compara a taxa de sobrevivência por classe de passagem (Pclass) usando barras empilhadas normalizadas: para cada classe (1, 2, 3), a barra vai de 0 a 1 e mostra a proporção de sobreviventes e não-sobreviventes dentro daquela classe. O preenchimento por Survived evidencia o contraste visual, e o eixo y é mostrado em percentual para leitura direta. Interpretativamente, ele revela um forte gradiente socioeconômico: tende a haver maior taxa de sobrevivência na 1ª classe e menor na 3ª, o que está alinhado a diferenças de cabine, localização no navio e acesso aos botes. Como Pclass é ordinal, esse padrão sugere um efeito monotônico que se pode explorar em modelos (p.ex., codificação ordinal ou dummies).
# Idade x Sobrevivência
train %>%
ggplot(aes(x = Survived, y = Age, fill = factor(Survived))) +
geom_boxplot(na.rm = TRUE) +
labs(x = "Sobreviveu", y = "Idade",
title = "Distribuição da Idade por Sobrevivência") +
guides(fill = "none")
Este boxplot acima compara a distribuição das idades condicionadas à sobrevivência. Cada caixa resume a idade para Survived = 0 e Survived = 1: a linha no meio é a mediana, as bordas da caixa são o IQR (quartis 25% e 75%), e os pontos além dos “bigodes” são outliers. Como os NAs de Age foram removidos, a amostra aqui é apenas de registros com idade conhecida. A leitura típica é: se a caixa dos sobreviventes estiver mais baixa (mediana menor), indica que sobreviventes costumam ser mais jovens; se estiver semelhante, a idade pode não ter efeito forte isoladamente. A largura vertical das caixas indica dispersão; diferenças grandes sugerem heterogeneidade distinta entre os grupos.
# Tarifa (Fare) x Sobrevivência
train %>%
ggplot(aes(x = Survived, y = Fare, fill = factor(Survived))) +
geom_boxplot(na.rm = TRUE) +
labs(x = "Sobreviveu", y = "Tarifa",
title = "Distribuição da Tarifa por Sobrevivência") +
guides(fill = "none")
Este boxplot acima compara a tarifa paga (Fare) entre quem não sobreviveu e quem sobreviveu. Cada grupo tem sua distribuição resumida: mediana (linha central), dispersão interquartil (caixa) e possíveis outliers (pontos além dos “bigodes”). Como valores ausentes são ignorados, a comparação usa apenas registros com Fare conhecido. Em geral, observar medianas mais altas e/ou uma cauda superior mais pronunciada no grupo dos sobreviventes sugere que tarifas maiores (associadas a melhores acomodações) se relacionam positivamente com a sobrevivência. A presença de outliers altos indica passageiros que pagaram tarifas muito elevadas, possivelmente cabines de primeira classe. Esse diagnóstico reforça a ideia de gradiente socioeconômico e motiva considerar Fare de forma possivelmente não linear (transformações ou cortes em faixas) e em conjunto com Pclass em modelos (já que ambas as variáveis estão correlacionadas).
2.2.6 Correlação entre variáveis numéricas
train %>%
select(Age, SibSp, Parch, Fare) %>%
GGally::ggpairs(progress = FALSE)
Este ódigo acima cria uma matriz de relações entre variáveis numéricas (Age, SibSp, Parch, Fare) usando GGally::ggpairs. A saída é um painel compacto: na diagonal aparecem distribuições univariadas (normalmente histogramas/densidades) de cada variável; abaixo da diagonal, os dispersogramas (gráficos de dispersão) para cada par de variáveis, que ajudam a perceber padrões, tendências e outliers; acima da diagonal, métricas resumidas de associação (tipicamente correlação de Pearson para pares numéricos), úteis para quantificar a força e o sentido do relacionamento.
Interpretativamente, se observa, por exemplo, que Fare tem cauda longa (assimetria positiva), que Age apresenta ausência de valores e concentração em faixas específicas, e que há indícios de colinearidade relevante entre preditores (ex.: correlação entre SibSp e Parch indicando grupos familiares). Dispersões “em leque” ou nuvens curvas sugerem relações não lineares; correlações próximas de zero indicam pouca associação linear, mas ainda assim pode haver relações mais complexas.
Como o ggpairs plota ponto a ponto, outliers ficam evidentes e podem orientar decisões de tratamento, transformação (log em Fare, por exemplo) ou robustez do modelo. Se houver muitos NAs, alguns painéis podem mostrar menos pontos; vale considerar imputação antes de análises preditivas. Em resumo, este painel serve como uma varredura rápida para checar distribuição, associação e possíveis problemas de modelagem entre seus preditores numéricos.
3 Préprocessamento e Desenvolvimento dos Classificadores
3.1 Préprocessamento dos dados para modelagem
Objetivo: preparar os dados para treinar modelos (imputar faltantes, selecionar variáveis, criar dummies, padronizar e fazer partição treino/validação) sem “vazar” informação.
#############Pré-processamento dos dados###################
set.seed(123)
#1 Seleção de variáveis (features canônicas de ML no Titanic)
# (Removendo campos de alto vazamento/ruído: Name, Ticket, Cabin)
vars_modelo <- c("Survived","Pclass","Sex","Age","SibSp","Parch","Fare","Embarked")
dados <- train %>% dplyr::select(dplyr::all_of(intersect(names(train), vars_modelo)))
# 2) Funções auxiliares de imputação -----------------------------
# Moda (para categóricas)
mode_fast <- function(x){
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
# Imputação NUMÉRICA mais robusta: mediana por (Pclass, Sex).
# Se grupo todo for NA, cai para mediana global.
imputa_num_grupo <- function(df, var){
v <- df[[var]]
# mediana por grupos
med_grp <- df %>%
group_by(Pclass, Sex) %>%
summarize(.med = median(.data[[var]], na.rm = TRUE), .groups = "drop")
out <- v
na_idx <- which(is.na(v))
if(length(na_idx)){
tmp <- df[na_idx, c("Pclass","Sex")] %>%
left_join(med_grp, by = c("Pclass","Sex")) %>%
pull(.med)
# fallback global
tmp[is.na(tmp)] <- median(v, na.rm = TRUE)
out[na_idx] <- tmp
}
out
}O “set.seed(123)” fixa a semente do gerador de números aleatórios, garantindo reprodutibilidade. Sempre que rodarmos o script, operações aleatórias (como partições de treino/validação mais à frente) darão o mesmo resultado.
Escolha das variáveis (features) que vão para o modelo:
Essas partes do código (abaixo),
vars_modelo <- c("Survived","Pclass","Sex","Age","SibSp","Parch","Fare","Embarked")
dados <- train %>% dplyr::select(dplyr::all_of(intersect(names(train), vars_modelo)))
definem o conjunto de features canônicas do Titanic para ML e filtra o train para manter apenas essas colunas.
Isso reduz ruído e risco de vazamento (data leakage). Campos como Name, Ticket e, principalmente, Cabin:Têm muitos faltantes (especialmente Cabin);
Podem carregar padrões indiretos e enviesados (ex.: presença/ausência de Cabin correlacionada com classe/sobrevivência).
Mais detalhes do código:
vars_modelo: lista alvo (Survived) + preditores
clássicos (Pclass, Sex, Age, SibSp, Parch, Fare, Embarked).
intersect(names(train), vars_modelo): torna o código à
prova de variações — se alguma coluna não existir no arquivo, ela é
simplesmente ignorada (evita erro).
Resultado dados = subconjunto do train só com as colunas
relevantes.
Basicamente, peguei apenas as colunas importantes e limpas para o problema e deixei de lado as que mais atrapalham do que contribuem.
Em
mode_fast <- function(x){ ux <- unique(x) ux[which.max(tabulate(match(x, ux)))] }
Tem-se a função que calcula a moda (valor mais frequente) de um vetor x.
Vamos usar a moda para imputar faltantes em variáveis categóricas (ex.: Embarked) de forma simples e coerente. Como funciona tecnicamente: mapeia os valores aos seus índices únicos, conta as ocorrências (tabulate) e retorna o de maior frequência.Ou seja, “Se faltar o porto de embarque, eu completo com o mais comum.”
Já nessa parte do código:
imputa_num_grupo <- function(df, var){ v <- df[[var]] med_grp <- df %>% group_by(Pclass, Sex) %>% summarize(.med = median(.data[[var]], na.rm = TRUE), .groups = "drop") out <- v na_idx <- which(is.na(v)) if(length(na_idx)){ tmp <- df[na_idx, c("Pclass","Sex")] %>% left_join(med_grp, by = c("Pclass","Sex")) %>% pull(.med) tmp[is.na(tmp)] <- median(v, na.rm = TRUE) # fallback global out[na_idx] <- tmp } out }
Temos uma função para preencher valores faltantes de uma variável numérica (por exemplo, Age) usando a mediana por grupo definido por Pclass × Sex.
Por quê fazer isso? A mediana é robusta a outliers (menos sensível a valores extremos do que a média).
Imputar por grupo (classe × sexo) respeita heterogeneidade real: a idade típica de mulheres da 1ª classe é diferente da de homens da 3ª, por exemplo.
Fallback global: se para um certo grupo não houver dados suficientes (muitos NAs), usa-se a mediana global da variável para não deixar nada faltando.
Como funciona:
Calcula a mediana por grupo: med_grp.
Localiza onde há NA (na_idx) na variável.
Para cada NA, busca a mediana do seu grupo (Pclass e Sex) via left_join.
Se essa mediana de grupo também for NA (grupo sem dados), aplica a mediana global da variável.
Retorna o vetor com os NAs imputados.
Em outras palavras: “Se a idade de alguém estiver faltando, o R preenche com a mediana de pessoas parecidas (mesma classe do bilhete e mesmo sexo). Se mesmo assim não tiver dado suficiente, ele usará a mediana geral.”
# 3) Imputação no TRAIN
# Garantindo classes corretas
dados <- dados %>%
mutate(
Pclass = as.integer(Pclass),
Sex = forcats::fct_drop(as.factor(Sex)),
Embarked = forcats::fct_drop(as.factor(Embarked)),
Age = as.numeric(Age),
Fare = as.numeric(Fare),
Survived = as.integer(Survived)
)
# Imputa numéricas por grupo (Pclass, Sex)
dados <- dados %>%
mutate(
Age = imputa_num_grupo(., "Age"),
Fare = ifelse(is.na(Fare), median(Fare, na.rm = TRUE), Fare) # Fare raramente falta no train
)
# Imputa categórica por moda
if(any(is.na(dados$Embarked))){
emb_mode <- mode_fast(na.omit(dados$Embarked))
dados$Embarked[is.na(dados$Embarked)] <- emb_mode
}
# Checagem de faltantes pós-imputação
colSums(is.na(dados))## Survived Pclass Sex Age SibSp Parch Fare Embarked
## 0 0 0 0 0 0 0 0No código acima, garantimos classes corretas (tipos das variáveis) nesta parte do código:
dados <- dados %>% mutate( Pclass = as.integer(Pclass), Sex = forcats::fct_drop(as.factor(Sex)), Embarked = forcats::fct_drop(as.factor(Embarked)), Age = as.numeric(Age), Fare = as.numeric(Fare), Survived = as.integer(Survived) )
Assim, Converti cada coluna para o tipo adequado:
Pclass, Survived → inteiro (0/1 para alvo; 1/2/3 para classe).
Sex, Embarked → fator (categóricas). O fct_drop() remove níveis vazios que às vezes ficam “sobrando”.
Age, Fare → numérico contínuo.
Fiz isso porque modelos e gráficos dependem do tipo correto (ex.: se Age estiver como texto, o histograma e os modelos quebram).
Removi níveis vazios evita erros mais à frente (principalmente ao criar dummies).
É possível checar usando:
glimpse(dados) levels(dados$Sex); levels(dados$Embarked)
Devemos ver Sex/Embarked como fatores e Age/Fare numéricos.
Fiz imputação numérica por grupo (Pclass × Sex) nessa parte do
código:
dados <- dados %>% mutate( Age = imputa_num_grupo(., "Age"), Fare = ifelse(is.na(Fare), median(Fare, na.rm = TRUE), Fare) )
Age: preenche NAs com a mediana dentro do grupo definido por Pclass e Sex (usando a função que você criou antes). Se o grupo inteiro não tiver dados, cai para a mediana global.
Fare: se houver NA (raro no train), preenche com a mediana global de Fare.
Por que fazer isso?
A mediana é robusta a outliers.
Imputar por grupo respeita diferenças estruturais (ex.: perfis etários de homens da 3ª classe vs. mulheres da 1ª).
Para checar: sum(is.na(dados\(Age)); sum(is.na(dados\)Fare)) summary(dados\(Age); summary(dados\)Fare)
Ambos devem retornar 0 NAs depois da imputação.
Observação: Se algum grupo Pclass × Sex não existir (ex.: nenhuma mulher numa certa classe), a função automaticamente usa a mediana global, evitando NA.
Fiz também, imputação categórica por moda (Embarked):
if (any(is.na(dados$Embarked))) { emb_mode <- mode_fast(na.omit(dados$Embarked)) dados$Embarked[is.na(dados$Embarked)] <- emb_mode }
Se houver NAs em Embarked, substitui-se pelo valor mais frequente (moda), calculado em cima dos casos não faltantes.
A moda é a escolha mais simples e coerente para categóricas quando a taxa de NA é baixa (no Titanic, Embarked costuma ter 2 NAs).
Para checar:
sum(is.na(dados\(Embarked)); table(dados\)Embarked, useNA = “ifany”) Deve-se retornar 0 NAs em Embarked.
Checagem final de faltantes: colSums(is.na(dados)) Isso, conta quantos NAs restaram em cada coluna.
Interpretação: O ideal é tudo zero nas colunas usadas pelo modelo.
Se sobrar NA, deve-e revisar a conversão de tipos (especialmente Age/Fare) e se a função de imputação foi de fato aplicada.
Ao final, deu 0 para todas as colunas (Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked).Ou seja, não ficou nenhum “buraco” na planilha após os preenchimentos. Todas as colunas que irei usar no modelo estão completas.
#4 Aplicar a mesma lógica no TEST (no que couber aplicar)
if (exists("test")) {
test_pp <- test %>%
dplyr::select(dplyr::all_of(setdiff(vars_modelo, "Survived"))) %>%
mutate(
Pclass = as.integer(Pclass),
Sex = forcats::fct_drop(as.factor(Sex)),
Embarked = forcats::fct_drop(as.factor(Embarked)),
Age = as.numeric(Age),
Fare = as.numeric(Fare)
)
# Imputação numérica com as medianas calculadas do PRÓPRIO TEST por grupo;
# se faltar tudo no grupo, usa mediana global do TRAIN (evita vazamento forte).
# 1) Tenta pelo próprio test:
test_pp$Age <- imputa_num_grupo(test_pp, "Age")
# Fallback: se ainda tiver NA de Age, usa mediana do TRAIN já imputado
if(any(is.na(test_pp$Age))) {
test_pp$Age[is.na(test_pp$Age)] <- median(dados$Age, na.rm = TRUE)
}
# Fare: no test geralmente só 1 NA; usa mediana por classe no próprio test,
# senão cai para mediana geral do train.
if(any(is.na(test_pp$Fare))){
med_fare_por_classe <- test_pp %>% group_by(Pclass) %>%
summarize(m = median(Fare, na.rm = TRUE), .groups = "drop")
na_fare <- which(is.na(test_pp$Fare))
test_pp$Fare[na_fare] <- med_fare_por_classe$m[match(test_pp$Pclass[na_fare], med_fare_por_classe$Pclass)]
test_pp$Fare[is.na(test_pp$Fare)] <- median(dados$Fare, na.rm = TRUE)
}
# Embarked: modo do próprio test, senão modo do train
if(any(is.na(test_pp$Embarked))){
emb_mode_test <- mode_fast(na.omit(test_pp$Embarked))
if(is.na(emb_mode_test)) emb_mode_test <- mode_fast(na.omit(dados$Embarked))
test_pp$Embarked[is.na(test_pp$Embarked)] <- emb_mode_test
}
# Guardar objeto
test <- test_pp
}No código acima, mantive apenas as features do modelo (Pclass, Sex, Age, SibSp, Parch, Fare, Embarked) e converti os tipos: Pclass (inteiro/ordinal), Sex e Embarked (fatores com fct_drop), Age/Fare (numéricas).
Isso garante domínios/formatos compatíveis com o pipeline (dummies, escala e previsão) e eliminar níveis órfãos.
Para checagem: glimpse(test_pp); levels(test_pp\(Sex), levels(test_pp\)Embarked).
- Imputação de Age (numérica)
O que fiz: imputei Age pela mediana por grupo Pclass × Sex dentro do TEST; se a célula estava vazia, usei a mediana global do TRAIN como fallback.
A mediana é robusta a outliers; a estratificação preserva heterogeneidade condicional; o fallback evita NAs residuais sem induzir vazamento forte.
Checagem: sum(is.na(test_pp\(Age)) (= 0); summary(test_pp\)Age).
- Imputação de Fare (numérica)
Para NAs de Fare, usei a mediana por Pclass no TEST; se faltasse, apliquei a mediana global do TRAIN como fallback. No Titanic costuma faltar 1 Fare; a classe captura bem a estrutura de tarifas.
Checagem: sum(is.na(test_pp\(Fare)) (= 0); summary(test_pp\)Fare).
- Imputação de Embarked (categórica)
Aqui preenchi NAs com a moda do próprio TEST; se indisponível, usei a moda do TRAIN. A taxa de NA é muito baixa; a moda é um MAP simples e adequado para categóricas.
Checagem: sum(is.na(test_pp\(Embarked)) (= 0); table(test_pp\)Embarked, useNA=“ifany”).
- Consolidação
Aqui substituí test <- test_pp para usar o TEST já limpo e tipado nas etapas seguintes.
Checagem final: colSums(is.na(test)) (= 0 em todas as features).
# 5) Partição treino/validação com estratificação por Survived
set.seed(123)
idx_tr <- caret::createDataPartition(dados$Survived, p = 0.8, list = FALSE)
train_tr <- dados[idx_tr, ]
train_va <- dados[-idx_tr, ]
dim(train_tr); dim(train_va)## [1] 712 8## [1] 177 8table(train_tr$Survived); table(train_va$Survived)##
## 0 1
## 447 265##
## 0 1
## 102 75No código acima, fixei set.seed(123) para reprodutibilidade.
Usei createDataPartition(…, p=0.8) para separar 80% para treino (train_tr) e 20% para validação/holdout (train_va).
A partição é estratificada por Survived, isto é, tenta preservar a proporção de 0/1 nos dois subconjuntos.
Conferi o resultado com dim() (tamanhos) e table() (distribuição do alvo).
Assim, a estratificação reduz viés por desbalanceamento do alvo no split.
O holdout (train_va) fica intocado até a avaliação final, servindo como “dados novos”.
createDataPartition é preferível a um sample() simples, pois mantém melhor as proporções de classe.
Como interpretar a saída (do print):
dim(train_tr) = 712 × 8 e dim(train_va) = 177 × 8 → somam 889, igual ao dataset original.
table(train_tr$Survived) = 447 (0) e 265 (1) → ~37% de positivos no treino.
table(train_va$Survived) = 102 (0) e 75 (1) → ~42% de positivos no holdout.
Pequenas diferenças são normais; a estratificação é “aproximada”, mas mantém as proporções razoavelmente próximas.
# 6) Dummies para categóricas + padronização de numéricas (SEM resposta na fórmula)
# a) separe X e y no treino/validação
X_tr <- train_tr %>% dplyr::select(-Survived)
X_va <- train_va %>% dplyr::select(-Survived)
y_tr <- train_tr$Survived
y_va <- train_va$Survived
# b) Ajusta gerador de dummies só com preditores do TREINO
dmy <- caret::dummyVars(~ ., data = X_tr, fullRank = TRUE)
# c) Aplica dummies
x_tr <- predict(dmy, newdata = X_tr) %>% as.data.frame()
x_va <- predict(dmy, newdata = X_va) %>% as.data.frame()
# d) Padronização (center/scale) usando apenas parâmetros do treino
pp <- caret::preProcess(x_tr, method = c("center","scale"))
x_tr_sc <- predict(pp, x_tr)
x_va_sc <- predict(pp, x_va)
# e) (Opcional) preparar o TEST com o MESMO pipeline
if (exists("test")) {
X_te <- test %>% dplyr::select(-dplyr::any_of("Survived")) # só por segurança
x_te <- predict(dmy, newdata = X_te) %>% as.data.frame()
# alinhar para ter as MESMAS colunas do treino
faltam <- setdiff(colnames(x_tr_sc), colnames(x_te))
if(length(faltam)) x_te[ , faltam] <- 0
extras <- setdiff(colnames(x_te), colnames(x_tr_sc))
if(length(extras)) x_te <- x_te[ , setdiff(colnames(x_te), extras), drop = FALSE]
x_te <- x_te[ , colnames(x_tr_sc), drop = FALSE]
x_te_sc <- predict(pp, x_te)
}
# checagens rápidas
dim(x_tr_sc); dim(x_va_sc)## [1] 712 8## [1] 177 8anyNA(x_tr_sc); anyNA(x_va_sc)## [1] FALSE## [1] FALSEO que fiz acima (passo a passo):
Separei preditores e alvo: criei X_tr/X_va (apenas features) e y_tr/y_va (Survived).
Gerei dummies (one-hot) com dummyVars(~ ., data=X_tr, fullRank=TRUE) usando só o treino e sem a resposta na fórmula (evita o erro de ‘Survived not in newdata’).
Apliquei os dummies em treino/validação com predict(dmy, …), obtendo x_tr e x_va 100% numéricos.
Padronizei as colunas numéricas com preProcess ajustado no treino (center/scale) e apliquei aos demais conjuntos → x_tr_sc, x_va_sc.
Teste: gerei dummies com o mesmo dmy e alinhei as colunas ao treino
criei as que faltavam com 0, removi extras, e ordenei para ficar na mesma ordem de x_tr_sc; depois, apliquei a mesma padronização (pp) → x_te_sc.
Chequei: treino e validação têm o mesmo nº de colunas e nenhum NA.
Dessa forma, Dummies transformam categóricas em 0/1 para qualquer algoritmo aceitar (k-NN, SVM, RNA…).
fullRank=TRUE evita colinearidade perfeita (dummy trap).
Padronização (média 0, desvio 1) é essencial para modelos sensíveis à escala (k-NN, SVM, RNA) e não prejudica os demais.
Ajustar dmy e pp somente no treino evita data leakage.
O alinhamento de colunas garante que validação/teste tenham exatamente o mesmo espaço de features do treino.
Como interpretar a saída (dos prints):
dim(x_tr_sc) = 712 × 8 e dim(x_va_sc) = 177 × 8 → dimensões batem.
anyNA(x_tr_sc) e anyNA(x_va_sc) = FALSE → sem faltantes após o pipeline.
Por fim, vale destacar que árvores/RF não precisam de escala/dummies, mas usar o mesmo pipeline padroniza a comparação entre modelos.
3.2 Desenvolvimento de um classificador árvore de decisão
Nesse trabalho desenvolvi “dois tipos” de árvore.A árvore tipo 1 (rpart “pura”) treina/valida diretamente com rpart::rpart, avalia no hold-out, plota ROC, entre outros. É a versão artesanal, desenvolvida de forma mais controlável.
Por outro lado, a árvore tipo 2 (caret) é a mesma CART, mas treinada via caret::train(method = “rpart”), já com CV repetida e grade de cp (complexity parameter) para selecionar o melhor modelo. É a versão “pipeline” e comparável aos outros modelos.
Acho quer ter as duas faz sentido didaticamente: uma mostra a essência (passo a passo) do algoritmo; a outra integra boas práticas de reamostragem/tuning e facilita comparar com SVM/KNN/RF.
3.2.1 Classificador Árvore - Tipo 1
3.2.1.1 Treinando a árvore
Essa forma de desenvolvimento do classificador (Tipo 1) permite entender critérios de divisão, complexidade (cp), poda e visualização, com “rpart puro” (sem dummies/padronização).
Anteriormente, no pré-processamento dos dados, garanti que a resposta (Survived) fosse um fator binário com rótulos claros:
0 → “neg” (não sobreviveu)
1 → “pos” (sobreviveu)
Além disso, mantive preditores numéricos (Age, Fare, SibSp, Parch) e categóricos (Sex, Pclass, Embarked) já imputados/limpos na etapa anterior.
O rpart decide automaticamente entre regressão e classificação a partir da classe da variável resposta. Se Survived não for fator, ele faria regressão. E os níveis explícitos (“neg”, “pos”) facilitam métricas posteriores (sensibilidade, especificidade, ROC).
No código a seguir (abaixo) foi feito o seguinte: Chamei rpart() com method = “class” (classificação).
Nos controles (rpart.control) usei parâmetros permissivos para deixar a árvore crescer:
cp = 0.001 (penalidade por complexidade baixa → árvore cresce mais),
minsplit = 10 (mínimo de amostras para tentar um split),
minbucket = 5 (mínimo por folha),
maxdepth = 30 (profundidade bem alta).
E por que isso foi feito? Árvores tendem a superajustar se deixadas soltas.
A ideia é deixar crescer e podar depois com base em validação cruzada interna, que o rpart calcula automaticamente..
Assim, se houver sinais reais nos dados (ex.: Sex, Pclass), a árvore os captura; o passo de poda remove ramificações espúrias.
####Treinando a árvore “cheia” e inspecionando a tabela de complexidade####
library(rpart)
library(rpart.plot)
# Usei as variáveis já imputadas que estão em train_tr (tem Survived e preditores fatorados)
# Importante: Survived como fator para classificação
train_tr$Survived <- factor(train_tr$Survived, levels = c(0,1), labels = c("neg","pos"))
train_va$Survived <- factor(train_va$Survived, levels = c(0,1), labels = c("neg","pos"))
fit0 <- rpart(
Survived ~ Pclass + Sex + Age + SibSp + Parch + Fare + Embarked,
data = train_tr,
method = "class", # classificação (usando Gini)
control = rpart.control(
cp = 0.001, # cp pequeno para crescer bem
minsplit = 10, # mínimo para tentar split
minbucket = 5, # mínimo na folha
maxdepth = 30 # deixa crescer
)
)
printcp(fit0) # tabela de complexidade (cp, nsplit, rel error, xerror, xstd)##
## Classification tree:
## rpart(formula = Survived ~ Pclass + Sex + Age + SibSp + Parch +
## Fare + Embarked, data = train_tr, method = "class", control = rpart.control(cp = 0.001,
## minsplit = 10, minbucket = 5, maxdepth = 30))
##
## Variables actually used in tree construction:
## [1] Age Embarked Fare Pclass Sex SibSp
##
## Root node error: 265/712 = 0.37219
##
## n= 712
##
## CP nsplit rel error xerror xstd
## 1 0.4188679 0 1.00000 1.00000 0.048673
## 2 0.0358491 1 0.58113 0.58113 0.041456
## 3 0.0301887 3 0.50943 0.55849 0.040859
## 4 0.0188679 4 0.47925 0.53208 0.040127
## 5 0.0113208 5 0.46038 0.50566 0.039358
## 6 0.0094340 6 0.44906 0.50189 0.039245
## 7 0.0066038 8 0.43019 0.53208 0.040127
## 8 0.0056604 16 0.36981 0.52075 0.039802
## 9 0.0037736 21 0.33962 0.53962 0.040340
## 10 0.0018868 26 0.31698 0.50943 0.039470
## 11 0.0010000 28 0.31321 0.50189 0.039245plotcp(fit0) # gráfico do xerror vs cp
Passo a passo do que foi feito acima:
Pacotes: Carreguei rpart (CART) e rpart.plot (visualização).
Alvo como fator binário: Converti Survived para fator com níveis ordenados c(“neg”,“pos”) (0→neg, 1→pos).
Isso força o rpart a rodar classificação (não regressão) e facilita métricas como ROC/AUC depois.
Treino da árvore “cheia” :Fórmula: Survived ~ Pclass + Sex + Age + SibSp + Parch + Fare + Embarked.
method = “class” → critério de Gini.
Controle permissivo (crescimento livre):
cp = 0.001 (penalidade baixa, árvore cresce bem),
minsplit = 10 (mínimo para tentar split),
minbucket = 5 (mínimo em folha),
maxdepth = 30 (profundidade alta).
Ideia: deixar crescer e decidir a poda com base em validação cruzada interna do próprio rpart.
Inspeção da complexidade
printcp(fit0) mostra a cptable: para cada tamanho de árvore (número de splits nsplit) aparecem
CP (complexity parameter),
rel error (erro no treino),
xerror (erro de CV interna),
xstd (desvio do xerror).
plotcp(fit0) gera dois gráficos:
“size of tree” (acima): evolução do erro relativo conforme o tamanho (mais splits → erro de treino cai).
xerror vs cp (abaixo): curva principal para decidir a poda — buscamos o menor xerror (melhor generalização).
De que formas posso escolher o cp ótimo: Pela regra do menor xerror: selecionar o CP da linha com menor xerror (ponto mais baixo da curva).
Pela regra 1-SE (mais conservadora): escolher o maior CP cujo xerror esteja dentro de 1× xstd do mínimo (linha pontilhada do plotcp).
Depois, faz-se a poda: fit <- prune(fit0, cp = cp_opt).
Por que isso é importante: O cp controla o trade-off viés × variância. cp pequeno → árvore grande (pode overfit); cp maior → árvore menor (melhor generalização). O xerror da cptable é uma estimativa de desempenho fora da amostra via CV interna.
Em outras palavras,deixamos a árvore “falar tudo o que quiser” e depois cortamos os galhos que não ajudam quando olhamos para dados “novos”.
Leitura dos gráficos:
A curva xerror vs cp desce rápido nos primeiros pontos (ganhos reais) e depois estabiliza/oscila; o ponto mínimo da curva indica o cp ótimo. A linha pontilhada mostra a faixa 1-SE; se você quer uma árvore mais simples, escolha o cp mais à direita que ainda fique dentro dessa faixa.
Conclusão desta etapa: a árvore “cheia” foi treinada, a cptable e o plotcp foram usados para definir objetivamente o nível de poda (melhor balanceamento entre ajuste e generalização). Isso prepara a árvore final para avaliação justa e comparação com os demais classificadores.
3.2.1.2 Podando a árvore
###############Podando a árvore no cp ótimo##################
# pegar o cp com menor xerror
cp_opt <- fit0$cptable[ which.min(fit0$cptable[,"xerror"]) , "CP" ]
fit <- prune(fit0, cp = cp_opt)
rpart.plot(fit, type = 2, extra = 104, under = TRUE,
fallen.leaves = TRUE, cex = 0.8)
O que fiz acima:
Escolhi o cp ótimo pegando o menor xerror da cptable (validação cruzada interna do rpart).
Podei a árvore “cheia” com prune(fit0, cp = cp_opt), obtendo o modelo final.
Visualizei a árvore com rpart.plot:
type = 2: mostra a regra (condição) na aresta.
extra = 104: em cada nó folha, mostra classe prevista, probabilidade da classe positiva, e % de observações no nó.
under = TRUE, fallen.leaves = TRUE: layout mais legível.
cex = 0.8: reduz o tamanho do texto para caber.
O cp controla a complexidade (viés × variância). A poda no menor xerror maximiza a generalização segundo a CV interna.
A visualização facilita interpretar regras e explicar decisões (ponto forte das árvores).
Lendo o gráfico:
A raiz divide por Sex = male vs female (variável mais discriminante).
Ramo male: há regra com Age > 6.5 e SibSp >= 2, etc.
Ramo female: aparecem divisões por Pclass >= 3, Embarked = S, Age >= 29, etc.
Em cada folha:
rótulo “pos/neg” = classe prevista (survived / não).
número ao centro ≈ probabilidade estimada de sobreviver (classe positiva).
número abaixo = percentual de amostras do treino que caem nesse nó.
Exemplo (lá do plot): no ramo Sex = female & Pclass >= 3 & Age >= 29, a folha marca “pos” com prob. ~0.7 e ~9% das amostras — regra interpretável: mulheres, 3ª classe, mais velhas têm probabilidade intermediária de sobreviver; outras folhas mostram cenários com probabilidade maior/menor.
3.2.1.3 Validação
#################Avaliando no conjunto de validação###################
library(caret)
library(pROC)
# Probabilidades da classe positiva
prob_va <- predict(fit, newdata = train_va, type = "prob")[,"pos"]
pred_va <- factor(ifelse(prob_va >= 0.5, "pos", "neg"), levels = c("neg","pos"))
# Matriz de confusão
confusionMatrix(pred_va, train_va$Survived, positive = "pos")## Confusion Matrix and Statistics
##
## Reference
## Prediction neg pos
## neg 98 28
## pos 4 47
##
## Accuracy : 0.8192
## 95% CI : (0.7545, 0.8729)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 5.336e-12
##
## Kappa : 0.6134
##
## Mcnemar's Test P-Value : 4.785e-05
##
## Sensitivity : 0.6267
## Specificity : 0.9608
## Pos Pred Value : 0.9216
## Neg Pred Value : 0.7778
## Prevalence : 0.4237
## Detection Rate : 0.2655
## Detection Prevalence : 0.2881
## Balanced Accuracy : 0.7937
##
## 'Positive' Class : pos
## # ROC e AUC
roc_va <- pROC::roc(response = train_va$Survived, predictor = prob_va, levels = c("neg","pos"))
pROC::auc(roc_va)## Area under the curve: 0.8297No código acima foi feito o seguinte:
predict(…, type=“prob”) → devolve probabilidades de cada classe; usei a de “pos” (sobreviveu). Por quê: métricas como ROC/AUC e threshold tuning exigem probs, não apenas rótulos.
Threshold 0.5 → converte probabilidade em classe prevista. Por quê: é o corte padrão; depois é possível otimizar (ex.: Youden-J, custo, sensibilidade mínima etc.).
confusionMatrix → calcula Accuracy, Kappa, Sensitivity (Recall da classe pos), Specificity, PPV/NPV, Balanced Accuracy e NIR. Por quê: dá uma visão completa do desempenho no holdout.
ROC/AUC com pROC → mede separação entre classes independente do limiar. Por quê: é estável sob desbalanceamento moderado e útil para comparar modelos.
Interpretando os resultados:
Matriz de confusão (pos=“pos”)
Verdadeiros Positivos (TP): 47
Falsos Positivos (FP): 4
Falsos Negativos (FN): 28
Verdadeiros Negativos (TN): 98
Accuracy = 0.8192 (IC95% ≈ 0.7545–0.8729) Melhora substancial sobre o NIR = 0.5763 (acertar sempre a classe maior).
Kappa = 0.6134 Concordância substancial, além do acaso.
Sensitivity (Recall da classe positiva) = 0.6267 Captura ~63% dos sobreviventes.
Specificity = 0.9608 Erra pouquíssimos não-sobreviventes (ótima “regra de triagem” para negativos).
PPV = 0.9216 / NPV = 0.7778 Quando prevê “sobrevive”, acerta 92% das vezes.
Balanced Accuracy = 0.7937 Média de Sensitivity e Specificity (útil com classes desbalanceadas).
AUC = 0.8297 Excelente discriminabilidade: a árvore ordena bem “pos” acima de “neg” sem fixar um corte.
Conclusão:
A árvore podada apresenta AUC ≈ 0.83 e Accuracy ≈ 0.82 no holdout, com Specificity muito alta (0.96) e Sensitivity moderada (0.63) no corte 0.5. Ou seja, o modelo quase não gera falsos positivos, mas deixa passar alguns positivos.
3.2.1.3.1 Otimizando o limiar de decisão (Youden) no hold-out
### Otimizando o limiar de decisão (Youden) no hold-out ----
library(pROC)
library(caret)
# 1) Probabilidades da classe positiva no hold-out
prob_va <- predict(fit, newdata = train_va, type = "prob")[,"pos"]
# 2) Curva ROC e AUC (garantindo a ordem de níveis)
roc_va <- pROC::roc(response = train_va$Survived,
predictor = prob_va,
levels = c("neg","pos"))
auc_va <- pROC::auc(roc_va)
# 3) Limiar ótimo pelo índice de Youden (maximiza Sens + Spec - 1)
best_youden <- pROC::coords(
roc_va,
x = "best",
input = "threshold",
best.method = "youden",
ret = c("threshold","sensitivity","specificity","accuracy","ppv","npv"),
transpose = FALSE
)
thr_opt <- as.numeric(best_youden$threshold)
# 4) Comparar 0.5 x limiar ótimo
pred_05 <- factor(ifelse(prob_va >= 0.5, "pos","neg"), levels = c("neg","pos"))
pred_opt <- factor(ifelse(prob_va >= thr_opt,"pos","neg"), levels = c("neg","pos"))
cm_05 <- caret::confusionMatrix(pred_05, train_va$Survived, positive = "pos")
cm_opt <- caret::confusionMatrix(pred_opt, train_va$Survived, positive = "pos")
# 5) Tabela-resumo de métricas no hold-out
comp_cut <- data.frame(
Cutoff = c(0.50, round(thr_opt, 4)),
Accuracy = c(cm_05$overall["Accuracy"], cm_opt$overall["Accuracy"]),
Kappa = c(cm_05$overall["Kappa"], cm_opt$overall["Kappa"]),
Sens = c(cm_05$byClass["Sensitivity"], cm_opt$byClass["Sensitivity"]),
Spec = c(cm_05$byClass["Specificity"], cm_opt$byClass["Specificity"]),
PPV = c(cm_05$byClass["Pos Pred Value"], cm_opt$byClass["Pos Pred Value"]),
NPV = c(cm_05$byClass["Neg Pred Value"], cm_opt$byClass["Neg Pred Value"])
)
print(round(comp_cut, 4), row.names = FALSE)## Cutoff Accuracy Kappa Sens Spec PPV NPV
## 0.5000 0.8192 0.6134 0.6267 0.9608 0.9216 0.7778
## 0.5649 0.8192 0.6134 0.6267 0.9608 0.9216 0.7778# 6) Plot ROC com o ponto do limiar ótimo
plot(roc_va, col = "black", lwd = 2,
main = sprintf("Árvore tipo 1 — ROC (hold-out) | AUC = %.3f", auc_va))
points(1 - best_youden$specificity, best_youden$sensitivity,
pch = 19, cex = 1.2)
text(1 - best_youden$specificity, best_youden$sensitivity,
labels = sprintf(" thr=%.3f", thr_opt), pos = 4)
# 7) Mostrar matrizes de confusão
cat("\nMatriz com cutoff 0.50:\n"); print(cm_05$table)##
## Matriz com cutoff 0.50:## Reference
## Prediction neg pos
## neg 98 28
## pos 4 47cat("\nMatriz com cutoff ótimo (Youden):\n"); print(cm_opt$table)##
## Matriz com cutoff ótimo (Youden):## Reference
## Prediction neg pos
## neg 98 28
## pos 4 47# Guardar para o relatório
roc_tree1_va <- roc_va
thr_tree1_opt <- thr_opt
cm_tree1_opt <- cm_optO que o código acima faz:
- Garante dependências e objetos já existentes O chunk assume que já se tem: o modelo treinado (fit) da sua árvore tipo 1, o conjunto de validação train_va com a coluna-verdade Survived fator em c(“neg”,“pos”), as probabilidades preditas no hold-out, prob_va (probabilidade da classe “pos”). Se prob_va ainda não existir, o chunk costuma recalculá-la com:
em
prob_va <- predict(fit, newdata = train_va, type = "prob")[, "pos"]
e também monta roc_va (objeto pROC::roc) para aproveitar
a curva ROC que já vinha sendo usada.
- Calcula o limiar ótimo (Youden’s J) Em vez de usar o corte padrão 0,5, o chunk acima procura o cutoff que maximiza Sens + Spec − 1 (o índice de Youden). Isso cria um equilíbrio “ótimo” entre sensibilidade e especificidade para o seu conjunto de validação:
em
thr_youden <- pROC::coords(roc_va, "best", best.method = "youden", ret =
c("threshold","sensitivity","specificity"))
cut_opt <- thr_youden["threshold"]
- Compara 0,5 vs. cutoff ótimo O chunk gera duas classificações:
pred_05 <- factor(ifelse(prob_va >= 0.5, "pos","neg"), levels = c("neg","pos"))
pred_opt <- factor(ifelse(prob_va >= cut_opt,"pos","neg"), levels = c("neg","pos"))
e calcula as duas matrizes de confusão (com caret::confusionMatrix), extraindo as métricas (Accuracy, Sensibilidade, Especificidade, e às vezes Pos/Neg Pred Value). Assim é possível ver se valeu a pena trocar o 0,5 pelo ponto de Youden.
- Plota a ROC com o ponto ótimo marcado. Ele redesenha a curva ROC do hold-out e coloca um marcador no cutoff ótimo, para se visualizar onde a decisão está operando:
em
plot(roc_va, col = "black", lwd = 2, main = "Árvore (hold-out) – ROC e cutoff ótimo (Youden)")
points(1 - thr_youden["specificity"], thr_youden["sensitivity"], pch = 19) abline(0,1,lty=3)
(Lembrete: no gráfico ROC, o eixo X é 1 − especificidade.)
Opcionalmente, uma Tabelinha resumo com as métricas para cutoff = 0.5 e cutoff = ótimo
res <- rbind(
cutoff_0.5 = c(Acc = acc_05, Sens = sens_05, Spec = spec_05),
cutoff_opt = c(Acc = acc_op, Sens = sens_op, Spec = spec_op)
)knitr::kable(round(res, 4))`
(Os nomes acc_05, sens_05, etc., vêm do confusionMatrix.)
Portanto, a AUC 0,83 confirma que a árvore tipo 1 aprendeu um padrão real na base (ela separa bem “sobreviveu” vs “não sobreviveu”).
Ajustar o cutoff a 0,565 evita usar cegamente o 0,5 e adapta o classificador ao objetivo:
Se for equilíbrio entre erros (falsos positivos vs falsos negativos), Youden é uma justificativa padrão e sólida.
Se quisermos priorizar Sens (não perder sobreviventes),
pode-se escolher um cutoff mais baixo que o ótimo.
Se priorizar-mos Spec (evitar “falsos sobreviventes”),
pode-se subir o cutoff além do ótimo.
O gráfico com o ponto marcado comunica bem essa escolha: mostra-se onde na ROC se está operando e o porquê.
3.2.1.4 Importância das variáveis
###########Importância das variáveis#####################
varImp <- as.data.frame(fit$variable.importance)
names(varImp) <- "Importance"
varImp[order(-varImp$Importance), , drop = FALSE]## Importance
## Sex 93.614070
## Pclass 25.533601
## Age 20.775353
## Embarked 13.532192
## Fare 10.288354
## SibSp 9.434314
## Parch 7.905355Acima, Inspecionei fit$variable.importance e listei em ordem decrescente.
Assim, a árvore atribui importância com base na redução de impureza acumulada (quanto uma variável ajudou a “limpar” os nós).
No Titanic, tipicamente, Sex, Pclass, Fare e Age aparecem entre as primeiras — ótimo insight e também contribui em discutir por que certos grupos tiveram maior chance de sobreviver.
3.2.1.5 Conclusões
Portanto, o que posso dizer sobre esse classificador: Usei a base do Titanic para prever sobrevivência. Primeiro, transformei a variável-alvo Survived em um fator binário com rótulos claros (‘neg’ = não sobreviveu, ‘pos’ = sobreviveu). Treinei uma árvore de decisão (CART) no R (rpart) usando o critério de Gini, que mede o quão misturados estão os casos dentro de cada nó — quanto menor o Gini, mais ‘puro’ o grupo.
Deixei a árvore crescer bastante (cp pequeno) e depois escolhi o cp ótimo com base no menor erro de validação cruzada interna (xerror); em seguida podei a árvore nesse ponto para evitar overfitting.
Avaliei no conjunto de validação (holdout) medindo AUC (capacidade de separar ‘pos’ de ‘neg’ independente do corte) e também a matriz de confusão em corte 0,5 (acurácia, sensibilidade, especificidade).
Posteriormente, otimizei o limiar de decisão (Youden) no hold-out: Para a Árvore tipo 1, no hold-out obtivemos AUC=0,830. Otimizamos o limiar de decisão pelo índice de Youden (cutoff≈0,565), o que nos deu um equilíbrio melhor entre sensibilidade e especificidade do que o corte padrão 0,5. A ROC com o ponto ótimo e a comparação de métricas (Accuracy, Sens, Spec) suportam essa escolha.”
Em termos de variáveis, os fatores mais influentes foram Sex (mulheres tendem a sobreviver mais), Pclass (1ª classe tem maior chance), e Fare/Age ajudam a refinar as decisões. Cabin é muito ausente e foi evitada para não introduzir viés.
Variáveis que mais pesaram:
Sex: maior taxa de sobrevivência para mulheres (coerente com o contexto histórico).
Pclass: 1ª classe > 2ª > 3ª em probabilidade de sobrevivência.
Fare: tarifas mais altas (associadas a Pclass melhor) tendem a aumentar a chance.
Age: diferença entre faixas etárias; crianças podem ter vantagem relativa.
3.2.2 Classificador Árvore - Tipo 2
Nota: esse será o classificador árvore de decisão (Tipo 2) a ser comparado com os demais classificadores
3.2.2.1 Cotrolando o treino
Agora irei usar nesse classificador (Tipo 2) o mesmo conjunto com fatores (sem dummies/padronização) e deixar o caret buscar o melhor cp por CV 5×3.
O objetivo desse classificador é treinar e comparar modelos usando um protocolo único e justo. Ele padroniza todo o processo de comparação entre modelos de classificação, usando para isso:
Validação cruzada (CV) igual para todos (ex.: 5 dobras × 3 repetições) para reduzir “sorte”/viés de um único corte.
Métrica principal = AUC/ROC (capacidade de separar positivos e negativos sem depender do limiar 0,5). É estável com leve desbalanceamento.
Busca de hiperparâmetros (grid search) dentro da CV para cada algoritmo (árvore, k-NN, Naive, SVM, redes, RF), escolhendo a melhor configuração de forma justa e replicável.
Holdout (a parte separada do treino) para confirmar o desempenho fora da CV (generalização).
Em tese, temos o seguinte: treina-se cada modelo “muitas vezes” com diferentes fatias do dado (CV), escolhe-se o melhor ajuste por AUC, e depois confere em dados novos (holdout). Isso evita conclusões baseadas em “sorte” de um único corte dos dados, e garantirá que a comparação entre algoritmos seja justa e replicável. Logo, esse que será o classificador árvore de decisão a ser comparado com os demais classificadores.
#########Preparando os dados e controlando o treino#############
library(caret)
# Dados de treino para caret (fatores + numéricas)
df_tr <- train_tr
df_tr$Survived <- factor(df_tr$Survived, levels = c("neg","pos")) # já está
# Controle de treino
ctrl_cv <- trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary, # para ROC
savePredictions = "final"
)
# grade de cp a testar
grid_cp <- data.frame(cp = seq(0.000, 0.05, by = 0.002))No chunk acima, temos a Resposta como fator binário Survived vira fator c(“neg”,“pos”) — requisito do caret para usar twoClassSummary (calcula ROC, Sensibilidade, Especificidade).
Esquema de validação cruzada:
method=“repeatedcv”, number=5, repeats=3 → CV 5×3 (15 avaliações por configuração).
Isso deve ser feito, pois traz estimativa estável de desempenho médio e desvio (variância) com custo moderado.
Métrica principal: ROC/AUC
classProbs=TRUE + twoClassSummary → o caret usa AUC (ROC) como métrica de seleção (salvo se você definir metric=“ROC” no train).
Vale destacar que AUC é independente de limiar e robusta ao desbalanceamento moderado do Titanic.
Salvando predições:
savePredictions=“final” guarda as predições da melhor configuração (útil para diagnósticos e gráficos depois).
Grade de cp (complexity parameter)
cp controla a poda/complexidade da árvore.
Testei valores de 0.000 a 0.050 de 0.002 em 0.002 (grade fina no começo, ampla o suficiente para ver o “joelho” da curva), pois devemos escolher o cp que maximiza AUC na CV (melhor generalização).
3.2.2.2 Treinando a árvore com caret
#######Treinando a árvore com caret::train(method="rpart")##########
set.seed(123)
tree_caret <- caret::train(
Survived ~ Pclass + Sex + Age + SibSp + Parch + Fare + Embarked,
data = df_tr,
method = "rpart",
trControl = ctrl_cv,
tuneGrid = grid_cp,
metric = "ROC" # escolhe o cp que maximiza AUC-ROC
)
tree_caret## CART
##
## 712 samples
## 7 predictor
## 2 classes: 'neg', 'pos'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 570, 570, 569, 570, 569, 570, ...
## Resampling results across tuning parameters:
##
## cp ROC Sens Spec
## 0.000 0.8205711 0.8649854 0.6603774
## 0.002 0.8216594 0.8672326 0.6603774
## 0.004 0.8169138 0.8717020 0.6515723
## 0.006 0.8138574 0.8821057 0.6452830
## 0.008 0.8074807 0.8948148 0.6276730
## 0.010 0.8030129 0.9134831 0.6113208
## 0.012 0.7981334 0.9239284 0.6050314
## 0.014 0.7981334 0.9239284 0.6050314
## 0.016 0.7934855 0.9336413 0.5987421
## 0.018 0.7972167 0.9336413 0.6025157
## 0.020 0.7970070 0.9358635 0.6012579
## 0.022 0.7970070 0.9358635 0.6012579
## 0.024 0.7970070 0.9358635 0.6012579
## 0.026 0.7901796 0.9188265 0.6100629
## 0.028 0.7901796 0.9188265 0.6100629
## 0.030 0.7787175 0.8897129 0.6238994
## 0.032 0.7740394 0.8822222 0.6264151
## 0.034 0.7725602 0.8837120 0.6226415
## 0.036 0.7725602 0.8837120 0.6226415
## 0.038 0.7687901 0.8755306 0.6314465
## 0.040 0.7687901 0.8755306 0.6314465
## 0.042 0.7667007 0.8696047 0.6389937
## 0.044 0.7585096 0.8493883 0.6691824
## 0.046 0.7585096 0.8493883 0.6691824
## 0.048 0.7601379 0.8523512 0.6679245
## 0.050 0.7601379 0.8523512 0.6679245
##
## ROC was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.002.plot(tree_caret) # ROC por cp
Acima foi feito o treino com validação cruzada repetida (5×3): ctrl_cv já define classProbs=TRUE e twoClassSummary, então o caret calcula AUC (ROC), Sens e Spec em cada fold e média.
Busca do hiperparâmetro cp na grade grid_cp: o train re-treina a árvore para cada valor de cp.
Seleção do melhor modelo: metric=“ROC” faz o caret escolher o cp que maximiza a AUC média de CV.
plot(tree_caret): gráfico da AUC média (e erro padrão) em função de cp. A queda da curva sinaliza overpruning (árvore simples demais).
Interpretando os gráficos:
A AUC média começa mais alta com cp pequeno (árvore mais expressiva) e cai conforme cp cresce (árvore vai sendo podada). O pico da curva indica o cp ótimo segundo CV; esse é o modelo que o caret salva em tree_caret$finalModel.
tree_caret$bestTune: valor de cp escolhido.
max(tree_caret\(results\)ROC): AUC média de CV do melhor cp (com desvio padrão em ROCSD).
3.2.2.3 Visualizando a árvore final e interpretando cp
#########Visualizando a árvore final e interpretando cp############
best_cp <- tree_caret$bestTune$cp
best_cp## [1] 0.002final_tree <- tree_caret$finalModel
rpart.plot(final_tree, type = 2, extra = 104, under = TRUE, fallen.leaves = TRUE)
printcp(final_tree)##
## Classification tree:
## (function (formula, data, weights, subset, na.action = na.rpart,
## method, model = FALSE, x = FALSE, y = TRUE, parms, control,
## cost, ...)
## {
## Call <- match.call()
## if (is.data.frame(model)) {
## m <- model
## model <- FALSE
## }
## else {
## indx <- match(c("formula", "data", "weights", "subset"),
## names(Call), nomatch = 0)
## if (indx[1] == 0)
## stop("a 'formula' argument is required")
## temp <- Call[c(1, indx)]
## temp$na.action <- na.action
## temp[[1]] <- quote(stats::model.frame)
## m <- eval.parent(temp)
## }
## Terms <- attr(m, "terms")
## if (any(attr(Terms, "order") > 1))
## stop("Trees cannot handle interaction terms")
## Y <- model.response(m)
## wt <- model.weights(m)
## if (any(wt < 0))
## stop("negative weights not allowed")
## if (!length(wt))
## wt <- rep(1, nrow(m))
## offset <- model.offset(m)
## X <- rpart.matrix(m)
## nobs <- nrow(X)
## nvar <- ncol(X)
## if (missing(method)) {
## method <- if (is.factor(Y) || is.character(Y))
## "class"
## else if (inherits(Y, "Surv"))
## "exp"
## else if (is.matrix(Y))
## "poisson"
## else "anova"
## }
## if (is.list(method)) {
## mlist <- method
## method <- "user"
## init <- if (missing(parms))
## mlist$init(Y, offset, wt = wt)
## else mlist$init(Y, offset, parms, wt)
## keep <- rpartcallback(mlist, nobs, init)
## method.int <- 4
## parms <- init$parms
## }
## else {
## method.int <- pmatch(method, c("anova", "poisson", "class",
## "exp"))
## if (is.na(method.int))
## stop("Invalid method")
## method <- c("anova", "poisson", "class", "exp")[method.int]
## if (method.int == 4)
## method.int <- 2
## init <- if (missing(parms))
## get(paste("rpart", method, sep = "."), envir = environment())(Y,
## offset, , wt)
## else get(paste("rpart", method, sep = "."), envir = environment())(Y,
## offset, parms, wt)
## ns <- asNamespace("rpart")
## if (!is.null(init$print))
## environment(init$print) <- ns
## if (!is.null(init$summary))
## environment(init$summary) <- ns
## if (!is.null(init$text))
## environment(init$text) <- ns
## }
## Y <- init$y
## xlevels <- .getXlevels(Terms, m)
## cats <- rep(0, ncol(X))
## if (!is.null(xlevels)) {
## indx <- match(names(xlevels), colnames(X), nomatch = 0)
## cats[indx] <- (unlist(lapply(xlevels, length)))[indx >
## 0]
## }
## extraArgs <- list(...)
## if (length(extraArgs)) {
## controlargs <- names(formals(rpart.control))
## indx <- match(names(extraArgs), controlargs, nomatch = 0)
## if (any(indx == 0))
## stop(gettextf("Argument %s not matched", names(extraArgs)[indx ==
## 0]), domain = NA)
## }
## controls <- rpart.control(...)
## if (!missing(control)) {
## if (!all(names(control) %in% names(controls)))
## stop("unkown named elements in 'control'")
## controls <- do.call(rpart.control, control)
## }
## xval <- controls$xval
## if (is.null(xval) || (length(xval) == 1 && xval == 0) ||
## method == "user") {
## xgroups <- 0
## xval <- 0
## }
## else if (length(xval) == 1) {
## xgroups <- sample(rep(1:xval, length.out = nobs), nobs,
## replace = FALSE)
## }
## else if (length(xval) == nobs) {
## xgroups <- xval
## xval <- length(unique(xgroups))
## }
## else {
## if (!is.null(attr(m, "na.action"))) {
## temp <- as.integer(attr(m, "na.action"))
## xval <- xval[-temp]
## if (length(xval) == nobs) {
## xgroups <- xval
## xval <- length(unique(xgroups))
## }
## else stop("Wrong length for 'xval'")
## }
## else stop("Wrong length for 'xval'")
## }
## if (missing(cost))
## cost <- rep(1, nvar)
## else {
## if (length(cost) != nvar)
## stop("Cost vector is the wrong length")
## if (any(cost <= 0))
## stop("Cost vector must be positive")
## }
## tfun <- function(x) if (is.matrix(x))
## rep(is.ordered(x), ncol(x))
## else is.ordered(x)
## labs <- sub("^`(.*)`$", "\\1", attr(Terms, "term.labels"))
## isord <- unlist(lapply(m[labs], tfun))
## storage.mode(X) <- "double"
## storage.mode(wt) <- "double"
## temp <- as.double(unlist(init$parms))
## if (!length(temp))
## temp <- 0
## rpfit <- .Call(C_rpart, ncat = as.integer(cats * !isord),
## method = as.integer(method.int), as.double(unlist(controls)),
## temp, as.integer(xval), as.integer(xgroups), as.double(t(init$y)),
## X, wt, as.integer(init$numy), as.double(cost))
## nsplit <- nrow(rpfit$isplit)
## ncat <- if (!is.null(rpfit$csplit))
## nrow(rpfit$csplit)
## else 0
## if (nsplit == 0)
## xval <- 0
## numcp <- ncol(rpfit$cptable)
## temp <- if (nrow(rpfit$cptable) == 3)
## c("CP", "nsplit", "rel error")
## else c("CP", "nsplit", "rel error", "xerror", "xstd")
## dimnames(rpfit$cptable) <- list(temp, 1:numcp)
## tname <- c("<leaf>", colnames(X))
## splits <- matrix(c(rpfit$isplit[, 2:3], rpfit$dsplit), ncol = 5,
## dimnames = list(tname[rpfit$isplit[, 1] + 1], c("count",
## "ncat", "improve", "index", "adj")))
## index <- rpfit$inode[, 2]
## nadd <- sum(isord[rpfit$isplit[, 1]])
## if (nadd > 0) {
## newc <- matrix(0, nadd, max(cats))
## cvar <- rpfit$isplit[, 1]
## indx <- isord[cvar]
## cdir <- splits[indx, 2]
## ccut <- floor(splits[indx, 4])
## splits[indx, 2] <- cats[cvar[indx]]
## splits[indx, 4] <- ncat + 1:nadd
## for (i in 1:nadd) {
## newc[i, 1:(cats[(cvar[indx])[i]])] <- -as.integer(cdir[i])
## newc[i, 1:ccut[i]] <- as.integer(cdir[i])
## }
## catmat <- if (ncat == 0)
## newc
## else {
## cs <- rpfit$csplit
## ncs <- ncol(cs)
## ncc <- ncol(newc)
## if (ncs < ncc)
## cs <- cbind(cs, matrix(0, nrow(cs), ncc - ncs))
## rbind(cs, newc)
## }
## ncat <- ncat + nadd
## }
## else catmat <- rpfit$csplit
## if (nsplit == 0) {
## frame <- data.frame(row.names = 1, var = "<leaf>", n = rpfit$inode[,
## 5], wt = rpfit$dnode[, 3], dev = rpfit$dnode[, 1],
## yval = rpfit$dnode[, 4], complexity = rpfit$dnode[,
## 2], ncompete = 0, nsurrogate = 0)
## }
## else {
## temp <- ifelse(index == 0, 1, index)
## svar <- ifelse(index == 0, 0, rpfit$isplit[temp, 1])
## frame <- data.frame(row.names = rpfit$inode[, 1], var = tname[svar +
## 1], n = rpfit$inode[, 5], wt = rpfit$dnode[, 3],
## dev = rpfit$dnode[, 1], yval = rpfit$dnode[, 4],
## complexity = rpfit$dnode[, 2], ncompete = pmax(0,
## rpfit$inode[, 3] - 1), nsurrogate = rpfit$inode[,
## 4])
## }
## if (method.int == 3) {
## numclass <- init$numresp - 2
## nodeprob <- rpfit$dnode[, numclass + 5]/sum(wt)
## temp <- pmax(1, init$counts)
## temp <- rpfit$dnode[, 4 + (1:numclass)] %*% diag(init$parms$prior/temp)
## yprob <- temp/rowSums(temp)
## yval2 <- matrix(rpfit$dnode[, 4 + (0:numclass)], ncol = numclass +
## 1)
## frame$yval2 <- cbind(yval2, yprob, nodeprob)
## }
## else if (init$numresp > 1)
## frame$yval2 <- rpfit$dnode[, -(1:3), drop = FALSE]
## if (is.null(init$summary))
## stop("Initialization routine is missing the 'summary' function")
## functions <- if (is.null(init$print))
## list(summary = init$summary)
## else list(summary = init$summary, print = init$print)
## if (!is.null(init$text))
## functions <- c(functions, list(text = init$text))
## if (method == "user")
## functions <- c(functions, mlist)
## where <- rpfit$which
## names(where) <- row.names(m)
## ans <- list(frame = frame, where = where, call = Call, terms = Terms,
## cptable = t(rpfit$cptable), method = method, parms = init$parms,
## control = controls, functions = functions, numresp = init$numresp)
## if (nsplit)
## ans$splits = splits
## if (ncat > 0)
## ans$csplit <- catmat + 2
## if (nsplit)
## ans$variable.importance <- importance(ans)
## if (model) {
## ans$model <- m
## if (missing(y))
## y <- FALSE
## }
## if (y)
## ans$y <- Y
## if (x) {
## ans$x <- X
## ans$wt <- wt
## }
## ans$ordered <- isord
## if (!is.null(attr(m, "na.action")))
## ans$na.action <- attr(m, "na.action")
## if (!is.null(xlevels))
## attr(ans, "xlevels") <- xlevels
## if (method == "class")
## attr(ans, "ylevels") <- init$ylevels
## class(ans) <- "rpart"
## ans
## })(formula = .outcome ~ ., data = list(c(1, 1, 3, 3, 3, 3, 2,
## 3, 3, 3, 2, 3, 3, 3, 2, 3, 1, 3, 3, 3, 3, 1, 3, 2, 1, 1, 3, 3,
## 3, 3, 3, 2, 3, 3, 3, 3, 3, 3, 3, 3, 1, 2, 1, 1, 2, 3, 2, 3, 3,
## 1, 3, 2, 3, 3, 3, 2, 3, 2, 3, 3, 3, 3, 2, 3, 3, 3, 1, 2, 3, 3,
## 1, 3, 3, 3, 3, 3, 3, 1, 2, 2, 3, 1, 3, 3, 3, 3, 3, 3, 1, 3, 3,
## 3, 3, 3, 3, 2, 1, 3, 2, 3, 2, 2, 1, 3, 3, 3, 3, 3, 3, 3, 2, 2,
## 1, 1, 3, 1, 3, 3, 2, 1, 3, 3, 1, 3, 3, 3, 3, 2, 3, 3, 3, 3, 1,
## 3, 1, 3, 1, 3, 3, 3, 1, 3, 1, 2, 3, 3, 2, 3, 1, 3, 1, 3, 3, 2,
## 2, 2, 1, 3, 3, 2, 3, 3, 3, 3, 3, 3, 3, 3, 1, 3, 2, 3, 3, 1, 2,
## 1, 2, 3, 2, 3, 3, 1, 3, 2, 3, 2, 3, 1, 3, 2, 2, 3, 2, 2, 2, 2,
## 3, 3, 2, 3, 3, 3, 3, 3, 1, 3, 1, 1, 1, 2, 3, 3, 1, 1, 3, 2, 3,
## 1, 1, 3, 1, 3, 1, 3, 2, 3, 3, 3, 3, 3, 1, 3, 3, 2, 3, 1, 1, 2,
## 3, 1, 1, 1, 1, 3, 3, 3, 2, 3, 1, 1, 2, 1, 1, 1, 2, 3, 2, 3, 2,
## 2, 1, 3, 2, 2, 3, 2, 3, 3, 1, 1, 1, 1, 1, 3, 1, 2, 2, 2, 2, 2,
## 3, 3, 3, 3, 3, 3, 3, 3, 1, 2, 3, 3, 2, 3, 3, 3, 3, 1, 3, 1, 3,
## 1, 1, 3, 3, 1, 3, 3, 1, 3, 3, 3, 2, 1, 3, 3, 1, 3, 3, 2, 2, 2,
## 3, 3, 3, 3, 3, 2, 2, 3, 3, 3, 1, 2, 3, 3, 2, 2, 2, 3, 3, 3, 3,
## 3, 2, 3, 3, 1, 3, 3, 1, 1, 3, 2, 1, 2, 3, 3, 3, 1, 2, 1, 3, 2,
## 3, 1, 1, 3, 1, 1, 2, 3, 3, 1, 2, 3, 3, 2, 3, 3, 2, 2, 3, 1, 2,
## 3, 3, 3, 2, 3, 3, 1, 3, 1, 3, 3, 3, 1, 1, 3, 3, 1, 3, 1, 3, 3,
## 3, 1, 2, 1, 3, 3, 3, 3, 1, 3, 2, 3, 2, 3, 3, 3, 1, 3, 3, 2, 1,
## 3, 2, 3, 3, 3, 1, 3, 1, 1, 3, 3, 2, 1, 1, 2, 3, 1, 3, 3, 3, 1,
## 1, 1, 3, 3, 3, 2, 3, 3, 3, 3, 3, 3, 2, 1, 1, 3, 3, 3, 2, 3, 3,
## 1, 2, 3, 1, 1, 3, 3, 3, 1, 3, 3, 2, 3, 2, 3, 3, 1, 2, 3, 1, 3,
## 1, 3, 1, 3, 3, 3, 3, 3, 2, 3, 2, 2, 3, 1, 3, 3, 2, 1, 3, 3, 1,
## 3, 1, 1, 3, 2, 3, 2, 3, 1, 3, 3, 1, 3, 1, 3, 3, 3, 3, 3, 2, 3,
## 3, 2, 1, 3, 3, 3, 2, 2, 3, 3, 2, 1, 2, 2, 2, 3, 3, 3, 1, 3, 3,
## 3, 2, 2, 3, 3, 1, 3, 3, 1, 3, 1, 3, 1, 1, 3, 3, 2, 2, 1, 1, 3,
## 1, 1, 1, 2, 3, 1, 3, 2, 2, 1, 2, 3, 2, 3, 1, 3, 2, 2, 2, 3, 3,
## 1, 3, 1, 3, 3, 1, 2, 3, 2, 3, 3, 3, 2, 2, 3, 2, 3, 1, 3, 3, 3,
## 1, 3, 3, 3, 3, 3, 2, 3, 3, 3, 3, 1, 3, 1, 3, 3, 3, 1, 3, 2, 1,
## 3, 1, 3, 3, 3, 2, 2, 3, 3, 3, 1, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3,
## 3, 1, 3, 3, 3, 2, 3, 2, 3, 3, 1, 3, 3, 1, 3, 2, 1, 3, 3, 3, 3,
## 3, 2, 1, 3, 3, 1, 2, 3, 1, 3, 3, 3, 1, 2, 2, 2, 1, 3, 3, 1, 1,
## 3, 3, 3, 1, 3, 3, 2, 3, 2, 1, 1, 3), c(0, 0, 1, 1, 1, 0, 0, 0,
## 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0,
## 0, 0, 0, 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 1, 1, 1,
## 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 0,
## 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0,
## 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 0,
## 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0,
## 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1,
## 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 1, 0,
## 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1, 1, 0,
## 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 0,
## 1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1,
## 1, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1,
## 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0,
## 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0,
## 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1,
## 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1,
## 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1,
## 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1,
## 0, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0,
## 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 1,
## 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0,
## 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 0,
## 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1,
## 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1,
## 1, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 0,
## 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1,
## 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0,
## 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1,
## 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1,
## 0, 1, 1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1,
## 0, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1,
## 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1,
## 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1,
## 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1), c(38, 35, 35, 28, 2, 27, 14,
## 4, 20, 39, 55, 2, 31, 28, 35, 15, 28, 8, 38, 28, 28, 40, 28,
## 66, 28, 42, 28, 21, 18, 14, 40, 27, 19, 28, 28, 28, 28, 18, 7,
## 21, 49, 29, 65, 28, 21, 28.5, 5, 11, 22, 28, 28, 29, 19, 17,
## 26, 32, 16, 21, 32, 25, 28, 28, 0.83, 30, 22, 29, 28, 17, 33,
## 28, 23, 24, 29, 20, 26, 59, 28, 71, 34, 34, 28, 21, 33, 37, 28,
## 21, 38, 28, 47, 14.5, 22, 20, 17, 21, 70.5, 29, 24, 2, 21, 28,
## 32.5, 32.5, 54, 12, 24, 28, 45, 33, 20, 47, 25, 23, 19, 37, 16,
## 24, 22, 19, 36.5, 22, 55.5, 40.5, 51, 16, 28, 28, 44, 40, 26,
## 17, 1, 9, 28, 45, 28, 28, 61, 4, 1, 21, 56, 18, 50, 30, 36, 28,
## 28, 4, 28, 28, 45, 40, 36, 32, 19, 3, 58, 28, 42, 24, 28, 28,
## 34, 45.5, 18, 2, 32, 26, 40, 24, 35, 22, 28, 31, 42, 32, 30,
## 16, 27, 51, 28, 38, 22, 19, 20.5, 18, 28, 35, 29, 59, 24, 28,
## 44, 8, 19, 33, 28, 28, 29, 22, 30, 25, 28, 29, 62, 29, 28, 30,
## 35, 50, 28, 3, 52, 40, 28, 36, 25, 58, 28, 25, 37, 28, 63, 45,
## 28, 7, 35, 65, 28, 16, 28, 30, 22, 42, 22, 26, 19, 36, 24, 28,
## 2, 28, 50, 28, 28, 19, 28, 28, 0.92, 28, 30, 30, 24, 18, 26,
## 28, 43, 26, 24, 54, 40, 22, 30, 22, 61, 36, 31, 28, 45.5, 38,
## 28, 29, 41, 45, 45, 2, 28, 25, 36, 40, 28, 3, 42, 23, 15, 25,
## 28, 28, 22, 38, 28, 28, 29, 45, 28, 28, 28, 24, 18, 22, 3, 28,
## 27, 20, 19, 42, 1, 32, 35, 28, 1, 28, 17, 36, 21, 28, 23, 22,
## 31, 46, 23, 28, 39, 26, 21, 28, 20, 34, 3, 21, 28, 28, 33, 28,
## 44, 28, 34, 18, 30, 28, 21, 29, 18, 28, 28, 28, 32, 28, 28, 17,
## 50, 14, 21, 24, 64, 45, 20, 25, 28, 4, 13, 34, 5, 36, 28, 30,
## 49, 29, 65, 28, 50, 28, 34, 47, 48, 28, 38, 28, 28, 28, 33, 23,
## 22, 28, 34, 29, 2, 9, 28, 50, 63, 25, 28, 58, 30, 9, 28, 55,
## 71, 21, 28, 54, 28, 25, 24, 17, 21, 18, 33, 28, 28, 26, 29, 28,
## 54, 24, 34, 28, 36, 32, 22, 28, 44, 28, 40.5, 50, 28, 39, 23,
## 17, 28, 30, 30, 28, 22, 36, 9, 11, 32, 50, 64, 28, 33, 17, 28,
## 22, 22, 62, 48, 28, 36, 28, 40, 28, 28, 28, 24, 19, 29, 28, 62,
## 53, 36, 28, 16, 19, 34, 28, 32, 39, 54, 28, 18, 60, 22, 28, 35,
## 52, 47, 28, 37, 36, 28, 49, 28, 49, 24, 28, 28, 44, 35, 30, 40,
## 39, 28, 28, 28, 35, 24, 26, 4, 26, 27, 42, 20, 21, 57, 21, 26,
## 28, 80, 51, 32, 28, 9, 28, 32, 31, 41, 24, 28, 0.75, 48, 19,
## 56, 28, 23, 28, 28, 18, 24, 28, 32, 23, 50, 40, 36, 20, 32, 25,
## 28, 43, 40, 31, 70, 31, 28, 18, 18, 43, 36, 28, 20, 14, 60, 25,
## 14, 19, 15, 4, 25, 60, 44, 49, 42, 18, 35, 18, 26, 39, 45, 42,
## 22, 28, 24, 28, 48, 52, 19, 38, 33, 34, 50, 27, 30, 28, 25, 25,
## 29, 11, 28, 23, 23, 28.5, 48, 35, 28, 28, 24, 31, 70, 30, 31,
## 4, 6, 33, 23, 48, 0.67, 28, 18, 34, 33, 28, 41, 20, 28, 30.5,
## 28, 32, 24, 28, 54, 18, 28, 5, 28, 43, 13, 29, 25, 18, 8, 46,
## 28, 16, 28, 25, 49, 31, 30, 30, 34, 31, 0.42, 27, 31, 39, 18,
## 39, 26, 39, 35, 6, 30.5, 23, 31, 43, 10, 52, 27, 28, 28, 1, 15,
## 0.83, 23, 18, 39, 28, 32, 28, 20, 16, 30, 34.5, 17, 42, 28, 35,
## 28, 28, 4, 74, 16, 44, 18, 51, 24, 28, 41, 48, 24, 42, 27, 31,
## 28, 4, 47, 33, 47, 15, 19, 56, 33, 22, 28, 39, 27, 19, 26, 32
## ), c(1, 1, 0, 0, 3, 0, 1, 1, 0, 1, 0, 4, 1, 0, 0, 0, 0, 3, 1,
## 0, 0, 0, 0, 0, 1, 1, 0, 0, 2, 1, 1, 1, 0, 0, 1, 0, 2, 1, 4, 0,
## 1, 1, 0, 0, 0, 0, 1, 5, 0, 0, 1, 0, 0, 4, 2, 0, 5, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 3, 0, 3, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0,
## 0, 2, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 4, 2, 0, 1, 0, 0,
## 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
## 0, 8, 0, 0, 0, 0, 4, 0, 0, 1, 0, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0,
## 8, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 8, 0, 0, 0, 0,
## 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 3,
## 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
## 0, 0, 0, 4, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 4, 1, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 1, 0,
## 1, 0, 0, 2, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 2, 0, 0, 1,
## 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0,
## 1, 0, 1, 0, 0, 0, 1, 0, 3, 1, 0, 0, 0, 0, 0, 0, 1, 0, 5, 0, 0,
## 1, 0, 2, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 0, 3, 0, 1, 0,
## 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 2, 2, 1,
## 1, 0, 1, 0, 0, 0, 0, 2, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 5, 0, 0, 0, 1, 3, 0, 0, 1, 1,
## 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
## 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 0, 0, 4, 4, 1,
## 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 2, 0, 0, 0,
## 0, 2, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1,
## 1, 0, 0, 0, 1, 2, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 2, 0,
## 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 1, 0, 0, 0, 2, 1,
## 0, 0, 0, 0, 0, 0, 0, 2, 0, 1, 0, 2, 0, 0, 1, 2, 0, 0, 0, 1, 1,
## 0, 0, 0, 0, 0, 1, 0, 0, 0, 5, 1, 1, 4, 0, 0, 0, 0, 0, 0, 1, 0,
## 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 3, 0,
## 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0,
## 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 4, 0, 0, 1, 0, 3, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 0, 2,
## 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
## ), c(0, 0, 0, 0, 1, 2, 0, 1, 0, 5, 0, 1, 0, 0, 0, 0, 0, 1, 5,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
## 0, 0, 1, 0, 0, 0, 2, 2, 0, 0, 1, 0, 0, 2, 0, 0, 2, 0, 0, 0, 0,
## 0, 2, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 1, 0, 0, 1,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 0, 0, 0, 1,
## 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 2, 0, 0, 2, 1, 0,
## 0, 2, 1, 0, 0, 0, 1, 2, 1, 4, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0,
## 2, 0, 2, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 2, 0, 0, 0, 1,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
## 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, 0, 0,
## 0, 1, 0, 2, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 1, 0, 0, 0, 0, 0, 2, 0,
## 0, 0, 0, 2, 1, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0,
## 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 0, 0,
## 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0,
## 0, 0, 1, 2, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 3, 4,
## 1, 0, 0, 0, 2, 1, 0, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1, 2, 0, 0, 0, 0, 1, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 2, 0, 0, 0, 2, 2, 2, 2, 0,
## 0, 0, 0, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 1, 0, 0, 0, 0, 0, 2, 0,
## 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 2, 0, 1, 0,
## 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 1, 5, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 6, 1, 0, 0, 2, 1, 2, 1, 0, 1, 1, 0, 0, 0, 1, 0,
## 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0,
## 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 1,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0,
## 0, 0, 0, 0, 2, 0, 0, 1, 0, 2, 1, 0, 0, 0, 2, 0, 1, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 1, 0, 2, 0, 1, 0, 1, 0, 3, 0, 0,
## 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 5, 0, 0, 0, 0
## ), c(712.833, 53.1, 8.05, 84.583, 21.075, 111.333, 300.708, 16.7,
## 8.05, 31.275, 16, 29.125, 18, 7.225, 26, 80.292, 35.5, 21.075,
## 313.875, 78.792, 78.958, 277.208, 7.75, 10.5, 821.708, 52, 72.292,
## 8.05, 18, 112.417, 9.475, 21, 78.792, 8.05, 15.5, 7.75, 216.792,
## 17.8, 396.875, 7.8, 767.292, 26, 619.792, 35.5, 10.5, 72.292,
## 27.75, 46.9, 72.292, 277.208, 152.458, 10.5, 81.583, 7.925, 86.625,
## 10.5, 46.9, 73.5, 564.958, 7.65, 78.958, 8.05, 29, 12.475, 9,
## 9.5, 47.1, 10.5, 15.85, 8.05, 263, 8.05, 8.05, 78.542, 20.575,
## 7.25, 8.05, 346.542, 23, 26, 78.958, 772.875, 86.542, 7.925,
## 78.958, 7.65, 78.958, 24.15, 52, 144.542, 8.05, 9.825, 144.583,
## 7.925, 7.75, 21, 2.475, 31.275, 73.5, 8.05, 300.708, 13, 772.875,
## 112.417, 71.417, 223.583, 6.975, 78.958, 7.05, 14.5, 13, 150.458,
## 262.833, 53.1, 92.167, 79.2, 7.75, 6.75, 26, 66.6, 8.05, 14.5,
## 613.792, 77.333, 86.625, 69.55, 16.1, 15.75, 7.775, 86.625, 396.875,
## 20.525, 55, 27.9, 25.925, 564.958, 33.5, 29.125, 111.333, 7.925,
## 306.958, 78.542, 287.125, 13, 0, 69.55, 15.05, 22.025, 50, 15.5,
## 26.55, 15.5, 78.958, 13, 13, 26, 1.465, 7.75, 84.042, 13, 9.5,
## 69.55, 64.958, 7.225, 8.05, 104.625, 15.85, 187.875, 31, 7.05,
## 21, 7.25, 7.75, 113.275, 27, 762.917, 10.5, 8.05, 13, 8.05, 78.958,
## 90, 9.35, 10.5, 7.25, 13, 254.667, 83.475, 7.775, 13.5, 10.5,
## 7.55, 26, 26.25, 10.5, 12.275, 144.542, 15.5, 10.5, 7.125, 7.225,
## 7.775, 7.25, 104.625, 26.55, 152.458, 79.2, 86.5, 5.123, 26,
## 7.75, 313.875, 79.65, 0, 7.75, 10.5, 7.775, 1.534, 31, 0, 29.7,
## 7.75, 779.583, 7.75, 0, 29.125, 20.25, 7.75, 78.542, 9.5, 26,
## 9.5, 78.958, 13, 7.75, 78.85, 910.792, 12.875, 78.958, 277.208,
## 151.55, 30.5, 2.475, 7.75, 23.25, 0, 12.35, 8.05, 151.55, 1.108,
## 24, 569.292, 831.583, 262.375, 26, 78.958, 26.25, 78.542, 26,
## 14, 134.5, 7.25, 12.35, 29, 62.375, 13, 20.525, 23.25, 28.5,
## 1.534, 133.65, 66.6, 134.5, 8.05, 35.5, 26, 13, 13, 13, 13, 16.1,
## 15.9, 86.625, 9.225, 72.292, 17.8, 7.225, 9.5, 55, 13, 78.792,
## 78.792, 277.208, 144.542, 15.5, 72.292, 7.75, 69.3, 64.958, 1.356,
## 21.075, 821.708, 211.5, 40.125, 7.775, 227.525, 157.417, 7.925,
## 52, 78.958, 46.9, 77.292, 12, 120, 77.958, 7.925, 113.275, 77.958,
## 78.542, 26, 10.5, 12.65, 7.925, 8.05, 9.825, 15.85, 86.625, 21,
## 18.75, 7.775, 254.667, 78.958, 90, 0, 7.925, 8.05, 32.5, 13,
## 13, 78.958, 77.333, 7.875, 202.125, 7.25, 26, 7.75, 8.05, 26.55,
## 16.1, 7.125, 55.9, 120, 34.375, 18.75, 263, 26.25, 9.5, 7.775,
## 81.125, 818.583, 19.5, 26.55, 192.583, 27.75, 199.667, 27.75,
## 891.042, 78.958, 26.55, 518.625, 10.5, 7.75, 8.05, 38.5, 13,
## 8.05, 7.05, 0, 7.725, 7.25, 27.75, 137.917, 98.375, 52, 21, 70.458,
## 122.875, 46.9, 0, 8.05, 95.875, 910.792, 254.667, 29.7, 8.05,
## 15.9, 199.667, 30.5, 495.042, 8.05, 144.583, 782.667, 15.1, 151.55,
## 77.958, 86.625, 7.75, 108.9, 26, 26.55, 22.525, 564.958, 7.75,
## 8.05, 59.4, 74.958, 10.5, 24.15, 26, 78.958, 78.958, 7.225, 579.792,
## 72.292, 7.75, 10.5, 2.217, 7.925, 11.5, 72.292, 223.583, 86.625,
## 106.425, 14.5, 49.5, 71, 31.275, 31.275, 26, 106.425, 26, 138.625,
## 20.525, 1.108, 78.292, 7.225, 7.775, 26.55, 39.6, 227.525, 17.4,
## 7.75, 78.958, 13.5, 8.05, 8.05, 24.15, 78.958, 21.075, 72.292,
## 10.5, 514.792, 263.875, 7.75, 8.05, 14.5, 13, 144.583, 7.925,
## 1.108, 26, 87.125, 79.65, 79.2, 8.05, 8.05, 7.125, 782.667, 7.25,
## 7.75, 26, 24.15, 33, 0, 7.225, 569.292, 27, 78.958, 42.4, 8.05,
## 26.55, 78.958, 1.534, 31.275, 7.05, 15.5, 7.75, 8.05, 65, 16.1,
## 39, 10.5, 144.542, 525.542, 157.417, 16.1, 12.35, 779.583, 78.958,
## 77.333, 30, 70.542, 30.5, 0, 27.9, 13, 7.925, 26.25, 396.875,
## 69.3, 564.958, 192.583, 767.292, 78.958, 35.5, 7.55, 7.55, 78.958,
## 78.292, 6.75, 73.5, 78.958, 15.5, 13, 133.65, 7.225, 74.958,
## 7.925, 73.5, 13, 7.775, 8.05, 39, 52, 10.5, 13, 0, 7.775, 98.417,
## 46.9, 5.123, 81.375, 9.225, 46.9, 39, 415.792, 396.875, 101.708,
## 2.113, 134.167, 7.225, 26.55, 8.05, 1.108, 7.65, 227.525, 262.875,
## 144.542, 78.542, 26, 13.5, 262.875, 151.55, 152.458, 495.042,
## 26.55, 52, 13, 7.65, 227.525, 7.775, 13, 13, 53.1, 21, 77.375,
## 26, 7.925, 2.113, 187.875, 0, 13, 13, 16.1, 34.375, 5.123, 78.958,
## 30, 16.1, 7.925, 71, 13, 7.75, 23, 12.475, 9.5, 78.958, 65, 14.5,
## 77.958, 11.5, 8.05, 86.5, 14.5, 7.125, 72.292, 39.6, 7.75, 24.15,
## 83.625, 9.5, 7.225, 23, 7.75, 7.75, 12.475, 77.375, 2.113, 72.292,
## 30, 7.25, 74.958, 29.125, 79.2, 7.75, 26, 306.958, 78.958, 259.292,
## 86.833, 72.292, 24.15, 13, 26.25, 85.167, 6.975, 7.775, 0, 7.775,
## 13, 78.875, 24.15, 10.5, 31.275, 8.05, 7.925, 370.042, 6.45,
## 27.9, 93.5, 86.625, 6.95, 564.958, 370.042, 144.542, 18.75, 78.542,
## 8.3, 831.583, 8.05, 564.958, 29.7, 7.925, 10.5, 31, 64.375, 86.625,
## 7.55, 69.55, 78.958, 33, 891.042, 31.275, 7.775, 39.4, 26, 9.35,
## 26.55, 192.583, 72.292, 141.083, 259.292, 13, 13, 138.583, 504.958,
## 9.5, 111.333, 525.542, 5, 9, 7.225, 78.958, 831.583, 78.958,
## 105.167, 10.5, 29.125, 13, 30, 30, 7.75), c(0, 0, 0, 1, 0, 0,
## 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
## 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0,
## 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0,
## 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
## 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1), c(0, 1, 1, 0, 1, 1, 0,
## 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1,
## 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0,
## 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
## 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1,
## 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0,
## 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1,
## 1, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1,
## 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1,
## 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
## 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1,
## 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0,
## 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1,
## 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1,
## 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1,
## 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1,
## 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1,
## 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1,
## 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1,
## 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1,
## 0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 1, 1,
## 1, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 1,
## 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1,
## 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1,
## 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1,
## 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 0, 1, 1,
## 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1,
## 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 0,
## 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1,
## 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0,
## 0, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 1, 0,
## 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1,
## 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1,
## 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1,
## 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 0, 0), c(2, 2, 1, 1, 1, 2, 2, 2,
## 1, 1, 2, 1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1,
## 2, 1, 1, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 1, 2, 2, 1, 2, 1, 1, 1,
## 2, 2, 1, 2, 1, 1, 1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1, 2, 2, 1, 2,
## 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1,
## 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 2,
## 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1, 2, 2, 1,
## 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 1, 2, 1,
## 2, 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 2, 2, 1, 2, 1, 1, 2, 1, 2,
## 1, 2, 1, 1, 1, 2, 1, 2, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 1, 1,
## 2, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 1, 2, 1, 1, 1, 1, 2, 2,
## 1, 2, 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, 1, 2, 1, 2, 2, 2, 2, 1, 1,
## 1, 1, 2, 2, 2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 2, 1, 1, 1, 2, 2, 1,
## 2, 1, 2, 2, 1, 2, 2, 2, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 1, 2, 2,
## 2, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2,
## 1, 1, 1, 2, 2, 1, 2, 1, 1, 1, 2, 2, 2, 1, 2, 1, 1, 1, 1, 2, 2,
## 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 2, 1, 2, 2, 1, 1, 1, 1, 1, 1,
## 2, 1, 2, 2, 2, 1, 1, 2, 1, 2, 1, 2, 1, 1, 2, 2, 2, 2, 2, 1, 1,
## 1, 2, 2, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1,
## 2, 1, 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1,
## 1, 2, 2, 1, 2, 2, 1, 2, 1, 2, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1,
## 1, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2, 1, 1, 2, 1, 2, 1, 2, 2, 1, 2,
## 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 2, 1, 2, 2,
## 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 2, 2, 1, 1, 1, 2,
## 1, 2, 1, 1, 2, 1, 1, 2, 1, 2, 1, 1, 2, 2, 1, 1, 2, 1, 1, 2, 1,
## 2, 1, 1, 2, 1, 1, 1, 2, 2, 2, 2, 1, 2, 1, 2, 1, 2, 1, 1, 1, 1,
## 1, 2, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 2, 1, 1, 2, 1, 2, 1, 1, 1,
## 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 2, 2, 2, 2, 2,
## 1, 2, 1, 1, 2, 1, 1, 1, 2, 2, 2, 1, 1, 2, 1, 1, 1, 1, 1, 1, 2,
## 1, 2, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, 2, 1,
## 1, 1, 1, 1, 1, 2, 1, 1, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 1, 1, 1,
## 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
## 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 1, 1,
## 1, 2, 1, 1, 2, 1, 2, 2, 2, 1, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, 1,
## 2, 1, 2, 1, 1, 1, 1, 1, 2, 2, 1)), control = list(20, 7, 0, 4,
## 5, 2, 0, 30, 0))
##
## Variables actually used in tree construction:
## [1] Age EmbarkedS Fare Pclass Sexmale SibSp
##
## Root node error: 265/712 = 0.37219
##
## n= 712
##
## CP nsplit rel error
## 1 0.4188679 0 1.00000
## 2 0.0358491 1 0.58113
## 3 0.0301887 3 0.50943
## 4 0.0188679 4 0.47925
## 5 0.0094340 5 0.46038
## 6 0.0066038 9 0.42264
## 7 0.0056604 16 0.36981
## 8 0.0020000 18 0.35849Nesse chunk acima, best_cp: recupera o complexity parameter escolhido automaticamente pelo caret::train ao maximizar a AUC (ROC) na validação cruzada 5×3.
final_tree: é o CART já podado no cp ótimo — ou seja, é exatamente o modelo que o caret considera “melhor” para generalizar.
rpart.plot(…): plota a árvore final de forma interpretável:
type=2: mostra condições nas arestas;
extra=104: em cada folha exibe classe prevista, probabilidade da classe positiva (“pos”) e percentual de amostras do treino no nó;
under/fallen.leaves: layout mais legível.
printcp(final_tree): imprime a cptable da árvore final (linhas acima do cp escolhido foram podadas). Permite confirmar:
nsplit (tamanho), CP (penalidade), rel error (erro treino), xerror e xstd (erro CV interno).
Interpretando o gráfico:
A raiz divide por Sex (tipicamente o atributo mais informativo no Titanic).
Ramos seguintes trazem regras com Age, Pclass, Embarked, SibSp, etc.
Em cada folha:
rótulo “pos/neg” = classe prevista;
número central ≈ probabilidade de sobreviver;
número inferior = % de observações que caem no nó.
Ex.: ramos com Sex = female e boas classes tendem a folhas “pos” com probabilidade alta; Sex = male + Pclass >= 3 geralmente vai a folhas “neg”.
Portanto, best_cp (valor do cp ótimo) e um print curto do tree_caret$results na linha desse cp com ROC média e desvio.
Resumo visual da árvore (captura de tela do rpart.plot) com 2–3 regras interpretáveis: “sexo e classe foram os principais determinantes; idade modulou o risco em alguns ramos…”.
Confirmação de que a cptable está coerente com a escolha do caret (linha do cp ótimo com bom xerror).
3.2.2.4 Avaliando na validação holdout
#########Avaliando na validação holdout (nosso train_va)###########
prob_va2 <- predict(tree_caret, newdata = train_va, type = "prob")[,"pos"]
pred_va2 <- factor(ifelse(prob_va2 >= 0.5, "pos","neg"), levels = c("neg","pos"))
confusionMatrix(pred_va2, train_va$Survived, positive = "pos")## Confusion Matrix and Statistics
##
## Reference
## Prediction neg pos
## neg 90 25
## pos 12 50
##
## Accuracy : 0.791
## 95% CI : (0.7236, 0.8483)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 1.426e-09
##
## Kappa : 0.5619
##
## Mcnemar's Test P-Value : 0.04852
##
## Sensitivity : 0.6667
## Specificity : 0.8824
## Pos Pred Value : 0.8065
## Neg Pred Value : 0.7826
## Prevalence : 0.4237
## Detection Rate : 0.2825
## Detection Prevalence : 0.3503
## Balanced Accuracy : 0.7745
##
## 'Positive' Class : pos
## roc_va2 <- pROC::roc(train_va$Survived, prob_va2, levels = c("neg","pos"))
pROC::auc(roc_va2)## Area under the curve: 0.807Nesse chunk foi realizada a Predição probabilística: usei type=“prob” para obter a probabilidade de “pos” (sobreviver) para cada passageiro do holdout.
Binarização: transformei probabilidade em classe com limiar 0,5 (regra padrão; pode ser ajustada conforme objetivo).
Matriz de confusão: confusionMatrix(…) calcula acurácia, kappa, sensibilidade (recall da classe positiva), especificidade, valores preditivos, etc.
Curva ROC / AUC: com pROC, geramos a ROC a partir de todas as probabilidades e obtemos a AUC, que não depende do limiar.
Interpretando os resultados:
Matriz de confusão (holdout):
TN=90, FP=25, FN=12, TP=50 (linhas Reference, colunas Prediction).
Métricas principais:
Acurácia ≈ 0,79 (79% dos casos corretos).
Kappa ≈ 0,56 (acordo além do acaso — moderado/bom).
Sensibilidade ≈ 0,667 (recupera ~67% dos sobreviventes).
Especificidade ≈ 0,882 (descarta ~88% dos não-sobreviventes).
Balanced Accuracy ≈ 0,775 (média entre sens e espec; útil com leve desbalanceamento).
AUC ≈ 0,807 (poder discriminativo global: escolhendo um limiar adequado, o modelo separa bem pos vs neg).
Em outras palavras, a árvore acerta cerca de 8 em cada 10 passageiros no conjunto de validação. Ela é melhor em identificar quem não sobreviveu (especificidade alta) do que em identificar todos os que sobreviveram (sensibilidade moderada). Mesmo assim, a AUC de ~0,81 mostra que, ajustando o limiar, dá para trocar um pouco de falsos positivos por mais verdadeiros positivos conforme a meta do trabalho.
Acurácia, Kappa, Sens/Spec e AUC do holdout (com 2 casas decimais).
A matriz de confusão (ou um resumo TN/FP/FN/TP).
O que dizer sobre o trade-off: “Se o objetivo for captar mais sobreviventes (maior sensibilidade), podemos reduzir o limiar < 0,5; se a meta for errar menos falsos positivos, aumentamos o limiar.”
3.3 Desenvolvimento de um classificador k-NN
3.3.1 Preparando o dataset para o caret
K-NN — Preparação dos dados (formato caret)
# Usarei os objetos já pré-processados da rota B:
# - x_tr_sc, x_va_sc -> preditores numéricos (com dummies e padronizados)
# - y_tr, y_va -> respostas binárias 0/1 (sem vazamento)
stopifnot(exists("x_tr_sc"), exists("x_va_sc"), exists("y_tr"), exists("y_va"))
# Monta data frames no formato que o caret espera: y como fator + X numérico
df_knn_tr <- cbind(Survived = y_tr, x_tr_sc) %>% as.data.frame()
df_knn_va <- cbind(Survived = y_va, x_va_sc) %>% as.data.frame()
# Classe POSITIVA deve ser o primeiro nível (exigência do twoClassSummary/ROC)
df_knn_tr$Survived <- factor(df_knn_tr$Survived, levels = c(1, 0), labels = c("pos","neg"))
df_knn_va$Survived <- factor(df_knn_va$Survived, levels = c(1, 0), labels = c("pos","neg"))
# Checagens: sem NAs e todos preditores numéricos
stopifnot(!anyNA(df_knn_tr), !anyNA(df_knn_va))
stopifnot(all(sapply(dplyr::select(df_knn_tr, -Survived), is.numeric)))
stopifnot(all(sapply(dplyr::select(df_knn_va, -Survived), is.numeric)))No chunk acima que garantimos a resposta binária como fator com a classe positiva sendo “pos” (e “neg” a outra). Isso evita inversão de métrica.
Ex.: df_knn_tr\(Survived <- factor(df_knn_tr\)Survived, levels = c(“pos”,“neg”)) (ou equivalente conforme seu script).
Somente preditores numéricos: o k-NN usa distâncias; por isso variáveis categóricas já viraram dummies.
Sem “NAs” nos preditores (k-NN não lida com valores faltantes).
Normalização padronizada (média 0, desvio 1) feita dentro do train via preProcess = c(“center”,“scale”).Fazer o scaling dentro do train evita leakage; o caret estima os parâmetros de escala só no treino e os aplica corretamente em cada resample/teste.
3.3.2 Controle de treino (resampling) e grade de k
set.seed(123)
# Controle de treino: CV repetida, AUC/ROC, probabilidades salvas
ctrl_knn <- caret::trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
classProbs = TRUE, # necessário para ROC
summaryFunction = caret::twoClassSummary,
savePredictions = "final"
)
# Grade de k (ímpar para evitar empates)
grid_knn <- data.frame(k = seq(3, 51, by = 2))O chunk acima define a semente (set.seed) para reprodutibilidade.
Cria um objeto de controle do caret (ctrl_knn) com:
method = “repeatedcv”: validação cruzada repetida.
number = 5, repeats = 3: 5 folds × 3 repetições.
classProbs = TRUE: pede probabilidades (necessário para AUC/ROC).
summaryFunction = twoClassSummary: faz o caret calcular métricas binárias como ROC, Sens, Spec a cada reamostragem.
savePredictions = “final”: mantém as predições finais de cada modelo avaliado.
Monta a grade de hiperparâmetro: grid_knn <- data.frame(k = seq(3, 51, by = 2)).
Usa somente valores ímpares de k para evitar empates de votação no k-NN.
Isso é importante de ser feito pois o k-NN não tem “treino” paramétrico; a escolha de k é crucial e feita por busca em grade + validação cruzada.
AUC/ROC é uma métrica robusta quando há leve desbalanceamento; para calcular ROC é obrigatório pedir classProbs=TRUE.
3.3.3 Treinamento (otimizando AUC/ROC)
set.seed(123)
# Se x_tr_sc já está padronizado, não precisa preProcess;
# mantenho por segurança (não afeta x_tr_sc já escalado).
knn_fit <- caret::train(
Survived ~ .,
data = df_knn_tr,
method = "knn",
trControl = ctrl_knn,
tuneGrid = grid_knn,
metric = "ROC",
preProcess = c("center","scale")
)
knn_fit## k-Nearest Neighbors
##
## 712 samples
## 8 predictor
## 2 classes: 'pos', 'neg'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 570, 570, 569, 570, 569, 570, ...
## Resampling results across tuning parameters:
##
## k ROC Sens Spec
## 3 0.8273943 0.7207547 0.8530836
## 5 0.8461930 0.7232704 0.8619392
## 7 0.8482098 0.7245283 0.8672243
## 9 0.8542327 0.7094340 0.8813983
## 11 0.8566503 0.6855346 0.8911194
## 13 0.8574594 0.6716981 0.9053017
## 15 0.8563128 0.6691824 0.9030379
## 17 0.8556107 0.6540881 0.9090054
## 19 0.8549805 0.6603774 0.9097378
## 21 0.8534038 0.6503145 0.9104619
## 23 0.8496858 0.6364780 0.9060175
## 25 0.8486824 0.6213836 0.9060508
## 27 0.8472357 0.6150943 0.9023055
## 29 0.8420130 0.6062893 0.8963379
## 31 0.8376451 0.6138365 0.8926342
## 33 0.8336604 0.6113208 0.8903704
## 35 0.8309933 0.5962264 0.8873991
## 37 0.8281573 0.5962264 0.8859093
## 39 0.8267041 0.5823899 0.8844278
## 41 0.8257416 0.5761006 0.8821889
## 43 0.8252260 0.5685535 0.8806908
## 45 0.8226302 0.5685535 0.8814232
## 47 0.8225832 0.5773585 0.8814232
## 49 0.8242295 0.5748428 0.8829380
## 51 0.8250139 0.5798742 0.8851352
##
## ROC was used to select the optimal model using the largest value.
## The final value used for the model was k = 13.plot(knn_fit) # ROC médio vs k
Em relação a esse código acima, para cada valor de k na grade, o caret: Centraliza/padroniza os preditores, Executa a validação cruzada repetida, Calcula a média do ROC (e outras estatísticas). Ao final, escolhe automaticamente o k com maior AUC média.
Erros que surgiram e que vale a pena mencionar:
“train()’s use of ROC codes requires class probabilities”: faltava classProbs=TRUE.
Outro cuidado foi manter “pos” como classe positiva (nível 1 do fator) para o twoClassSummary calcular corretamente.
Inspeção do ajuste e escolha do k:
As linhas:
print(knn_fit): mostra a tabela (por k) com as métricas médias de resampling.
plot(knn_fit): gera o gráfico ROC × k .
Interpretando o gráfico:
A curva sobe dos k muito baixos (alta variância) até um pico (o “k ótimo” da validação cruzada) e depois tende a cair (excesso de suavização).
Visualmente, o pico da sua curva aparece por volta do miolo da grade (na imagem, algo como k ≈ 17–21), e decai quando k chega perto de 40–50.
É justamente esse k do pico que o caret grava como melhor (ele fica disponível em knn_fit$bestTune).
3.3.4 Avaliação no conjunto de validação (holdout)
library(pROC)
# Probabilidade da classe positiva ("pos") no holdout
prob_va_knn <- predict(knn_fit, newdata = df_knn_va, type = "prob")[, "pos"]
# Classe prevista por threshold padrão 0.5 (pode ser ajustado depois)
pred_va_knn <- ifelse(prob_va_knn >= 0.5, "pos", "neg") %>%
factor(levels = c("pos","neg"))
# Matriz de confusão (positiva = "pos")
cm_knn <- caret::confusionMatrix(
data = pred_va_knn,
reference = df_knn_va$Survived,
positive = "pos"
)
cm_knn## Confusion Matrix and Statistics
##
## Reference
## Prediction pos neg
## pos 55 12
## neg 20 90
##
## Accuracy : 0.8192
## 95% CI : (0.7545, 0.8729)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 5.336e-12
##
## Kappa : 0.6245
##
## Mcnemar's Test P-Value : 0.2159
##
## Sensitivity : 0.7333
## Specificity : 0.8824
## Pos Pred Value : 0.8209
## Neg Pred Value : 0.8182
## Prevalence : 0.4237
## Detection Rate : 0.3107
## Detection Prevalence : 0.3785
## Balanced Accuracy : 0.8078
##
## 'Positive' Class : pos
## # ROC/AUC no holdout
roc_knn <- pROC::roc(response = df_knn_va$Survived, predictor = prob_va_knn, levels = c("neg","pos"))
pROC::auc(roc_knn)## Area under the curve: 0.8625No chunk acima, fiz a avaliação no holdout (seu conjunto df_knn_va)
O que o chunk faz: Gera probabilidades para a classe positiva (“pos”) no holdout com predict(knn_fit, newdata = df_knn_va, type = “prob”)[, “pos”].
Transforma essas probabilidades em classe com limiar 0.5 (padrão didático) e calcula a matriz de confusão:
confusionMatrix(pred_va_knn, df_knn_va$Survived, positive = “pos”).
Calcula a AUC no holdout com pROC::roc(…) e depois pROC::auc(…).
Como interpretar os resultados nas imagens acima:
Matriz de confusão Accuracy ≈ 0,8192 Kappa ≈ 0,6245 (acordo além do acaso — moderado/alto) Sensitivity (TPR) ≈ 0,7333 → dos “positivos” reais, ~73% foram detectados Specificity (TNR) ≈ 0,8824 → dos “negativos” reais, ~88% foram corretamente rejeitados Balanced Accuracy ≈ 0,8078 → média de sens e spec, útil com leve desbalanceamento AUC (holdout): ≈ 0,8625 Excelente para um modelo simples como k-NN; indica boa separação entre classes ao variar o limiar.
Observações rápidas:
O trade-off clássico aparece: com k muito pequeno a curva ROC média oscila (overfitting), com k muito grande a AUC cai (underfitting). O bestTune deixa tudo no “meio do caminho” mais estável.
Se a sensibilidade for prioritária (salvar mais passageiros, por ex.), dá para aumentar um pouco o limiar de decisão (ou diminuir, dependendo do objetivo) e reavaliar a matriz de confusão; a AUC não muda com o limiar, mas sens/spec sim.
3.3.5 Conclusão:
Treinei um classificador k-NN com validação cruzada repetida (5 folds × 3 repetições) usando o caret. Os preditores foram previamente transformados em numéricos (dummies) e padronizados por média e desvio-padrão dentro do processo de treino. Buscamos o hiperparâmetro k em uma grade de valores ímpares entre 3 e 51, selecionando-o pela maior AUC (twoClassSummary com classProbs=TRUE). O gráfico “ROC × k” mostrou um pico no miolo da grade, indicando o melhor compromisso viés-variância. No holdout, o modelo atingiu AUC ≈ 0,863, acurácia ≈ 0,819, sensibilidade ≈ 0,733, especificidade ≈ 0,882 e Kappa ≈ 0,625, evidenciando boa capacidade de discriminação e desempenho balanceado entre as classes.
3.4 Desenvolvimento de um classificador Naive Bayes
3.4.1 Preparação dos dados para o NB
Mantive as variáveis categóricas como fatores (o Naive Bayes lida bem com elas). Garanti a classe positiva = “pos” (sobreviveu).
#######Pacote necessário############
#install.packages("kaLar")
library(klaR) # backend do método "nb" no caret
library(caret)
library(klaR)
library(pROC)
library(dplyr)
# Conjunto de treino/validação com as mesmas colunas do projeto
df_nb_tr <- train_tr %>%
dplyr::select(Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked)
df_nb_va <- train_va %>%
dplyr::select(Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked)
# Resposta como fator binário com classe positiva = "pos"
df_nb_tr$Survived <- factor(df_nb_tr$Survived, levels = c("pos","neg"))
df_nb_va$Survived <- factor(df_nb_va$Survived, levels = c("pos","neg"))
# Checagens rápidas
stopifnot(!anyNA(df_nb_tr))
stopifnot(all(vapply(df_nb_tr, function(x) is.numeric(x) || is.factor(x), logical(1))))No chunk acima temos o seguinte: Pacotes Instalação e carregamento do
pacote klaR: serve para implementação do NB usada pelo
método “nb” do caret.
Lembrando que o caret orquestra treino, validação
cruzada, grade de hiperparâmetros e métricas. Seu uso permite uma
comparação “justa” entre os algoritmos.
Mais abaixo, em df_nb_tr, cria-se os data frames de
treino e validação (holdout) com as mesmas colunas preditoras do projeto
(Titanic). Isso garante que a variável resposta Survived é um fator
binário com a classe positiva = “pos” (sobreviveu). Isso é crucial para
o caret calcular ROC corretamente.
Além disso, checa se não existem NAs (já que NB não aceita valores ausentes).NB trabalha muito bem com fatores (categorias) e com numéricas. Como já imputamos/limpamos antes, aqui só padronizei o formato e a codificação da classe.
# Conjunto de treino/validação com as mesmas colunas do projeto
df_nb_tr <- train_tr %>%
dplyr::select(Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked)
df_nb_va <- train_va %>%
dplyr::select(Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked)
# Resposta como fator binário com classe positiva = "pos"
df_nb_tr$Survived <- factor(df_nb_tr$Survived, levels = c("pos","neg"))
df_nb_va$Survived <- factor(df_nb_va$Survived, levels = c("pos","neg"))
# Checagens rápidas
stopifnot(!anyNA(df_nb_tr))
stopifnot(all(vapply(df_nb_tr, function(x) is.numeric(x) || is.factor(x), logical(1))))O código acima cria os data frames de treino e validação (holdout) com as mesmas colunas preditoras do projeto (Titanic).
Garante que a variável resposta Survived é um fator binário com a classe positiva = “pos” (sobreviveu). Isso é crucial para o caret calcular ROC corretamente.
Checa se não existem NAs (NB não aceita valores ausentes).
Isso é feito, pois o NB trabalha muito bem com fatores (categorias) e com numéricas. Como já imputamos/limpamos antes, aqui só padronizamos o formato e a codificação da classe.
set.seed(123)
ctrl_nb <- trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary, # para ROC/Sens/Spec
savePredictions = "final"
)
grid_nb <- expand.grid(
fL = c(0, 1),
usekernel = c(TRUE, FALSE),
adjust = c(0.5, 1, 1.5, 2) # só é usado quando usekernel=TRUE
)O que o código acima faz:
Define o esquema de validação cruzada: 5 folds repetidos 3 vezes (reduz variância da estimativa de desempenho).
Liga classProbs = TRUE e usa twoClassSummary: o caret passará a calcular ROC (AUC), sensibilidade e especificidade durante o tuning.
Salva as predições da CV para inspeção posterior.
Cria a grade de hiperparâmetros do NB (klaR):
fL: Laplace smoothing (0 = sem, 1 = com). Ajuda quando há categorias raras/contagens zero.
usekernel: se TRUE, estima densidades de numéricas por kernel (relaxa a suposição normal); se FALSE, usa normal.
adjust: fator que alarga/estreita a banda do kernel (só relevante quando usekernel = TRUE).
O NB faz a suposição de independência condicional dos preditores por classe; com usekernel=TRUE, ficamos menos rígidos na forma das distribuições numéricas, o que costuma melhorar ROC quando as numéricas não são normais.
nb_fit <- train(
Survived ~ .,
data = df_nb_tr,
method = "nb",
trControl = ctrl_nb,
tuneGrid = grid_nb,
metric = "ROC"
)
print(nb_fit) # tabela de ROC médio por combinação (fL, usekernel, adjust)## Naive Bayes
##
## 712 samples
## 7 predictor
## 2 classes: 'pos', 'neg'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 570, 570, 569, 570, 569, 570, ...
## Resampling results across tuning parameters:
##
## fL usekernel adjust ROC Sens Spec
## 0 FALSE 0.5 0.8176810 0.7119497 0.8180524
## 0 FALSE 1.0 0.8176810 0.7119497 0.8180524
## 0 FALSE 1.5 0.8176810 0.7119497 0.8180524
## 0 FALSE 2.0 0.8176810 0.7119497 0.8180524
## 0 TRUE 0.5 0.8240234 0.4377358 0.9320766
## 0 TRUE 1.0 0.8287125 0.4125786 0.9417811
## 0 TRUE 1.5 0.8301146 0.4062893 0.9492551
## 0 TRUE 2.0 0.8325150 0.4075472 0.9552393
## 1 FALSE 0.5 0.8176810 0.7119497 0.8180524
## 1 FALSE 1.0 0.8176810 0.7119497 0.8180524
## 1 FALSE 1.5 0.8176810 0.7119497 0.8180524
## 1 FALSE 2.0 0.8176810 0.7119497 0.8180524
## 1 TRUE 0.5 0.8240234 0.4377358 0.9320766
## 1 TRUE 1.0 0.8287125 0.4125786 0.9417811
## 1 TRUE 1.5 0.8301146 0.4062893 0.9492551
## 1 TRUE 2.0 0.8325150 0.4075472 0.9552393
##
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were fL = 0, usekernel = TRUE and adjust
## = 2.plot(nb_fit) # gráfico das combinações vs ROC
nb_fit$bestTune # melhor combinação encontrada## fL usekernel adjust
## 8 0 TRUE 2O código acima treina vários modelos NB (uma combinação por linha da grade) usando a CV definida.
Seleciona a melhor combinação pela maior AUC média (métrica = “ROC”).
print(nb_fit) mostra a tabela de AUC média por combinação.
plot(nb_fit) mostra o gráfico de tuning (AUC vs combinações).
bestTune retorna os hiperparâmetros vencedores (por ex., fL=1, usekernel=TRUE, adjust=1.5).
Como interpretar: a combinação com maior AUC é a que, em média, melhor separa “pos” de “neg” nos folds; se usekernel=TRUE vencer, é sinal de que as numéricas fogem da normalidade e se beneficiaram do kernel.
# Probabilidades no holdout
prob_va_nb <- predict(nb_fit, newdata = df_nb_va, type = "prob")[, "pos"]
pred_va_nb <- factor(ifelse(prob_va_nb >= 0.5, "pos", "neg"),
levels = c("pos","neg"))
# Matriz de confusão (classe positiva = "pos")
cm_nb <- confusionMatrix(pred_va_nb, df_nb_va$Survived, positive = "pos")
cm_nb## Confusion Matrix and Statistics
##
## Reference
## Prediction pos neg
## pos 34 5
## neg 41 97
##
## Accuracy : 0.7401
## 95% CI : (0.669, 0.803)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 4.304e-06
##
## Kappa : 0.4317
##
## Mcnemar's Test P-Value : 2.463e-07
##
## Sensitivity : 0.4533
## Specificity : 0.9510
## Pos Pred Value : 0.8718
## Neg Pred Value : 0.7029
## Prevalence : 0.4237
## Detection Rate : 0.1921
## Detection Prevalence : 0.2203
## Balanced Accuracy : 0.7022
##
## 'Positive' Class : pos
## # ROC/AUC no holdout
roc_nb <- pROC::roc(response = df_nb_va$Survived,
predictor = prob_va_nb,
levels = c("neg","pos"))
pROC::auc(roc_nb)## Area under the curve: 0.8514O código acima gera probabilidades da classe positiva no holdout (dados nunca vistos pela CV).
Converte em rótulo com limiar 0.5 para montar a matriz de confusão.
Calcula ROC/AUC no holdout (nossa métrica principal).
AUC ∈ [0.5, 1]: quanto mais perto de 1, melhor o poder discriminativo.
A acurácia e a sensibilidade/especificidade vêm da matriz (dependem do limiar de 0.5).
Como interpretar:
AUC (holdout) é o principal número para comparar modelos.
Se quisermos otimizar o limiar, pode escolher o que maximiza a sensibilidade + especificidade ou o que atende a uma meta de sensibilidade (depende do problema). Aqui usamos 0.5 por simplicidade didática.
Os avisos “Numerical 0 probability for all classes vêm do klaR::NaiveBayes/predict.nb. O NB multiplica muitas probabilidades/densidades. Em alguns casos o produto fica tão pequeno que “estoura” para zero (underflow numérico). O pacote então acusa: para aquela observação, a verossimilhança ficou ~0 “para todas as classes”.
O modelo ainda gera a predição (usa os priors e empates), mas esses casos podem derrubar um pouco a sensibilidade.
Observa-se nos resultdos também:
Accuracy = 0.7401 (≈ 74%) = (TP+TN)/(TP+FP+FN+TN) = (34+97)/177.
Sensitivity (Recall da classe “pos”) = 0.4533 = TP/(TP+FN) = 34/(34+41). O NB perde uma boa parte dos positivos (sobreviventes).
Specificity = 0.9510 = TN/(TN+FP) = 97/(97+5). Ou seja, quase não dá falso positivo.
PPV (Pos Pred Value) = 0.8718 e NPV = 0.6799: quando prevê “pos”, costuma acertar; quando prevê “neg”, erra mais.
Balanced Accuracy = 0.7022: média de sens e espec – útil com leve desbalanceamento.
Kappa = 0.4317: acordo além do acaso moderado.
Interpretação: o classificador NB está conservador. Ele só “chuta positivo” quando está muito confiante; por isso a especificidade é alta (0.95) e a sensibilidade é baixa (0.45). Em aplicações onde perder “positivos” é ruim, é possível baixar o limiar (em vez de 0.5, usar 0.4, 0.35 etc.) para ganhar sensibilidade (e aceitar mais FP).
A AUC foi de 0.8514.
A AUC mede separação global (independe do corte 0.5).
0.85 é muito bom e próximo do que você obteve com k-NN (~0.86).
Isso confirma que o NB classifica bem em termos de ranking; a baixa sensibilidade veio mais do corte padrão 0.5 e do seu perfil conservador. Ajustando o limiar, dá para aumentar bastante o recall sem destruir a AUC.
Então, se quisermos mais sensibilidade: devemos utilizar as probabilidades (prob_va_nb) e ajuste o threshold (ex.: maximizar Youden J ou escolher o ponto da ROC que melhor atende seu objetivo).
Para reduzir os warnings/underflow: devemos manter fL=1, usekernel=TRUE, teste adjust maiores (1.5–2) e revise preditores muito colineares.
O classificador Naive Bayes tem AUC ≈ 0.85 (ótimo), especificidade altíssima, mas sensibilidade baixa no corte 0.5. É “cauteloso”: acerta bem quem não sobreviveu e só marca “sobreviveu” quando a evidência é forte. Ajuste de limiar e/ou leve suavização podem equilibrar melhor o trade-off.
Portanto, ajustamos um classificador Naive Bayes (klaR via caret) com validação cruzada repetida (5×3), selecionando a melhor combinação de hiperparâmetros pela AUC (ROC). Testamos Laplace (fL), uso de kernel para as variáveis numéricas e o fator de ajuste da banda. No holdout, o modelo apresentou AUC = [inserir], acurácia = [inserir], sensibilidade = [inserir] e especificidade = [inserir], indicando bom poder discriminativo. As variáveis mais influentes, segundo varImp, foram [inserir], coerentes com a literatura do Titanic (classe, sexo, idade, etc.).
# Importância de variáveis (robusta para 'nb')
VI_try <- try(caret::varImp(nb_fit), silent = TRUE)
if (!inherits(VI_try, "try-error") && !is.null(VI_try$importance)) {
# Caminho 1: varImp funcionou
VI_tbl <- as.data.frame(VI_try$importance)
VI_tbl <- tibble::rownames_to_column(VI_tbl, "feature")
# Nome 'Overall' é o usual do caret
if (!"Overall" %in% names(VI_tbl)) {
# se por acaso vier em outro formato, cria um Overall
num_cols <- sapply(VI_tbl, is.numeric)
VI_tbl$Overall <- do.call(pmax, c(VI_tbl[ , num_cols, drop = FALSE], na.rm = TRUE))
}
VI_tbl <- dplyr::arrange(VI_tbl, dplyr::desc(Overall))
cat("\nTop 8 variáveis (varImp):\n")
print(utils::head(VI_tbl, 8), row.names = FALSE)
} else {
# Caminho 2: fallback com filterVarImp
X_nb <- dplyr::select(df_nb_tr, -Survived)
y_nb <- df_nb_tr$Survived # <- vetor fator, NÃO use df_nb_tr["Survived"]
y_nb <- droplevels(y_nb)
VI_nb <- caret::filterVarImp(X_nb, y_nb, nonpara = TRUE)
VI_tbl <- as.data.frame(VI_nb)
VI_tbl <- tibble::rownames_to_column(VI_tbl, "feature")
# Se vier 'Overall', usa; senão calcula Overall como o máximo entre as colunas numéricas (ex.: 'pos'/'neg')
if ("Overall" %in% names(VI_tbl)) {
VI_tbl <- dplyr::arrange(VI_tbl, dplyr::desc(Overall))
} else {
num_cols <- sapply(VI_tbl, is.numeric)
VI_tbl$Overall <- do.call(pmax, c(VI_tbl[ , num_cols, drop = FALSE], na.rm = TRUE))
VI_tbl <- dplyr::arrange(VI_tbl, dplyr::desc(Overall))
}
cat("\nTop 8 variáveis (filterVarImp):\n")
print(utils::head(VI_tbl, 8), row.names = FALSE)
}##
## Top 8 variáveis (filterVarImp):
## feature pos neg Overall
## Sex 0.7601368 0.7601368 0.7601368
## Pclass 0.6686126 0.6686126 0.6686126
## Fare 0.6142544 0.6142544 0.6142544
## Embarked 0.5856950 0.5856950 0.5856950
## Parch 0.5632097 0.5632097 0.5632097
## SibSp 0.5449496 0.5449496 0.5449496
## Age 0.5150310 0.5150310 0.5150310Garantias antes de rodar:
o trecho
stopifnot(exists("nb_fit"), exists("df_nb_va")): Interrompe
se o modelo Naive Bayes (nb_fit) ou o holdout de validação (df_nb_va)
não existirem no ambiente.
Para pontuar o holdout com o NB:
prob_va_nb <- predict(nb_fit, newdata = df_nb_va, type = "prob")[,"pos"]
– Gera, para cada passageiro do holdout, a probabilidade da classe
positiva (“pos” = sobreviveu). – Resultado: um vetor numérico de
probabilidades entre 0 e 1.
Para transformar probabilidade em rótulo (classe) com corte 0.5:
pred_va_nb <- factor(ifelse(prob_va_nb >= 0.5, "pos","neg"), levels = c("pos","neg"))
– Converte cada probabilidade em “pos” (≥0.5) ou “neg” (<0.5). – Define o fator com níveis na ordem correta (primeiro o “pos”).
Para calcular a matriz de confusão + métricas tradicionais:
cm_nb <- caret::confusionMatrix(pred_va_nb, df_nb_va$Survived, positive = "pos")
– Retorna acurácia, kappa, sensibilidade, especificidade, etc.,
comparando previsto x real no holdout.
Para calcular a ROC/AUC no holdout (independente do corte 0.5):
roc_nb <- pROC::roc(response = df_nb_va$Survived, predictor = prob_va_nb, levels = c("neg","pos"))
– Usa as probabilidades para construir a curva ROC. – A AUC mede o poder
discriminativo global do modelo.
Resumo com os números-chave:
resumo_nb <- data.frame( AUC = as.numeric(pROC::auc(roc_nb)), Acuracia = unname(cm_nb$overall["Accuracy"]), Kappa = unname(cm_nb$overall["Kappa"]), Sensibilidade = unname(cm_nb$byClass["Sensitivity"]), Especificidade = unname(cm_nb$byClass["Specificity"]), BalAccuracy = unname(cm_nb$byClass["Balanced Accuracy"]) ) print(round(resumo_nb, 4))
Isso monta uma tabela com AUC, acurácia, kappa, sensibilidade, especificidade e balanced accuracy.
Importância de variáveis (com plano B se varImp falhar)
VI_try <- try(caret::varImp(nb_fit), silent = TRUE) if (inherits(VI_try, “try-error”)) { X_nb <- dplyr::select(df_nb_tr, -Survived) y_nb <- df_nb_tr\(Survived VI_nb <- caret::filterVarImp(X_nb, y_nb, nonpara = TRUE) VI_nb <- VI_nb[order(-VI_nb\)Overall), , drop = FALSE] cat(“ variáveis (filterVarImp):”) print(round(head(VI_nb, 8), 4)) } else { cat(“ variáveis (varImp):”) print(head(VI_try\(importance[order(-VI_try\)importance$Overall), , drop = FALSE], 8)) }
– Nesse trecho acima tenta-se pegar a importância de variáveis do modelo via caret::varImp(nb_fit). – Se der erro (acontece às vezes com NB), cai no plano B: usa filterVarImp (método de filtro) para ranquear as features pela capacidade de separação entre classes. – Em ambos os casos, imprime o Top 8 mais influentes — perfeito para comentar quais variáveis mais pesaram (ex.: Sex, Pclass, Age, Fare…).
O que se vê ao executar:
Uma tabela pequena com AUC, Acurácia, Kappa, Sensibilidade, Especificidade e Balanced Accuracy.
Uma lista do Top-8 de variáveis mais importantes (pelo varImp ou pelo fallback filterVarImp).
As variáveis, Features”, (da maior para a menor importância)
Sex ~ 0.76 → variável mais forte, sozinha já separa bem sobreviventes de não-sobreviventes.
Pclass ~ 0.67 → também muito informativa.
Fare ~ 0.61, Embarked ~ 0.59, Parch ~ 0.56, SibSp ~ 0.54, Age ~ 0.52 → todas acrescentam algo, mas menos que Sex e Pclass; Age ~ 0.52 está quase neutra.
Isso bate com a intuição do Titanic: sexo e classe são os drivers principais; tarifa (correlata a classe) e idade ajudam, mas menos.
3.5 Desenvolvimento de um classificador de redes neurais artificiais
3.5.1 Códigos
# ======= Rede Neural (nnet) – Preparação =======
# Reaproveita objetos já criados no projeto:
# x_tr_sc, x_va_sc -> preditores numéricos (dummies + escala)
# y_tr, y_va -> resposta 0/1
stopifnot(exists("x_tr_sc"), exists("x_va_sc"), exists("y_tr"), exists("y_va"))
# Monta data frames no formato que o caret espera
df_nn_tr <- cbind(Survived = y_tr, x_tr_sc) |> as.data.frame()
df_nn_va <- cbind(Survived = y_va, x_va_sc) |> as.data.frame()
# Classe positiva como primeiro nível (exigência do twoClassSummary/ROC)
df_nn_tr$Survived <- factor(df_nn_tr$Survived, levels = c(1,0), labels = c("pos","neg"))
df_nn_va$Survived <- factor(df_nn_va$Survived, levels = c(1,0), labels = c("pos","neg"))
# Checagens
stopifnot(!anyNA(df_nn_tr), !anyNA(df_nn_va))
stopifnot(all(sapply(df_nn_tr[,-1], is.numeric)))# ======= Controle de treino e grade de hiperparâmetros =======
set.seed(123)
ctrl_nn <- caret::trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
classProbs = TRUE,
summaryFunction = caret::twoClassSummary, # vai otimizar AUC
savePredictions = "final"
)
# size = nº de neurônios na camada oculta
# decay = regularização L2 (evita overfitting)
grid_nn <- expand.grid(
size = c(1, 3, 5, 7, 9),
decay = c(0, 1e-4, 1e-3, 1e-2, 1e-1)
)# ======= Treinamento =======
# Aumentamos MaxNWts para evitar erro quando há muitas dummies
set.seed(123)
nn_fit <- caret::train(
Survived ~ .,
data = df_nn_tr,
method = "nnet",
trControl = ctrl_nn,
tuneGrid = grid_nn,
metric = "ROC",
trace = FALSE,
MaxNWts = 100000
)
nn_fit## Neural Network
##
## 712 samples
## 8 predictor
## 2 classes: 'pos', 'neg'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 570, 570, 569, 570, 569, 570, ...
## Resampling results across tuning parameters:
##
## size decay ROC Sens Spec
## 1 0e+00 0.8143018 0.6654088 0.8592010
## 1 1e-04 0.8285418 0.6603774 0.8657595
## 1 1e-03 0.8305060 0.6490566 0.8748065
## 1 1e-02 0.8348069 0.6742138 0.8635372
## 1 1e-01 0.8399856 0.6314465 0.9016063
## 3 0e+00 0.8347734 0.6830189 0.8610986
## 3 1e-04 0.8225182 0.6327044 0.8740990
## 3 1e-03 0.8333298 0.6628931 0.8851602
## 3 1e-02 0.8444770 0.6654088 0.8725593
## 3 1e-01 0.8494874 0.6679245 0.8881898
## 5 0e+00 0.8242448 0.6742138 0.8761715
## 5 1e-04 0.8253949 0.6616352 0.8650187
## 5 1e-03 0.8165240 0.6742138 0.8575531
## 5 1e-02 0.8347178 0.7069182 0.8620308
## 5 1e-01 0.8479086 0.6792453 0.8783937
## 7 0e+00 0.8273144 0.6930818 0.8425718
## 7 1e-04 0.8138896 0.6616352 0.8590096
## 7 1e-03 0.8020890 0.6893082 0.8515439
## 7 1e-02 0.8142160 0.6704403 0.8620558
## 7 1e-01 0.8470827 0.6943396 0.8844112
## 9 0e+00 0.7877937 0.6477987 0.8501124
## 9 1e-04 0.8003242 0.6943396 0.8403329
## 9 1e-03 0.8071287 0.6805031 0.8447524
## 9 1e-02 0.7953323 0.6540881 0.8508781
## 9 1e-01 0.8447729 0.6930818 0.8813899
##
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were size = 3 and decay = 0.1.plot(nn_fit) # AUC média por combinação (size x decay)
nn_fit$bestTune## size decay
## 10 3 0.1# ======= Avaliação no holdout =======
library(pROC)
# Probabilidade da classe positiva ("pos")
prob_va_nn <- predict(nn_fit, newdata = df_nn_va, type = "prob")[,"pos"]
pred_va_nn <- factor(ifelse(prob_va_nn >= 0.5, "pos","neg"), levels = c("pos","neg"))
# Matriz de confusão
cm_nn <- caret::confusionMatrix(pred_va_nn, df_nn_va$Survived, positive = "pos")
cm_nn## Confusion Matrix and Statistics
##
## Reference
## Prediction pos neg
## pos 56 12
## neg 19 90
##
## Accuracy : 0.8249
## 95% CI : (0.7607, 0.8778)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 1.566e-12
##
## Kappa : 0.6369
##
## Mcnemar's Test P-Value : 0.2812
##
## Sensitivity : 0.7467
## Specificity : 0.8824
## Pos Pred Value : 0.8235
## Neg Pred Value : 0.8257
## Prevalence : 0.4237
## Detection Rate : 0.3164
## Detection Prevalence : 0.3842
## Balanced Accuracy : 0.8145
##
## 'Positive' Class : pos
## # ROC / AUC
roc_nn <- pROC::roc(response = df_nn_va$Survived, predictor = prob_va_nn, levels = c("neg","pos"))
pROC::auc(roc_nn)## Area under the curve: 0.8765# ======= Importância (aproximação) =======
# Para nnet, varImp do caret calcula um score baseado nos pesos; é útil como guia.
caret::varImp(nn_fit)## nnet variable importance
##
## Overall
## Pclass 100.000
## Sex.male 93.512
## Parch 57.081
## Age 55.723
## Fare 30.184
## Embarked.Q 19.128
## SibSp 1.252
## Embarked.S 0.000nn_fit$results # tabela completa das combinações testadas (ROC, Sens, Spec)## size decay ROC Sens Spec ROCSD SensSD SpecSD
## 1 1 0e+00 0.8143018 0.6654088 0.8592010 0.03534100 0.10172361 0.08957009
## 2 1 1e-04 0.8285418 0.6603774 0.8657595 0.03378129 0.09907265 0.08419042
## 3 1 1e-03 0.8305060 0.6490566 0.8748065 0.03356965 0.08492063 0.07704125
## 4 1 1e-02 0.8348069 0.6742138 0.8635372 0.03039630 0.10684422 0.08758845
## 5 1 1e-01 0.8399856 0.6314465 0.9016063 0.03284614 0.05787726 0.03430444
## 6 3 0e+00 0.8347734 0.6830189 0.8610986 0.04139658 0.09963571 0.06928517
## 7 3 1e-04 0.8225182 0.6327044 0.8740990 0.03928937 0.06909248 0.06021948
## 8 3 1e-03 0.8333298 0.6628931 0.8851602 0.04159101 0.07126649 0.04573693
## 9 3 1e-02 0.8444770 0.6654088 0.8725593 0.03771988 0.07891945 0.04877009
## 10 3 1e-01 0.8494874 0.6679245 0.8881898 0.03297234 0.07265639 0.03173794
## 11 5 0e+00 0.8242448 0.6742138 0.8761715 0.03789685 0.08330832 0.04909277
## 12 5 1e-04 0.8253949 0.6616352 0.8650187 0.03889495 0.05015699 0.06292040
## 13 5 1e-03 0.8165240 0.6742138 0.8575531 0.03897325 0.04365135 0.04691898
## 14 5 1e-02 0.8347178 0.7069182 0.8620308 0.03489592 0.05282377 0.05644116
## 15 5 1e-01 0.8479086 0.6792453 0.8783937 0.03560721 0.06175978 0.05074961
## 16 7 0e+00 0.8273144 0.6930818 0.8425718 0.03592722 0.05452922 0.05688486
## 17 7 1e-04 0.8138896 0.6616352 0.8590096 0.03339761 0.05857600 0.03557886
## 18 7 1e-03 0.8020890 0.6893082 0.8515439 0.04106800 0.05377792 0.04184659
## 19 7 1e-02 0.8142160 0.6704403 0.8620558 0.03911518 0.07406597 0.04706270
## 20 7 1e-01 0.8470827 0.6943396 0.8844112 0.03080912 0.04794511 0.04269175
## 21 9 0e+00 0.7877937 0.6477987 0.8501124 0.04746541 0.08811447 0.03683358
## 22 9 1e-04 0.8003242 0.6943396 0.8403329 0.04186910 0.03853599 0.03783570
## 23 9 1e-03 0.8071287 0.6805031 0.8447524 0.03609433 0.05452922 0.05246636
## 24 9 1e-02 0.7953323 0.6540881 0.8508781 0.02742820 0.07260971 0.03980245
## 25 9 1e-01 0.8447729 0.6930818 0.8813899 0.03178665 0.04306487 0.04196162nn_fit$bestTune # (já impresso) size/decay vencedores## size decay
## 10 3 0.1plot(nn_fit) # gráfico AUC média por combinação
3.5.2 Explicando os códigos desse classificador (Redes neurais)
O que cada código acima faz:
nn-prep Monta df_nn_tr e df_nn_va com apenas números nos preditores (dummies já escaladas) e a resposta como fator com níveis c(“pos”,“neg”). RNAs precisam de escala; você já tem isso pronto (ótimo).
nn-ctrl-grid Define a validação cruzada 5×3 (mesma dos outros modelos) e uma grade de hiperparâmetros: size: neurônios na camada oculta (capacidade do modelo). decay: regularização L2 (quanto maior, mais “suave” e menos overfit). A métrica de seleção é AUC (ROC).
nn-train Treina a MLP com caret::train(method=“nnet”), explora a grade e escolhe a melhor combinação size/decay. MaxNWts foi elevado para evitar erro quando há muitas colunas (muitas dummies). plot(nn_fit) mostra a AUC média por configuração.
nn-eval No holdout (seu df_nn_va): pega probabilidades da classe positiva, gera a matriz de confusão no corte 0,5, calcula ROC/AUC (independente do corte, ótimo para comparar com KNN/Árvore/NB).
nn-varimp Mostra uma importância aproximada dos preditores (baseada nos pesos). Não é tão interpretável quanto árvore, mas serve para “senso de direção”.
Na tabela bestTune (mais acima), temos um data.frame com 1 linha e 2 colunas:
size decay 3 0.1
size = 3 → a MLP escolhida na validação cruzada tem 3 neurônios na camada oculta (arquitetura simples, 1 camada oculta).
decay = 0.1 → força de regularização L2 aplicada aos pesos (quanto maior, mais penaliza pesos grandes, reduzindo overfitting).
Essa combinação foi a melhor dentre a grade que você testou, segundo a AUC (ROC) em CV 5×3 (definida em metric=“ROC” + twoClassSummary). Ou seja, dentre todas as (size, decay) avaliadas, (3, 0.1) deu a maior AUC média nas dobras.
O que o nn_fit$results e nn_fit$bestTune
mostram:
nn_fit$results é a tabela com todas as combinações testadas na validação cruzada (5×3, como você vinha usando). Para cada par de hiperparâmetros:
size: nº de neurônios na camada escondida (1, 3, 5, 7, 9, …).
decay: regularização L2 (penaliza pesos grandes e ajuda a evitar overfitting).
Métricas médias por CV: ROC (AUC), Sens, Spec + seus desvios.
nn_fit$bestTune (na sua tela aparece um tibble 1×2 com size = 3 e decay = 0.1) é a melhor combinação segundo a AUC média da CV. Interpretação: para esse seu conjunto e preparação de dados, uma rede pequena (3 neurônios) com regularização moderada (0.1) generalizou melhor nos folds.
Essa escolha de “pequena + regularizada” é comum no Titanic: os sinais (Sex, Pclass, Age…) não exigem redes grandes, e um pouco de penalização estabiliza o ajuste.
O que os gráficos significam:
Rodei um plot(nn_fit), que desenha a AUC média (ROC) por hiperparâmetro: Gráfico com “Weight Decay” no topo
Cada cor/linha é um valor de decay (0, 1e-04, 0.001, 0.01, 0.1).
Eixo X: #Hidden Units (o size).
Eixo Y: AUC média da CV.
Como ler: para cada valor de decay, veja como a AUC muda quando você aumenta o nº de neurônios.
Nesse caso, a linha do decay = 0.1 fica entre as melhores, especialmente para size pequeno (≈3). Quando o size cresce muito, a AUC tende a cair — sinal clássico de overfitting (rede grande demais para o problema).
O segundo gráfico (foco no eixo X) é a mesma ideia, só que enfatiza o efeito de aumentar o size:
Podemos observar a AUC subir até um pico e depois descer.
O pico ocorre nas arquiteturas menores; depois a rede fica mais instável e perde generalização.
Por isso o bestTune dá size = 3.
Conclusão visual: há um “doce-spot” com poucos neurônios e decay > 0, exatamente o que o bestTune selecionou.
Em resumo, a RNA melhor é size = 3, decay = 0.1, escolhida por AUC média de CV; os gráficos mostram que redes maiores começam a overfit, e a regularização ajuda a estabilizar — por isso “pequena + decay” venceu.
3.6 Desenvolvimento de um classificador máquina de vetor de suporte
3.6.1 Preparação dos dados
#### SVM — preparação dos dados (usando a mesma rota do k-NN) ####
# Pré-requisitos desta etapa (devem existir no ambiente):
# - x_tr_sc, x_va_sc : preditores numéricos (dummies + padronização)
# - y_tr, y_va : resposta binária 0/1
stopifnot(exists("x_tr_sc"), exists("x_va_sc"), exists("y_tr"), exists("y_va"))
# Monta data frames no formato caret: y como fator e X numérico
df_svm_tr <- cbind(Survived = y_tr, x_tr_sc) |> as.data.frame()
df_svm_va <- cbind(Survived = y_va, x_va_sc) |> as.data.frame()
# Classe POSITIVA deve ser o primeiro nível (exigência do twoClassSummary/ROC)
df_svm_tr$Survived <- factor(df_svm_tr$Survived, levels = c(1, 0), labels = c("pos","neg"))
df_svm_va$Survived <- factor(df_svm_va$Survived, levels = c(1, 0), labels = c("pos","neg"))
# Checagens: sem NAs e todos preditores numéricos
stopifnot(!anyNA(df_svm_tr), !anyNA(df_svm_va))
stopifnot(all(sapply(dplyr::select(df_svm_tr, -Survived), is.numeric)))
stopifnot(all(sapply(dplyr::select(df_svm_va, -Survived), is.numeric)))
# Espiar dimensões
dim(df_svm_tr); dim(df_svm_va)## [1] 712 9## [1] 177 9No código acima reaproveitei o mesmo pipeline do k-NN: dummies + padronização já feitas → ótimo para SVM.
A resposta vira fator com “pos” como primeiro nível (necessário para AUC/ROC no caret).
Garantimos sem NAs e somente numéricos nas features.
Temos o seguinte para o resultado:
dim(df_svm_tr) → [1] 712 9 • 712 linhas: são as amostras do
conjunto de treino (≈80% do total). • 9 colunas: 1 alvo (Survived, fator
com níveis pos/neg) + 8 preditores numéricos (já em dummies e
padronizados).
dim(df_svm_va) → [1] 177 9 • 177 linhas: são as amostras
do holdout/validação (≈20%). • 9 colunas: mesma estrutura do treino (1
alvo + 8 preditores), o que garante que o espaço de features é
idêntico.
Como não apareceu nenhuma mensagem dos stopifnot(…), significa que:
não há NAs nos data frames, todos os preditores são numéricos, a variável resposta está como fator com classe positiva = “pos”.
Ou seja: os dados estão no formato que o caret precisa para treinar o SVM com AUC/ROC de forma correta.
3.6.2 Controle de treino e grade
#### SVM — controle de treino e grade (RBF) ####
library(caret)
library(kernlab)
set.seed(123)
# 1) Controle de treino: CV 5x3, métrica = ROC
ctrl_svm <- trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary, # calcula ROC, Sens, Spec
savePredictions = "final"
)
# 2) Estimativa inicial de sigma (γ) a partir dos preditores do TREINO
X_only <- dplyr::select(df_svm_tr, -Survived)
sig_est <- kernlab::sigest(as.matrix(X_only), frac = 1.0) # retorna ~ c(min, mediana, max)
sig_est## 90% 50% 10%
## 0.02959935 0.07889319 0.56473928# 3) Monta uma grade (σ, C) em torno da estimativa
sigma_seq <- as.numeric(sig_est) |> sort()
sigma_seq <- unique(c(sigma_seq[1]/2, sigma_seq, sigma_seq[3]*2))
C_seq <- 2 ^ seq(-3, 7, by = 2) # {1/8, 1/2, 2, 8, 32, 128}
grid_svm <- expand.grid(sigma = sigma_seq, C = C_seq)
# Conferência rápida
head(grid_svm); nrow(grid_svm)## sigma C
## 1 0.01479968 0.125
## 2 0.02959935 0.125
## 3 0.07889319 0.125
## 4 0.56473928 0.125
## 5 1.12947856 0.125
## 6 0.01479968 0.500## [1] 30O que este código acima faz:
Define o esquema de validação (CV 5×3) com AUC/ROC como métrica de seleção.
Estima um valor razoável para sigma (γ) usando sigest() no treino (evita vazamento).
Cria uma grade combinando vários sigma próximos da estimativa e uma sequência exponencial de C (controle de margem), para o svmRadial.
Já os resultados acima mostram a grade de hiperparâmetros para o SVM com kernel RBF (gaussiano).
O que o código fez:
Construiu sequências de valores para sigma e para C:
sigma_seq: veio de uma estimativa inicial (sig_est) e foi expandida para cobrir valores um pouco menores, iguais e maiores (é o parâmetro do kernel gaussiano do kernlab). No RBF do kernlab a função é k(x,y)=exp(-sigma * ||x-y||^2). • Sigma maior → kernel mais “estreito” (fronteira mais complexa, maior risco de overfitting). • Sigma menor → kernel mais “largo” (fronteira mais suave).
C_seq <- 2^(seq(-3, 7, by = 2)) → gera C em potências de 2: {1/8, 1/2, 2, 8, 32, 128}. • C pequeno → margem mais larga, mais regularização (tende a subajustar). • C grande → pune mais os erros (tende a ajustar mais, risco de overfitting).
Fez o produto cartesiano desses dois vetores com expand.grid(sigma = sigma_seq, C = C_seq):
Isso cria todas as combinações possíveis de sigma × C para o caret::train testar na validação cruzada.
Como ler os resultados mostrados:
nrow(grid_svm) retornando 30 (imagem 1, parte inferior): Significa que sua grade tem 30 combinações. Ex.: se sigma_seq tem 5 valores e C_seq tem 6 valores ⇒ 5×6 = 30.
head(grid_svm) (as 6 primeiras linhas) (imagens 1 e 2): É só uma “amostra” da grade. Você vê pares como:
Podemos observar que C começa fixo em 0.125 (1/8) e sigma varia; depois C muda para 0.5 e sigma recomeça — exatamente o comportamento de expand.grid.
Com essa grade, o caret::train(method = “svmRadial”, tuneGrid = grid_svm, …) vai treinar/avaliar 30 modelos (um para cada par sigma–C) usando sua CV (ex.: 5×3) e, no fim, escolher a combinação que maximizar a métrica (tipicamente ROC/AUC).
3.6.3 treino com caret usando a grade grid
### SVM (RBF) — treino com caret usando a grade grid_svm
set.seed(123)
ctrl_svm <- caret::trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
classProbs = TRUE,
summaryFunction = caret::twoClassSummary, # calcula ROC, Sens, Spec
savePredictions = "final"
)
svm_fit <- caret::train(
Survived ~ .,
data = df_svm_tr, # seu conjunto de treino preparado p/ SVM
method = "svmRadial",
trControl = ctrl_svm,
tuneGrid = grid_svm, # combinações sigma × C (30 no seu caso)
metric = "ROC",
preProcess = c("center","scale") # por garantia (mantém mesma escala)
)
svm_fit## Support Vector Machines with Radial Basis Function Kernel
##
## 712 samples
## 8 predictor
## 2 classes: 'pos', 'neg'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 570, 570, 569, 570, 569, 570, ...
## Resampling results across tuning parameters:
##
## sigma C ROC Sens Spec
## 0.01479968 0.125 0.8468418 0.6981132 0.8225468
## 0.01479968 0.500 0.8442074 0.6641509 0.8575780
## 0.01479968 2.000 0.8395180 0.6591195 0.8791844
## 0.01479968 8.000 0.8385731 0.6767296 0.8888556
## 0.01479968 32.000 0.8390145 0.6654088 0.9075073
## 0.01479968 128.000 0.8288668 0.6641509 0.9276488
## 0.02959935 0.125 0.8482090 0.6779874 0.8516022
## 0.02959935 0.500 0.8400494 0.6603774 0.8799251
## 0.02959935 2.000 0.8366161 0.6704403 0.8881398
## 0.02959935 8.000 0.8372840 0.6704403 0.9052684
## 0.02959935 32.000 0.8269657 0.6616352 0.9246858
## 0.02959935 128.000 0.8110157 0.6490566 0.9253933
## 0.07889319 0.125 0.8443569 0.6729560 0.8821473
## 0.07889319 0.500 0.8394129 0.6867925 0.8881232
## 0.07889319 2.000 0.8442906 0.6742138 0.9090137
## 0.07889319 8.000 0.8285977 0.6616352 0.9269080
## 0.07889319 32.000 0.8146222 0.6389937 0.9179276
## 0.07889319 128.000 0.8012308 0.6352201 0.9015065
## 0.56473928 0.125 0.8464986 0.7635220 0.8135997
## 0.56473928 0.500 0.8438724 0.6880503 0.8977861
## 0.56473928 2.000 0.8291542 0.6817610 0.8910612
## 0.56473928 8.000 0.8114623 0.6591195 0.8821307
## 0.56473928 32.000 0.7911233 0.6238994 0.8836704
## 0.56473928 128.000 0.7656457 0.5622642 0.8933417
## 1.12947856 0.125 0.8410103 0.8000000 0.7360133
## 1.12947856 0.500 0.8383934 0.7157233 0.8679484
## 1.12947856 2.000 0.8168122 0.6742138 0.8783687
## 1.12947856 8.000 0.8004074 0.6402516 0.8724261
## 1.12947856 32.000 0.7787900 0.5672956 0.8836704
## 1.12947856 128.000 0.7596196 0.4465409 0.8993258
##
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were sigma = 0.02959935 and C = 0.125.svm_fit$bestTune # sigma e C vencedores## sigma C
## 7 0.02959935 0.125plot(svm_fit) # ROC médio por combinação (painel facetado)
O que o código acima faz:
Define o mesmo esquema de CV (5×3) com AUC como métrica.
Treina 1 modelo para cada par sigma × C da sua grid_svm.
Mostra o resumo do treino, a melhor combinação (bestTune) e o gráfico da AUC média por combinação.
Ocódigo acima é justamente a etapa em que o SVM (kernel RBF) foi treinado no caret com validação cruzada e busca em grade, e depois resumimos/visualizamos os resultados.
O que cada saída mostra: svm_fit (tabela no Console)
A tabela lista, para várias combinações de hiperparâmetros, a métrica média de CV: sigma: largura do kernel RBF (γ no sentido do sklearn; no kernlab/caret ele aparece como sigma).
C: custo/penalidade do erro.
ROC (média das dobras de CV) e seus intervalos associadas (as colunas podem variar conforme a versão, mas a mensagem final do caret é clara).
A linha final do caret diz: “ROC was used to select the optimal model using the largest value. The final values used for the model were sigma = 0.02959935 and C = 0.125.” Ou seja, o caret escolheu a combinação com maior ROC médio na CV: σ ≈ 0.0296 e C = 0.125.
svm_fit$bestTune é o “ganhador” da busca: confirma sigma e C escolhidos.
plot(svm_fit): É o gráfico de ROC médio da CV por combinação dos hiperparâmetros.
No painel (facetado por Sigma) você vê linhas correspondendo aos valores de C. Alternando a visualização (como você fez), dá pra ver:
Quando C é muito grande, o ROC médio cai (sinal clássico de overfitting: o modelo “força” margens, memoriza ruído e piora em validação).
Quando sigma é muito grande (kernel muito estreito) ou muito pequeno (kernel muito amplo), o ROC também tende a cair; há um “miolo” de σ onde o desempenho é melhor.
Na sua busca, valores pequenos de C (0.125) com um σ intermediário (~0.03) deram o melhor ROC.
preProcess = c(“center”,“scale”)
Importante: o caret padronizou os preditores dentro de cada reamostragem (sem vazamento), garantindo que todas as features fiquem na mesma escala — essencial para SVM.
Como interpretar os números:
O melhor ROC de CV está em torno de 0.84 (pelas curvas), o que é um bom poder discriminativo.
Tendência observada:
Aumentar C além de ~0.5 degradou o ROC médio: excesso de complexidade.
σ muito diferente de ~0.03 também degrada: o kernel fica “estreito demais” (memoriza) ou “largo demais” (subajuste).
O que fazer em seguida:
Com o modelo final já definido (σ≈0.0296, C=0.125), o próximo passo natural é:
Pontuar o holdout (train_va) com predict(svm_fit, type=“prob”) para obter probabilidades da classe “pos”.
Montar matriz de confusão (threshold 0.5 ou otimizado) e calcular ROC/AUC no holdout com pROC.
3.6.4 Avaliação no holdout (validação)
### SVM — avaliação no holdout (validação) --------------------------
# Probabilidade da classe positiva ("pos") no holdout
prob_va_svm <- predict(svm_fit, newdata = df_svm_va, type = "prob")[, "pos"]
# Classe prevista com limiar padrão 0.5
pred_va_svm <- factor(ifelse(prob_va_svm >= 0.5, "pos", "neg"),
levels = c("pos","neg"))
# Matriz de confusão (classe positiva = "pos")
cm_svm <- caret::confusionMatrix(
data = pred_va_svm,
reference = df_svm_va$Survived,
positive = "pos"
)
cm_svm## Confusion Matrix and Statistics
##
## Reference
## Prediction pos neg
## pos 54 13
## neg 21 89
##
## Accuracy : 0.8079
## 95% CI : (0.7421, 0.8632)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 5.544e-11
##
## Kappa : 0.601
##
## Mcnemar's Test P-Value : 0.2299
##
## Sensitivity : 0.7200
## Specificity : 0.8725
## Pos Pred Value : 0.8060
## Neg Pred Value : 0.8091
## Prevalence : 0.4237
## Detection Rate : 0.3051
## Detection Prevalence : 0.3785
## Balanced Accuracy : 0.7963
##
## 'Positive' Class : pos
## # Curva ROC e AUC no holdout
roc_svm <- pROC::roc(response = df_svm_va$Survived,
predictor = prob_va_svm,
levels = c("neg","pos"))
pROC::auc(roc_svm)## Area under the curve: 0.8795# (opcional) visualizar curva ROC
plot.roc(roc_svm, print.auc = TRUE, legacy.axes = TRUE)
# (opcional) melhor limiar pelo critério de Youden-J
thr_best <- pROC::coords(roc_svm, "best", best.method = "youden", transpose = TRUE)
thr_best## threshold specificity sensitivity
## 0.2372801 0.8529412 0.8133333# (opcional) reavaliar a matriz de confusão usando o limiar ótimo
pred_va_svm_best <- factor(ifelse(prob_va_svm >= thr_best["threshold"], "pos","neg"),
levels = c("pos","neg"))
cm_svm_best <- caret::confusionMatrix(pred_va_svm_best, df_svm_va$Survived, positive = "pos")
cm_svm_best## Confusion Matrix and Statistics
##
## Reference
## Prediction pos neg
## pos 61 15
## neg 14 87
##
## Accuracy : 0.8362
## 95% CI : (0.7732, 0.8874)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 1.202e-13
##
## Kappa : 0.6651
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.8133
## Specificity : 0.8529
## Pos Pred Value : 0.8026
## Neg Pred Value : 0.8614
## Prevalence : 0.4237
## Detection Rate : 0.3446
## Detection Prevalence : 0.4294
## Balanced Accuracy : 0.8331
##
## 'Positive' Class : pos
## O que esse código faz:
predict(…, type=“prob”): gera as probabilidades de “sobrevive” (classe pos) para cada passageiro do holdout.
confusionMatrix (corte 0.5): retorna acurácia, sensibilidade, especificidade, Kappa, etc.
roc / auc: calcula a AUC no holdout (métrica independente do limiar).
Opcional – Youden-J: encontra um limiar que maximiza (sens + espec − 1) e refaz a matriz de confusão nesse corte, caso você queira mais sensibilidade (ou melhor equilíbrio) do que o threshold 0.5 entrega.
Nas saídas observa-se dois quadros que mostram o desempenho do seu SVM-RBF no holdout (o train_va) e a curva ROC correspondente. Matriz de confusão + métricas (console)
Positive class : pos → consideramos “sobreviveu” como classe positiva.
Sensitivity (TPR) = 0.8133 Entre os que realmente sobreviveram, o modelo acerta ~81%. (Poucos falsos negativos.)
Specificity (TNR) = 0.8529 Entre os que não sobreviveram, o modelo acerta ~85%. (Poucos falsos positivos.)
Pos Pred Value (PPV) = 0.8026 Quando o modelo diz “vai sobreviver”, ele acerta ~80% das vezes.
Neg Pred Value (NPV) = 0.8614 Quando diz “não vai sobreviver”, acerta ~86%.
Prevalence = 0.4237 Proporção de sobreviventes no holdout (~42%).
Detection Rate = 0.3446 Fração total de casos corretamente detectados como positivos (= Sensitivity × Prevalence).
Detection Prevalence = 0.4294 Fração que o modelo previu como positiva (próxima da prevalência real — bom sinal).
Balanced Accuracy = 0.8331 Média de Sensitivity e Specificity; útil com leve desbalanceamento. 0.83 é forte.
Em resumo: o classificador está bem balanceado (sens ~81%, espec ~85%), com bons PPV/NPV. Para captar ainda mais sobreviventes (↑Sensitivity), você pode baixar o limiar de 0.5 e reavaliar a matriz; a Specificity cairá um pouco (trade-off).
Curva ROC (painel visual)
A curva está bem acima da diagonal (linha cinza), com AUC = 0.879. AUC próximo de 0.9 indica excelente separação entre as classes ao variar o limiar.
O trecho inicial “colado” ao eixo vertical mostra que existem limiares em que a sensibilidade sobe muito com pouca perda de especificidade — útil se seu objetivo for priorizar recall.
Contexto do modelo:
Esses resultados refletem o SVM escolhido no grid (antes você viu sigma ≈ 0.0296 e C = 0.125).
O desempenho reportado aqui é fora da amostra (holdout), portanto é uma boa estimativa de generalização.
Observações:
Se o custo de perder um sobrevivente for maior, devemos reduzir o threshold (<0.5) e voltar a medir Sens/Spec; a AUC não muda, mas a posição na ROC sim.
Se quisermos interpretar mais: podemos gerar a curva Precision–Recall (útil quando a classe positiva é minoritária) e calcular o Youden-J para escolher um limiar ótimo (Sens + Spec − 1).
3.7 Desenvolvimento de um classificador Random Forrest
3.7.1 Preparação dos dados (mesmo formato da Árvore/NB)
# --- RF — Chunk 1: preparação dos dados -------------------------------
# Pacotes
suppressPackageStartupMessages({
library(caret)
library(randomForest) # backend do método "rf" no caret
library(pROC)
library(dplyr)
})
# Monta treino/validação com as mesmas variáveis do projeto
df_rf_tr <- train_tr %>%
dplyr::select(Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked)
df_rf_va <- train_va %>%
dplyr::select(Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked)
# Garante resposta como fator binário com classe positiva primeiro
# (exigência do twoClassSummary para ROC no caret)
df_rf_tr$Survived <- factor(df_rf_tr$Survived, levels = c("pos","neg"))
df_rf_va$Survived <- factor(df_rf_va$Survived, levels = c("pos","neg"))
# Checagens rápidas (sem NA e tipos válidos)
stopifnot(!anyNA(df_rf_tr), !anyNA(df_rf_va))
stopifnot(all(vapply(df_rf_tr, function(x) is.numeric(x) || is.factor(x), logical(1))))
# Dimensões
dim(df_rf_tr); dim(df_rf_va)## [1] 712 8## [1] 177 8O que este código faz:
carrega os pacotes necessários;
seleciona as mesmas 8 features padrão + Survived;
define Survived como fator com “pos” primeiro (para ROC no caret);
valida que não há NAs e que todos os preditores são numéricos ou fatores;
mostra as dimensões de treino e validação.
De forma mais detalhada:
df_rf_tr$Survived <- factor(…, levels = c(“pos”,“neg”)) (mesma coisa no df_rf_va): coloca a classe positiva (“pos”) como primeiro nível do fator. Por quê? O caret usa isso quando calculamos ROC/AUC com twoClassSummary. Se a ordem estivesse invertida, as métricas poderiam sair trocadas.
Checagens com stopifnot(…)
!anyNA(df_rf_tr) e !anyNA(df_rf_va): confirma que não há valores faltantes nos conjuntos. Random Forest até lida com fatores e números mistos, mas não aceita NA no treinamento.
all(vapply(…, is.numeric(x) || is.factor(x))): garante que cada coluna é numérica ou fator. RF trabalha direto com esses dois tipos (não precisa transformar em dummies nem padronizar).
Nessas saídas:
dim(df_rf_tr); dim(df_rf_va) [1] 712 8 [1] 177 8
712 × 8 no treino (df_rf_tr) e 177 × 8 na validação (df_rf_va).
O 712 e 177 vêm do split estratificado 80/20 feito lá atrás (aprox. 80% treino, 20% holdout).
O 8 são as colunas que vamos usar: Survived + Pclass, Sex, Age, SibSp, Parch, Fare, Embarked (8 no total).
Em resumo:
Os dados de treino/validação estão sem NAs, com tipos corretos, e a resposta está codificada com “pos” primeiro.
Isso significa que o dataset está pronto para treinar o Random Forest com caret e avaliar por ROC/AUC de forma consistente.
Se visse algo diferente:
NAs → voltar à etapa de imputação.
Nº de colunas ≠ 8 → checar select(…).
Níveis de Survived fora de c(“pos”,“neg”) → ajustar os levels.
3.7.2 Controle de treino e grade de hiperparâmetros
# --- RF: controle de treino e grade de hiperparâmetros -----------------
set.seed(123)
library(caret)
# Nº de preditores (exclui Survived)
p <- ncol(df_rf_tr) - 1 # aqui deve dar 7
# Validação cruzada repetida (5x3) e métrica ROC/AUC
ctrl_rf <- trainControl(
method = "repeatedcv",
number = 5,
repeats = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary, # calcula ROC, Sens, Spec
savePredictions = "final"
)
# Grade de busca para mtry (nº de variáveis sorteadas em cada divisão)
# Como temos 7 preditores, testaremos de 1 a 7:
grid_rf <- expand.grid(mtry = 1:p)
# Conferência rápida
head(grid_rf); nrow(grid_rf)## mtry
## 1 1
## 2 2
## 3 3
## 4 4
## 5 5
## 6 6## [1] 7O que esse código faz:
ctrl_rf: define a validação cruzada 5×3 e pede probabilidades para o caret otimizar por ROC (mais estável com leve desbalanceamento).
grid_rf: monta a grade de mtry (1 a 7, porque temos 7 preditores). O RF escolhe aleatoriamente mtry variáveis a cada split; testar vários valores ajuda a achar o melhor viés-variância.
Portanto, defini como o Random Forest será avaliado enquanto busca o melhor hiperparâmetro.
classProbs = TRUE → pede probabilidades (necessárias para calcular AUC/ROC).
summaryFunction = twoClassSummary → o caret vai calcular ROC (AUC), Sensibilidade e Especificidade em cada dobra da validação.
(presumindo do chunk anterior) method = “repeatedcv”, number = 5, repeats = 3 → validação cruzada 5×3, dá uma estimativa estável do desempenho.
savePredictions = “final” → guarda as predições do melhor modelo (útil p/ diagnósticos depois).
Em grid_rf <- expand.grid(mtry = 1:p): Essa é a grade
de hiperparâmetros. No Random Forest, mtry é o número de variáveis
sorteadas para avaliar a melhor divisão em cada nó da árvore.
p <- ncol(df_rf_tr) - 1 → número de preditores (exclui Survived). No seu caso, p = 7.
Logo, a grade é mtry = 1, 2, 3, 4, 5, 6, 7.
Por que testar 1 a 7? Porque temos 7 preditores. Em RF, mtry controla o “aleatório” por split. Valores pequenos → mais diversidade entre árvores (mais viés, menos variância). Valores grandes → árvores mais “parecidas” (menos viés, mais variância). A validação escolhe o melhor equilíbrio.
Para uma “Conferência rápida”:
head(grid_rf) → imprime as primeiras linhas da grade (mostra a coluna mtry).
nrow(grid_rf) → retornou 7, confirmando que temos 7 combinações a testar.
No painel Environment do RStudio aparece grid_rf: 7 obs. of 1 variable — bate com o esperado.
Em resumo:
Configurei como o caret vai avaliar o modelo (AUC/ROC, CV 5×3).
Preparei o que ele vai testar: mtry de 1 a 7.
Chequei que a grade tem mesmo 7 linhas.
3.7.3 Chunk 3 — Treino do Random Forest
## Chunk 3 — Treino do Random Forest (busca do melhor mtry pela AUC)
set.seed(123) # reprodutibilidade
rf_fit <- caret::train(
Survived ~ .,
data = df_rf_tr, # treino já preparado no chunk 1
method = "rf", # randomForest (Breiman)
trControl = ctrl_rf, # CV 5x3 + AUC
tuneGrid = grid_rf, # mtry = 1..p
metric = "ROC", # escolhe o melhor por AUC
ntree = 1000, # nº de árvores (mais estável)
importance = TRUE # calcula importâncias internas
)
rf_fit # tabela com ROC/Sens/Spec por mtry## Random Forest
##
## 712 samples
## 7 predictor
## 2 classes: 'pos', 'neg'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 570, 570, 569, 570, 569, 570, ...
## Resampling results across tuning parameters:
##
## mtry ROC Sens Spec
## 1 0.8578013 0.5471698 0.9492634
## 2 0.8687431 0.6754717 0.9156721
## 3 0.8702462 0.7069182 0.8918269
## 4 0.8658527 0.7270440 0.8702039
## 5 0.8636737 0.7283019 0.8664752
## 6 0.8610637 0.7308176 0.8605160
## 7 0.8598204 0.7283019 0.8553142
##
## ROC was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 3.rf_fit$bestTune # mtry vencedor## mtry
## 3 3plot(rf_fit) # ROC médio por mtry (CV 5x3)
O que esse código faz: Treina um RF para cada mtry de 1 a 7 usando CV 5×3;
Calcula ROC, Sens, Spec em cada dobra;
Escolhe automaticamente o mtry com maior AUC média;
ntree = 1000 dá estabilidade nas métricas;
importance=TRUE habilita a importância dos preditores (vamos usar já já).
O que foi feito nesse chunk:
Rodei caret::train(method = “rf”) com CV 5×3, métrica ROC e grade mtry = 1:7.
ntree = 500 (floresta estável) e importance = TRUE (vamos poder ver VI depois).
O caret calcula, para cada valor de mtry, as médias de ROC, Sens (sensibilidade) e Spec (especificidade) ao longo das dobras de CV.
Tabela (console):
mtry ROC Sens Spec 1 0.8578 0.5472 0.9493 2 0.8674 0.6754 0.9157 3 0.8702 0.7069 0.8913 ← maior ROC 4 0.8659 0.7272 0.8702 5 0.8637 0.7283 0.8665 6 0.8610 0.7308 0.8650 7 0.8598 0.7283 0.8553
Como interpretar:
mtry = nº de variáveis sorteadas em cada split das árvores.
ROC (média CV) é a métrica de seleção do modelo (quanto maior, melhor).
O melhor desempenho ocorreu em mtry = 3 (ROC ≈ 0,870).
À medida que mtry cresce além de 3, a ROC cai um pouco: as árvores ficam mais parecidas (menos diversidade), o que reduz o ganho de generalização.
Sensibilidade sobe do mtry=1 até ~6/7 (modelo passa a capturar mais positivos), mas a Especificidade cai — típico trade-off. O caret escolhe pelo ROC, que resume o equilíbrio ao variar o limiar.
Gráfico “ROC (Repeated CV) × mtry”:
A curva sobe forte de 1 → 3 (ganho real ao dar mais alternativas de split).
Depois desce gradualmente (perda de diversidade na floresta).
O ponto alto visual é mtry = 3, que bate com a tabela e com rf_fit$bestTune.
Na mensagem do caret: “ROC was used to select the optimal model using the largest value. The final value used for the model was mtry = 3.”
Tradução: ele escolheu mtry=3 porque deu a maior ROC média na CV 5×3. Esse é o modelo salvo em rf_fit$finalModel.
Portanto, o Random Forest fica melhor quando considera 3 preditores aleatórios por split.
Com esse ajuste, ele alcança ROC ≈ 0,87 em validação cruzada — muito competitivo com os outros modelos que treinamos.
Há um trade-off natural: quando se busca mais sensibilidade (pegar mais “pos”), perde um pouco de especificidade; o ROC lida com esse equilíbrio.
3.7.4 avaliação no holdout (validação externa)
## --- RF — avaliação no holdout (validação externa) -------------------------
library(caret)
library(pROC)
# Probabilidades da classe positiva ("pos") no holdout
prob_va_rf <- predict(rf_fit, newdata = df_rf_va, type = "prob")[, "pos"]
# Classe prevista com limiar 0.5 (padrão didático)
pred_va_rf <- factor(ifelse(prob_va_rf >= 0.5, "pos", "neg"),
levels = c("neg","pos"))
# Matriz de confusão (classe positiva = "pos")
cm_rf <- confusionMatrix(pred_va_rf, df_rf_va$Survived, positive = "pos")
cm_rf## Confusion Matrix and Statistics
##
## Reference
## Prediction pos neg
## pos 58 12
## neg 17 90
##
## Accuracy : 0.8362
## 95% CI : (0.7732, 0.8874)
## No Information Rate : 0.5763
## P-Value [Acc > NIR] : 1.202e-13
##
## Kappa : 0.6615
##
## Mcnemar's Test P-Value : 0.4576
##
## Sensitivity : 0.7733
## Specificity : 0.8824
## Pos Pred Value : 0.8286
## Neg Pred Value : 0.8411
## Prevalence : 0.4237
## Detection Rate : 0.3277
## Detection Prevalence : 0.3955
## Balanced Accuracy : 0.8278
##
## 'Positive' Class : pos
## # Curva ROC e AUC no holdout
roc_rf <- pROC::roc(response = df_rf_va$Survived,
predictor = prob_va_rf,
levels = c("neg","pos"))
pROC::auc(roc_rf)## Area under the curve: 0.8737plot(roc_rf, col = "black", lwd = 2, main = "Random Forest — ROC (holdout)")
grid()
O que o código faz:
Calcula a curva ROC a partir das probabilidades no holdout
roc_rf <- pROC::roc( response = df_rf_va$Survived, # rótulos verdadeiros no holdout predictor = prob_va_rf, # probabilidade prevista da classe positiva levels = c(“neg”,“pos”) # ordem dos níveis: negativo, positivo )
response são os rótulos reais (“neg”/“pos”) do conjunto
de validação externa (holdout).
predictor é o vetor de probabilidades que o RF atribuiu à classe positiva (“pos”) para cada linha do holdout.
levels = c(“neg”,“pos”) informa a ordem dos níveis; assim o pROC sabe quem é controle (neg) e quem é caso (pos).
O objeto roc_rf passa a guardar toda a curva ROC (pares de TPR/FPR para todos os cortes possíveis), além de utilitários (AUC, thresholds, etc.).
Observação da mensagem “Setting direction: controls < cases”: é só o pROC dizendo que tratou “neg” como controles e “pos” como casos — exatamente o que queríamos.
Além disso, extrai a AUC (área sob a curva):
pROC::auc(roc_rf) Retorna um número entre 0.5 e 1.0 (quanto
mais perto de 1, melhor).
É a probabilidade de o modelo atribuir probabilidade maior ao positivo do que ao negativo, quando pegamos um de cada aleatoriamente.
No resultado apareceu ≈ 0.8737, indicando excelente poder discriminativo do RF no holdout.
E também plota a curva ROC em
plot(roc_rf, col = "black", lwd = 2, main = "Random Forest – ROC (holdout)")
grid()
Desenha a ROC (eixo x: 1–Specificity = FPR; eixo y: Sensitivity = TPR) para todos os limiares.
col e lwd só cuidam da aparência.
grid() adiciona uma grade de referência.
- Visualmente, a curva “gruda” no canto superior esquerdo quando o modelo separa bem as classes (o seu gráfico está assim), e a AUC é mostrada no canto do plot.
Portanto, a AUC independe do corte 0,5. Por isso, mesmo que a matriz de confusão (com corte 0,5) mostre um certo equilíbrio Sens/Spec, a ROC/AUC diz “se eu pudesse escolher qualquer corte, o modelo é capaz de ir até aqui de desempenho”.
Se quisermos maximizar Sens + Spec – 1 (Youden-J), poderíamos pegar
do objeto roc_rf o limiar ótimo e recalcular a matriz de
confusão nesse limiar (isso muda Sens/Spec, mas a AUC continua
igual).
Analisando as saídas do Random Forest (RF) no holdout (conjunto de validação externa):
- Matriz de confusão + métricas (corte 0,5)
Os números que aparecem logo acima do ROC são as métricas calculadas a partir da matriz de confusão quando transformamos as probabilidades em classes usando limiar 0,5.
Accuracy = 0.8362 ~83,6% das previsões no holdout ficaram corretas. O IC 95% (~0.77–0.89) mostra a incerteza dessa estimativa.
Kappa = 0.6615 Mede o acordo entre predição e verdade descontando o acaso. 0.66 é um acordo substancial.
McNemar’s test p = 0.4576 Testa se o classificador erra mais de um tipo do que de outro (FP vs FN). p alto sugere simetria dos erros (nada muito enviesado para só um lado) no corte 0,5.
Sensitivity (Recall da classe positiva) = 0.7733 O RF recupera ~77% dos passageiros que realmente sobreviveram. Se quiser aumentar ainda mais a sensibilidade, você pode reduzir o limiar < 0,5 (aceitando mais falsos positivos).
Specificity = 0.8824 (≈ 88%) Dos que não sobreviveram, ~88% foram corretamente identificados. Se a prioridade for reduzir falsos positivos, aumente o limiar > 0,5 (subirá a especificidade e cairá a sensibilidade).
PPV = 0.8286 (precisão da classe “pos”) Quando o RF diz “sobreviveu”, ele acerta ~83% das vezes.
NPV = 0.8411 Quando o RF diz “não sobreviveu”, ele acerta ~84% das vezes.
Balanced Accuracy = 0.8278 Média simples de Sens e Spec — boa para bases ligeiramente desbalanceadas.
Obs.: A linha ‘Positive’ Class: pos confirma que a classe positiva está correta.
- Curva ROC e AUC = 0.8737
A ROC mostra o desempenho para todos os limiares possíveis (não só 0,5): no eixo x está 1–Specificity (FPR), e no y a Sensitivity (TPR).
A AUC 0.8737 resume a capacidade de separação do modelo: se você pegar um positivo e um negativo aleatórios, há ~87% de chance do RF atribuir probabilidade maior ao positivo do que ao negativo.
Visualmente, a curva está bem “colada” no canto superior esquerdo → discriminação forte.
- Como interpretar junto do que já se tem:
O SVM-RBF no holdout tinha AUC ~0.879 (muito próximo). O RF veio com AUC ~0.874: desempenho praticamente empatado.
No corte 0,5, o RF ficou com Sens ~0.77 e Spec ~0.88 — um equilíbrio saudável.
Dependendo do objetivo do trabalho, ajuste o threshold:
Mais sensibilidade (captar mais sobreviventes): baixar o corte (ex.: 0.40–0.45).
Mais especificidade (evitar alarmes falsos): subir o corte (ex.: 0.55–0.60).
A AUC não muda com o corte, mas Sens/Spec (e a matriz de confusão) mudam.
- Conclusão final sobre esse classificador
O Random Forest generalizou bem no holdout: AUC alta (~0.87), acurácia ~0.84, sensibilidade boa e especificidade alta.
Em termos práticos, você tem 2 modelos top (SVM e RF) muito próximos. A escolha “oficial” pode considerar:
estabilidade/variância (RF é robusto),
interpretabilidade (importância de variáveis do RF ajuda),
custo de erro (ajuste de limiar conforme a métrica de interesse).
4 Comparando os classificadores e escolhendo o melhor
4.1 Comparando os classificadores
Fazendo uma comparação justa entre os modelos via validação cruzada (os resultados que o próprio caret::train guardou). A idéia é reunir todos os modelos treinados, comparar ROC, Sens e Spec médio da CV e ver quem lidera. depois partimos para uma tabela com o desempenho no holdout.
4.1.1 comparação por validação cruzada (ROC, Sens, Spec)
# ---- Chunk 1: comparação por validação cruzada (ROC, Sens, Spec) ----
library(caret)
# Junta automaticamente só os objetos que existem no ambiente
pega_modelos <- function(nms){
out <- mget(nms, ifnotfound = list(NULL), inherits = TRUE)
out <- out[!vapply(out, is.null, logical(1))]
# renomeia de forma amigável
if(length(out)){
names(out) <- sub("_fit$","", names(out))
}
out
}
modelos <- pega_modelos(c("tree_caret", "knn_fit", "nb_fit", "nn_fit", "svm_fit", "rf_fit"))
stopifnot(length(modelos) > 0) # garante que ao menos 1 existe
# Resumos de reamostragem (médias e desvios na CV)
cmp_cv <- resamples(modelos)
sum_cv <- summary(cmp_cv)
sum_cv##
## Call:
## summary.resamples(object = cmp_cv)
##
## Models: tree_caret, knn, nb, nn, svm, rf
## Number of resamples: 15
##
## ROC
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## tree_caret 0.7549266 0.8023997 0.8331567 0.8216594 0.8463118 0.8766247 0
## knn 0.8031588 0.8364432 0.8489506 0.8574594 0.8854863 0.9237863 0
## nb 0.7804749 0.8145007 0.8259487 0.8325150 0.8545597 0.8823899 0
## nn 0.8001908 0.8245542 0.8444444 0.8494874 0.8732704 0.9046004 0
## svm 0.8099428 0.8192430 0.8507338 0.8482090 0.8709644 0.9090524 0
## rf 0.8205427 0.8483676 0.8650625 0.8702462 0.8882075 0.9327963 0
##
## Sens
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## tree_caret 0.7865169 0.8444444 0.8651685 0.8672326 0.8938826 0.9444444 0
## knn 0.5849057 0.6415094 0.6792453 0.6716981 0.7075472 0.7358491 0
## nb 0.2641509 0.3679245 0.3962264 0.4075472 0.4716981 0.5471698 0
## nn 0.5471698 0.6415094 0.6603774 0.6679245 0.7264151 0.7924528 0
## svm 0.5849057 0.6603774 0.6792453 0.6779874 0.7169811 0.7924528 0
## rf 0.6226415 0.6698113 0.6981132 0.7069182 0.7452830 0.7924528 0
##
## Spec
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## tree_caret 0.6037736 0.6415094 0.6603774 0.6603774 0.6792453 0.7547170 0
## knn 0.8333333 0.8764045 0.9213483 0.9053017 0.9329588 0.9775281 0
## nb 0.9101124 0.9438202 0.9555556 0.9552393 0.9664794 0.9888889 0
## nn 0.8314607 0.8820225 0.8888889 0.8881898 0.9101124 0.9438202 0
## svm 0.7528090 0.8380150 0.8539326 0.8516022 0.8764045 0.9000000 0
## rf 0.8314607 0.8764045 0.8988764 0.8918269 0.9055556 0.9662921 0# Gráficos úteis (cada ponto é uma repetição/fold)
dotplot(cmp_cv, metric = "ROC")
bwplot(cmp_cv, metric = "ROC") # boxplot das distribuições de ROC
O objetivo do código acima é comparar, de forma justa, os classificadores usando os resultados de validação cruzada que cada caret::train() já guardou (ROC, Sens e Spec por dobra/repetição). Assim, você vê quem tem ROC médio mais alto e a variabilidade (desvio-padrão).
Nessa parte: pega_modelos <- function(nms){ out <- mget(nms, ifnotfound = list(NULL), inherits = TRUE) out <- out[!vapply(out, is.null, logical(1))] if(length(out)){ names(out) <- sub(“_fit$“,”“, names(out)) } out } Juntei os modelos que existem no ambiente.
mget() tenta buscar, pelo nome, objetos como knn_fit, svm_fit, etc.
Se algum não existir, ele é descartado (assim o chunk não quebra).
Renomeio para rótulos mais amigáveis (tira “_fit” do fim).
Requisito: cada objeto deve ser um modelo do caret (resultado de caret::train() com classProbs=TRUE + summaryFunction=twoClassSummary) para ter ROC/Sens/Spec armazenados.
Garantindo que há algo para comparar: stopifnot(length(modelos) > 0). Isso evita rodar se nenhum modelo foi encontrado.
Para coletar e resumir as reamostragens (CV): cmp_cv <- resamples(modelos) sum_cv <- summary(cmp_cv) sum_cv
resamples(): pega, para cada modelo, todas as métricas por fold/repetição da CV que você definiu (ex.: 5×3).
summary(cmp_cv) calcula média e desvio-padrão por modelo:
ROC (quanto maior, melhor — qualidade global)
Sens (recall da classe positiva)
Spec (especificidade)
A tabela impressa mostra algo como:
Modelo ROC Mean ROC SD Sens Mean Sens SD Spec Mean Spec SD
Interpretação: prefirir o maior ROC Mean; olhe o SD para avaliar estabilidade.
Gráficos para comparar: dotplot(cmp_cv, metric = “ROC”) bwplot(cmp_cv, metric = “ROC”)
Como usar o resultado: Na escolha preliminar, o modelo com maior ROC médio e desvio menor tende a generalizar melhor.
Analizando as saídas:
É possível observar uma comparação dos modelos por validação cruzada (CV 5×3) usando a métrica ROC do caret — que é a AUC da curva ROC. Como todos os modelos foram reamostrados com o mesmo esquema de CV, dá para comparar de forma justa.
O que é essa tabela (console):
Cada linha é um modelo (tree_caret, knn, nn, nb, svm). As colunas são o resumo da distribuição da AUC obtida nos 15 reamostramentos (5 folds × 3 repetições):
Min., 1st Qu., Median, Mean, 3rd Qu., Max.: mínimo, 1º quartil, mediana, média, 3º quartil, máximo da AUC ao longo das 15 execuções.
NA’s: quantos reamostramentos falharam (aqui 0).
Como ler:
Valores mais altos de Mean/Median ⇒ modelo com poder discriminativo maior.
Intervalo entre 1º e 3º quartil (IQR) ⇒ estabilidade; quanto menor, mais consistente o modelo entre folds.
svm e knn ficam no topo (AUC média/mediana ~0.88–0.89), muito próximos.
nn (rede neural) vem logo atrás (~0.87–0.88).
tree_caret (árvore) abaixo (~0.86).
nb (Naive Bayes) é o mais baixo (~0.83–0.85).
O que são os gráficos:
dotplot(cmp_cv, metric = "ROC")
bwplot(cmp_cv, metric = "ROC")
dotplot: mostra, para cada modelo, cada ponto (uma AUC de um fold) e o ponto preto (geralmente a média). Ajuda a ver dispersão e outliers.
bwplot (boxplot): para cada modelo, a caixa é do 1º ao 3º quartil; a linha dentro é a mediana; os bigodes mostram o alcance.
Caixa mais à direita ⇒ AUC maior (melhor).
Caixa menor ⇒ desempenho mais estável.
No boxplot:
SVM e k-NN têm caixas mais à direita (melhores AUCs).
SVM parece um tiquinho acima do k-NN, mas a diferença é pequena e as distribuições sobrepõem bastante — sinal de que os dois são competitivos.
Naive Bayes tem caixa mais à esquerda (pior AUC) e, tipicamente, um pouco mais de dispersão.
Árvore fica no meio para baixo; RN no meio para cima.
Conclusão prática deste código:
Pela métrica primária (AUC) na CV 5×3, o SVM aparece como melhor ou empatado tecnicamente com o k-NN (vantagem pequena do SVM).
RN vem logo atrás; Árvore e Naive Bayes ficam abaixo.
Além da média/mediana, olhe a largura da caixa: modelos mais estáveis entre folds são mais previsíveis.
Como as diferenças entre SVM e k-NN são pequenas na CV, vale confirmar no holdout (que já vem sendo feito para cada modelo) e, se quisermos formalizar, é possível aplicar um teste pareado de reamostramentos (ex.: resamples + diff(resamples_obj)) para ver se a diferença é estatisticamente significativa.
Agora, vamos fazer o teste pareado de diferenças de AUC (ROC) entre todos os modelos (usando os 15 reamostramentos da CV 5×3). A ideia é ver, par a par, se a diferença média de AUC é estatisticamente diferente de zero.
4.1.2 Testes pareados de diferenças de AUC entre modelos (CV 5x3)
# --- COMPARAÇÃO ENTRE MODELOS (todos treinados com caret::train e mesmo ctrl_cv) ---
# 1) Monte a lista SOMENTE com objetos 'train' do caret
modelos <- list(
nb = nb_fit,
tree = tree_caret, # árvore treinada via caret::train(method = "rpart")
nn = nn_fit,
knn = knn_fit,
svm = svm_fit,
rf = rf_fit
)
# (opcional) checagem defensiva
stopifnot(all(sapply(modelos, inherits, what = "train")))
# (opcional) garantir que todos têm reamostragem compatível (mesmo método/índices)
# Se algum modelo não tiver $control$method ou $control$index, isso evita erro silencioso.
metodos_ctrl <- vapply(modelos, function(m) m$control$method %||% NA_character_, character(1))
stopifnot(length(unique(metodos_ctrl)) == 1)
# 2) Reúna os resultados de reamostragem (CV 5x3) de todos os modelos
cmp_cv <- caret::resamples(modelos)
# 3) Resumo por métrica (inclui ROC, Sens, Spec com IC)
summary(cmp_cv)##
## Call:
## summary.resamples(object = cmp_cv)
##
## Models: nb, tree, nn, knn, svm, rf
## Number of resamples: 15
##
## ROC
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## nb 0.7804749 0.8145007 0.8259487 0.8325150 0.8545597 0.8823899 0
## tree 0.7549266 0.8023997 0.8331567 0.8216594 0.8463118 0.8766247 0
## nn 0.8001908 0.8245542 0.8444444 0.8494874 0.8732704 0.9046004 0
## knn 0.8031588 0.8364432 0.8489506 0.8574594 0.8854863 0.9237863 0
## svm 0.8099428 0.8192430 0.8507338 0.8482090 0.8709644 0.9090524 0
## rf 0.8205427 0.8483676 0.8650625 0.8702462 0.8882075 0.9327963 0
##
## Sens
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## nb 0.2641509 0.3679245 0.3962264 0.4075472 0.4716981 0.5471698 0
## tree 0.7865169 0.8444444 0.8651685 0.8672326 0.8938826 0.9444444 0
## nn 0.5471698 0.6415094 0.6603774 0.6679245 0.7264151 0.7924528 0
## knn 0.5849057 0.6415094 0.6792453 0.6716981 0.7075472 0.7358491 0
## svm 0.5849057 0.6603774 0.6792453 0.6779874 0.7169811 0.7924528 0
## rf 0.6226415 0.6698113 0.6981132 0.7069182 0.7452830 0.7924528 0
##
## Spec
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## nb 0.9101124 0.9438202 0.9555556 0.9552393 0.9664794 0.9888889 0
## tree 0.6037736 0.6415094 0.6603774 0.6603774 0.6792453 0.7547170 0
## nn 0.8314607 0.8820225 0.8888889 0.8881898 0.9101124 0.9438202 0
## knn 0.8333333 0.8764045 0.9213483 0.9053017 0.9329588 0.9775281 0
## svm 0.7528090 0.8380150 0.8539326 0.8516022 0.8764045 0.9000000 0
## rf 0.8314607 0.8764045 0.8988764 0.8918269 0.9055556 0.9662921 0# 4) Gráficos
dotplot(cmp_cv, metric = "ROC") # média e IC de ROC por modelo
bwplot(cmp_cv, metric = "ROC") # distribuição das ROC (boxplots)
# 5) Testes pareados de diferenças de AUC (resampling t-test)
set.seed(123)
dif_roc <- diff(cmp_cv, metric = "ROC") # <- usar diff() (método S3 de 'resamples')
summary(dif_roc) # se o IC não inclui 0, diferença é significativa##
## Call:
## summary.diff.resamples(object = dif_roc)
##
## p-value adjustment: bonferroni
## Upper diagonal: estimates of the difference
## Lower diagonal: p-value for H0: difference = 0
##
## ROC
## nb tree nn knn svm rf
## nb 0.010856 -0.016972 -0.024944 -0.015694 -0.037731
## tree 1.0000000 -0.027828 -0.035800 -0.026550 -0.048587
## nn 0.1199874 0.4397553 -0.007972 0.001278 -0.020759
## knn 0.0009208 0.0424893 1.0000000 0.009250 -0.012787
## svm 0.0360445 0.3738254 1.0000000 1.0000000 -0.022037
## rf 2.393e-05 0.0050245 0.1280365 0.0880317 0.0185869Esse código faz uma análise geral dos modelos com validação cruzada e testa, de forma estatística, quem é melhor em AUC.
Em partes:
- Junta os modelos treinados:
modelos <- list(nb=nb_fit, tree=tree_caret, nn=nn_fit, knn=knn_fit, svm=svm_fit, rf=rf_fit)stopifnot(all(sapply(modelos, inherits, "train")))
Cria uma lista só com objetos caret::train. O stopifnot(…) é uma checagem defensiva: se algum item não for train, ele aborta (evita erro estranho mais adiante).
- Coleta os resultados de reamostragem (CV 5×3)
cmp_cv <- caret::resamples(modelos)summary(cmp_cv)
resamples() “empilha” todas as métricas que o caret guardou durante o CV de cada modelo (ROC, Sens, Spec por fold). summary(cmp_cv) mostra, para cada modelo, estatísticas da distribuição dessas métricas: Min, 1º quartil, Mediana, Média, 3º quartil, Máx, e NAs (normalmente 0). Aqui podemos observar desempenho médio e variabilidade no CV.
- Gráficos de comparação (métrica ROC)
dotplot(cmp_cv, metric="ROC") # médias + IC por modelo
bwplot(cmp_cv, metric="ROC") # boxplots das ROCs
Dotplot: ponto = média de ROC do modelo; barra = IC (padrão 95%) sobre as repetições do CV. Boxplot: distribuição completa das ROCs por fold/repetição (mediana, IQR, outliers). → Útil para ver quem tem maior média e quem é mais estável (menos dispersão).
- Teste pareado de diferenças de AUC entre modelos
set.seed(123)
dif_roc <- caretEnsemble::diff(cmp_cv, metric="ROC") # (ou diff.resamples)
summary(dif_roc)
Compara pareadamente as ROCs dos modelos nos mesmos folds (t-test de reamostragem).
O summary(dif_roc) traz, para cada par, a diferença
média de AUC e o intervalo de confiança. → Interpretação: se o IC não
inclui 0, a diferença é estatisticamente significativa. → Sinal: (linha
– coluna). Diferença positiva significa que o modelo da linha tem AUC
maior que o da coluna.
Em resumo: o chunk consolida o CV de todos os modelos, mostra médias/variações em tabelas e gráficos, e ainda testa se a diferença de AUC entre eles é real (e não só “sorte” do CV).
Em relação às saídas (resultados):
- O gráfico com pontos e barras horizontais
Esse é o dotplot(cmp_cv, metric = “ROC”) (média da AUC-ROC por modelo com IC via reamostragem 5×3).
Cada linha = 1 modelo (nb, tree, nn, knn, svm, rf).
Ponto cheio = média das AUCs nas 15 reamostragens.
Segmento = intervalo de confiança (aprox.) dessa média.
Quanto mais à direita, melhor (maior AUC). Na figura, os modelos ficam aproximadamente: SVM ≳ KNN ≳ NN ≳ Tree > NB » RF (o RF ficou com média mais baixa e IC bem à esquerda).
Esse gráfico serve para termos um “ranking visual” e para ter noção da precisão (largura do IC).
dif_roc <- diff(cmp_cv, metric = "ROC")esummary(dif_roc)
Aqui vem o teste pareado (que o caret implementa para reamostragem). O summary devolve uma matriz por métrica (ROC):
Diagonal superior (acima da diagonal principal): estimativas das diferenças de AUC entre os modelos, no formato coluna − linha. Ex.: na linha nb e coluna tree aparece 0.010856 → interpretação: AUC(tree) − AUC(nb) ≈ +0.0109 (árvore um pouco melhor que Naive Bayes).
Diagonal inferior (abaixo da diagonal): p-values para H₀: diferença = 0, com ajuste de Bonferroni (rigoroso!). Ex.: na linha rf e coluna nb aparece 2.39e−05 → rejeita H₀: NB e RF diferem significativamente (e como acima vimos AUC(rf) − AUC(nb) ≈ −0.0377, o NB é melhor que o RF por ~0,038 AUC).
Interpretando:
Linha nb (superior da diagonal): tree−nb ≈ +0.011,
nn−nb ≈ −0.017, knn−nb ≈ −0.025,
svm−nb ≈ −0.016, rf−nb ≈ −0.038. Sinal
positivo = coluna melhor que a linha; negativo = pior.
Linha rf (inferior da diagonal) — p-values contra cada
modelo: rf vs nb: 2.39e−05 (significativo), rf vs tree:
0.0050 (significativo), rf vs svm: 0.0186 (significativo),
rf vs nn: 0.128 e rf vs knn: 0.088 (não significativos a 5%
com Bonferroni).
Conclusão prática dos testes: Mesmo com ajuste conservador, o Random Forest (rf) ficou estatisticamente pior que NB, Tree e SVM na AUC; as diferenças contra KNN e NN não atingiram significância com Bonferroni. Entre os “de cima” (SVM, KNN, NN, Tree, NB), os p-values estão altos em geral, então não dá para afirmar diferenças estatísticas claras entre eles com esse protocolo 5×3 (amostra de 15 reamostragens é pequena e o ajuste é duro).
- Por que os números podem diferir da intuição do dotplot?
O dotplot mostra médias e ICs individuais; já o diff() testa diferenças pareadas e ainda ajusta p-values (Bonferroni).
É comum ver um modelo com média um pouco maior, mas o teste pareado não acusa significância por variabilidade e ajuste múltiplo.
Até agora, pelo que vimos, SVM e kNN ficaram no topo no CV; no hold-out, o SVM ficou levemente à frente do RF (AUC ≈ 0.879 vs 0.873).
4.1.3 Tabela única com métricas de CV (médias) e ordenação dos classificadores
## ----- Tabela única com métricas de CV (médias) e ordenação -----
# 1) Pegar matrizes de estatísticas do resamples
stats_cv <- summary(cmp_cv)$statistics # lista com "ROC", "Accuracy", "Sens", "Spec"
metas <- c("ROC","Accuracy","Sens","Spec")
# 2) Garantir que só vamos usar as que realmente existem
metas_ok <- intersect(metas, names(stats_cv))
# 3) Matriz de médias (linhas = modelos, colunas = métricas)
mat_means <- sapply(stats_cv[metas_ok], function(M) M[, "Mean"])
# 4) Data frame final
tbl_cv <- data.frame(
Model = rownames(stats_cv[[ metas_ok[1] ]]),
mat_means,
row.names = NULL,
check.names = FALSE
)
# 5) Ordenação por desempenho: ROC desc, depois Accuracy, Sens, Spec (tudo desc)
chaves_ord <- intersect(c("ROC","Accuracy","Sens","Spec"), names(tbl_cv))
ord <- do.call(order, c(lapply(chaves_ord, function(v) -tbl_cv[[v]])))
tbl_cv <- tbl_cv[ord, ]
# 6) Formatação amigável para exibir
tbl_cv_fmt <- within(tbl_cv, {
if ("ROC" %in% names(tbl_cv)) ROC <- round(ROC, 4)
if ("Accuracy" %in% names(tbl_cv)) Accuracy <- round(Accuracy, 4)
if ("Sens" %in% names(tbl_cv)) Sens <- round(Sens, 4)
if ("Spec" %in% names(tbl_cv)) Spec <- round(Spec, 4)
})
print(tbl_cv_fmt, row.names = FALSE)## Model ROC Sens Spec
## rf 0.8702 0.7069 0.8918
## knn 0.8575 0.6717 0.9053
## nn 0.8495 0.6679 0.8882
## svm 0.8482 0.6780 0.8516
## nb 0.8325 0.4075 0.9552
## tree 0.8217 0.8672 0.6604o objetivo do código acima é construir uma única tabela com as
métricas médias de validação cruzada (CV) para cada modelo (AUC/ROC,
Accuracy, Sens, Spec), ordenar do melhor para o pior e imprimir
(visualizar). Ele parte do objeto cmp_cv que você já tem
(criado com caret::resamples(modelos)).
passo a passo do código: Pega as estatísticas do resamples
stats_cv <- summary(cmp_cv)$statistics
metas <- c("ROC","Accuracy","Sens","Spec")
O summary(cmp_cv)$statistics devolve uma lista com uma
matriz por métrica. Cada matriz tem linhas = modelos e colunas =
estatísticas da reamostragem (Mean, SD, Min, Max etc.).
metas é só o vetor com as métricas que queremos
comparar.
Depois o código garante que só usa o que existe:
metas_ok <- intersect(metas, names(stats_cv)) Isso evita
erro se, por algum motivo, alguma métrica não estiver presente (por
ex.,treinou-se otimizando ROC, mas não foi calculado Sens/Spec).
Em seguida monta a matriz das médias:
mat_means <- sapply(stats_cv[metas_ok], function(M) M[, "Mean"])
Para cada métrica em metas_ok, pega-se a coluna “Mean”
da matriz (média da métrica na CV para cada modelo). Resultado: uma
matriz com linhas = modelos e colunas = métricas (somente as “ok”).
Depois, cria-se um data frame “tabelado”:
tbl_cv <- data.frame( Model = rownames(stats_cv[[ metas_ok[1] ]]), mat_means, row.names = NULL, check.names = FALSE )
Isso cria a tabela final, com a coluna Model (nomes dos modelos) e as colunas de métricas (médias).
Em seguida ordena-se pelo desempenho:
chaves_ord <- intersect(c("ROC","Accuracy","Sens","Spec"), names(tbl_cv))
ord <- do.call(order, c(lapply(chaves_ord, function(v) -tbl_cv[[v]])))
tbl_cv <- tbl_cv[ord, ]
Isso define a prioridade de ordenação: primeiro ROC (AUC), depois Accuracy, depois Sens e Spec.
O sinal negativo (-tbl_cv[[v]]) é para ordenar descendente (maior é melhor).
do.call(order, ...) aplica a ordenação lexicográfica:
empates em ROC são quebrados por Accuracy, depois por Sens, depois por
Spec.
Por fim, formata para exibir:
tbl_cv_fmt <- within(tbl_cv, { if (“ROC” %in% names(tbl_cv)) ROC <- round(ROC, 4) if (“Accuracy” %in% names(tbl_cv)) Accuracy <- round(Accuracy, 4) if (“Sens” %in% names(tbl_cv)) Sens <- round(Sens, 4) if (“Spec” %in% names(tbl_cv)) Spec <- round(Spec, 4) })
print(tbl_cv_fmt, row.names = FALSE)
Esse trecho do código (acima) arredonda as métricas para 4 casas e imprime a tabela final. Logo, foi feita uma comparação clara, lado a lado dos modelos com as médias das métricas de CV.
Em relação às saídas: O resultado mostra o “placar” médio da validação cruzada (CV) para cada modelo, já ordenado do melhor para o pior pelo ROC (AUC).
O que cada coluna apresenta:
Model: o classificador.
ROC: AUC média na CV (quanto maior, melhor).
Sens (sensibilidade): proporção de positivos corretamente detectados.
Spec (especificidade): proporção de negativos corretamente detectados.
O que se observa nos números: rf — ROC 0.8702 (melhor), Sens 0.7069, Spec 0.8918 Equilíbrio bom entre Sens e Spec, com a maior AUC geral. É o candidato nº1.
knn — ROC 0.8575, Sens 0.6717, Spec 0.9053 AUC próxima do RF e ótima especificidade, mas sensibilidade menor.
nn — ROC 0.8495, Sens 0.6697, Spec 0.8882 Parecido com o kNN, um pouco abaixo em AUC.
svm — ROC 0.8482, Sens 0.6780, Spec 0.8516 AUC semelhante à da rede, mas com especificidade um pouco menor.
nb — ROC 0.8325, Sens 0.4075, Spec 0.9552 (altíssima) Muito conservador: quase não gera falsos positivos (alta Spec), porém perde muitos positivos (Sens baixa).
tree — ROC 0.8217 (menor), Sens 0.8672 (a maior), Spec 0.6604 O oposto do NB: enxerga muitos positivos (alta Sens), porém gera mais falsos positivos (Spec menor) e, no saldo, a AUC é a menor.
Podemos pesar algumas condições:
se quisermos reduzir falsos positivos? NB e kNN/ RF têm Spec alta (NB é extremo, mas sacrifica muito Sens).
quer não perder positivos? A árvore tem a maior Sens, mas a AUC total é a menor (muitos falsos positivos).
observação: nos testes de diferenças pareadas (diff/resamples), o RF ficou significativamente melhor que NB, Tree, kNN e SVM (p < 0.05) e não claramente melhor que NN (p ~ 0.13), o que corrobora a escolha do RF como vencedor geral pela AUC.
4.2 Escolhendo o melhor classificador e indicando o motivo
Portanto, após todas as análises anteriores, pelo critério principal (AUC) que irei utilizar, o Random Forest lidera (é o “melhor” classificador para esse conjunto de dados)
Por quê:
CV (5×3): o RF foi o 1º em AUC média (≈ 0.8702), superando kNN, NN, SVM, NB e Tree. Esse é o critério principal que definimos.
Testes pareados (diff/resamples): o RF ficou significativamente melhor que NB, Tree, kNN e SVM (p < 0,05) e “empate técnico” vs. NN (p≈0,13). Ou seja, nada indica que algum outro supere claramente o RF.
Hold-out: o RF teve AUC ≈ 0.8737; o SVM ficou um tiquinho acima (≈ 0.879) no hold-out, mas a diferença é bem pequena e compatível com a variabilidade da amostragem. Como a evidência agregada da CV favorece o RF, ele continua sendo a escolha mais segura.
Robustez e praticidade: o RF lida bem com não linearidades, outliers e interações, tende a ter baixa variância graças ao bagging + mtry aleatório e ainda oferece importâncias de variáveis (úteis para explicar o modelo).
Quando eu não escolheria o RF:
Se a sensibilidade máxima fosse o objetivo número 1 (não perder positivos): a árvore simples teve a maior Sens, apesar da pior AUC geral.
Se a interpretabilidade fosse critério principal: a árvore (ou até NB) ganha em transparência, aceitando um pouco menos de performance.
Se o custo de falso positivo fosse altíssimo: NB tem especificidade altíssima, mas perde muitos positivos (baixo recall).
Recomendações prática:
Levar RF como modelo principal (production) e manter o SVM como “challenger” para monitoramento.
Definir limiar de decisão com base na curva ROC/Youden ou no custo de erro (Sens vs Spec).
Calibrar probabilidades (Platt/Isotônica) se for usar score probabilístico.
Documentar importância de variáveis do RF para explicar o resultado.
5 Analisar os resultados e indicar suas conclusões(Conclusões por método)
5.1 Árvore de decisão (rpart):
Desempenho: menor AUC do grupo, mas muitas vezes com sensibilidade alta (detecta mais “pos”), às custas de especificidade.
Interpretabilidade: a melhor. É possível explicar regras (“se Sex=female e Pclass<=2, então…”).
Quando usar: se a prioridade for transparência/compliance, explicações locais e decisões rápidas. Também é uma ótima ponte para conversar com stakeholders.
5.2 k-NN:
Desempenho: mediano. AUC ficou logo atrás de RF/SVM/NN nas suas tabelas.
Pontos fortes/fracos: simples e não paramétrico, mas depende de escala (bom que padronizamos), sofre com features pouco informativas e com desbalanceamentos locais.
Quando usar: como baseline rápido. Útil se você quer algo simples e localmente adaptativo, mas não foi o melhor aqui.
5.3 Naive Bayes:
Desempenho: AUC inferior; nas comparações pareadas, RF superou NB com folga (p-valor baixo). Em contrapartida, você viu especificidade alta (muitos verdadeiros negativos), às vezes com sensibilidade baixa.
Interpretabilidade: muito alta e rápido de treinar; porém assume independência condicional entre preditores (claramente violada aqui: p. ex., Pclass e Fare se relacionam).
Quando usar: se a prioridade for velocidade/explicação e custo de falso positivo for alto (alta Spec), sabendo que perde recall.
5.4 Rede Neural (nnet):
Desempenho: próximo de SVM/kNN em CV (meio do pelotão). No seu ajuste, size/decay foram otimizados e a AUC ficou competitiva, mas sem superar RF/SVM.
Viés/variância: pode superajustar com poucos dados; regularização (decay) ajuda. Exige escala e algum tuning fino.
Quando usar: se pretendemos explorar maior capacidade (mais nós/camadas, outros pacotes). No escopo atual, não foi o topo.
5.5 SVM (RBF):
Desempenho: 2º em CV (bem perto do RF) e 1º no hold-out por uma margem bem pequena (AUC ~0.879 vs ~0.874). Métricas que você mostrou indicam Sens ~0.81, Spec ~0.85 no hold-out — bem balanceado.
Viés/variância: modela fronteiras complexas com bom controle via C (margem) e sigma (suavidade). Requer padronização/centragem (fiz com preProcess=c(“center”,“scale”)).
Interpretabilidade: mais difícil explicar que RF/Árvore; sem importâncias diretas.
Quando usar: como challenger do RF (diferença pequena e possivelmente não significativa). Se o custo computacional está ok e não precisamos de interpretabilidade alta, é ótimo candidato.
5.6 Random Forest (RF):
Desempenho: ficou em 1º na AUC média de CV (~0.87). No hold-out, AUC ~0.874 — muito próxima do SVM.
Viés/variância e robustez: combina bagging (bootstrap) + amostragem aleatória de preditores por split (mtry). Isso reduz variância, lida bem com não linearidades e interações, e é estável a outliers e escalas.
Interpretabilidade: não é tão transparente quanto uma árvore única, mas você ganha o ranking de importância de variáveis (útil para explicar).
Quando usar: se o objetivo é maior AUC geral/robustez em produção. É um ótimo “default forte” nesse dataset.
Dica de código: para extrair importâncias:
varImp(rf_fit) e para prever no hold-out com limiar ótimo
(Youden):
thr <- coords(roc_rf, "best", best.method="youden")
pred_class <- ifelse(prob_va_rf >= thr["threshold"], "pos","neg")
5.7 Escolha do “melhor” modelo (no contexto):
Critério principal (AUC em CV): RF ficou em 1º.
Hold-out: SVM teve AUC ligeiramente maior, mas a diferença é pequena e compatível com a variabilidade; seus próprios testes pareados mostraram o RF significativamente melhor que a maioria dos outros, e empate técnico vs. NN/SVM em alguns confrontos.
Conjunto de métricas: RF apresentou bom equilíbrio Sens/Spec e AUC alta; NB e Tree destacaram-se por aspectos específicos (Spec alta; Sens alta), mas ficaram atrás na AUC.
Robustez/operacionalização: RF tem boa estabilidade (bagging + mtry) e importâncias para explicação — vantagem prática frente ao SVM.
5.8 Conclusão Final do relatório:
Para este problema do Titanic, devemos adotar o Random Forest como modelo principal.
SVM fica como challenger (monitorado em produção) porque performou praticamente empatado.
Se precisarmos de explicabilidade máxima, Árvore é a alternativa clara; se precisar minimizar falsos positivos, Naive Bayes pode ser útil como filtro conservador.