Aplicação dos métodos de Classificação

Machine Learning - Aplicação dos métodos de classificação

Objetivo

Aplicar alguns métodos de classificação a um banco de dados, em um problema de classificação e ver qual é melhor com base na taxa de erro.

Informações sobre o banco de dados e sobre as variáveis

Disponibilidade de informação geral

• O conjunto de dados trata-se de 11 características clínicas utilizadas para a previsão de possíveis eventos relacionados a doenças cardiovasculares.

O conjunto de dados pode ser encontrado em: conjunto de dados

Mais sobre o banco de dados

As doenças cardiovasculares (DCVs) são a causa número 1 de morte no mundo, levando cerca de 17,9 milhões de vidas a cada ano, o que representa 31% de todas as mortes em todo o mundo. Quatro em cada 5 mortes por DCV são devidas a ataques cardíacos e derrames, e um terço dessas mortes ocorre prematuramente em pessoas com menos de 70 anos de idade. A insuficiência cardíaca é um evento comum causado por DCVs e este conjunto de dados contém 11 recursos que podem ser usados para prever uma possível doença cardíaca.

Pessoas com doenças cardiovasculares ou com alto risco cardiovascular (devido à presença de um ou mais fatores de risco, como hipertensão, diabetes, hiperlipidemia ou doença já estabelecida) precisam de detecção e gerenciamento precoces, em que um modelo de aprendizado de máquina pode ser de grande ajuda.

Sobre as variáveis dependentes:

Idade: idade do paciente em anos

Sexo: sexo do paciente [M: Masculino, F: Feminino]

ChestPainType: tipo de dor no peito [TA: Angina Típica, ATA: Angina Atípica, NAP: Dor Não Anginosa, ASY: Assintomática]

RestingBP: pressão arterial em repouso [mm Hg]

Colesterol: colesterol sérico [mm/dl]

JejumBS: açúcar no sangue em jejum [1: se JejumBS > 120 mg/dl, 0: caso contrário]

ECG em repouso: resultados do eletrocardiograma em repouso [Normal: Normal, ST: com anormalidade da onda ST-T (inversões da onda T e/ou elevação ou depressão do ST > 0,05 mV), HVE: mostrando hipertrofia ventricular esquerda provável ou definitiva pelos critérios de Estes]

MaxHR: frequência cardíaca máxima alcançada [Valor numérico entre 60 e 202]

ExerciseAngina: angina induzida por exercício [S: Sim, N: Não]

Oldpeak: oldpeak = ST [Valor numérico medido na depressão]

ST_Slope: a inclinação do segmento ST do exercício de pico [Up: ascendente, Flat: plano, Down: descendente]

Sobre a variável resposta:

HeartDisease: classe de saída [1: doença cardíaca, 0: normal]

Exclusão de variáveis

Como os métodos aprendidos estavam utilizando apenas variáveis númericas, vamos excluir as variáveis categóricas para realizar o ajuste dos modelos apenas com as variáveis númericas, a frente quando vermos receita vamos utilizar, pois, podemos transformar essas variáveis categóricas em dummy.

• Carregando o banco de dados

Código

setwd("\\Users\\paulo\\OneDrive\\Área de Trabalho\\ESTATÍSTICA\\UFPB\\8º PERÍODO\\ANÁLISE MULTIVARIADA II\\PROVA")
banco <- read.csv2("heart.csv", header = T, sep = ",")
attach(banco)

• Carregando as bibliotecas

Código

library(dplyr)
library(plotly)
library(skimr)
library(stringr)
library(MASS)
library(class)
library(tidymodels)
library(tidyverse)

Análise Exploratória dos Dados

Código

glimpse(banco)

Rows: 918
Columns: 12
$ Age            <int> 40, 49, 37, 48, 54, 39, 45, 54, 37, 48, 37, 58, 39, 49,…
$ Sex            <chr> "M", "F", "M", "F", "M", "M", "F", "M", "M", "F", "F", …
$ ChestPainType  <chr> "ATA", "NAP", "ATA", "ASY", "NAP", "NAP", "ATA", "ATA",…
$ RestingBP      <int> 140, 160, 130, 138, 150, 120, 130, 110, 140, 120, 130, …
$ Cholesterol    <int> 289, 180, 283, 214, 195, 339, 237, 208, 207, 284, 211, …
$ FastingBS      <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ RestingECG     <chr> "Normal", "Normal", "ST", "Normal", "Normal", "Normal",…
$ MaxHR          <int> 172, 156, 98, 108, 122, 170, 170, 142, 130, 120, 142, 9…
$ ExerciseAngina <chr> "N", "N", "N", "Y", "N", "N", "N", "N", "Y", "N", "N", …
$ Oldpeak        <chr> "0", "1", "0", "1.5", "0", "0", "0", "0", "1.5", "0", "…
$ ST_Slope       <chr> "Up", "Flat", "Up", "Flat", "Up", "Up", "Up", "Up", "Fl…
$ HeartDisease   <int> 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1…

• Como foi dito anteriormente, vamos ficar apenas com as variáveis que são númericas.

Código

banco <- banco %>% 
  dplyr::select(Age,RestingBP,Cholesterol,MaxHR,Oldpeak,HeartDisease)

banco$Oldpeak <- as.numeric(banco$Oldpeak)
banco$HeartDisease <- factor(banco$HeartDisease, levels = c(0,1), labels = c("Normal", "Doença Cardíaca"))

glimpse(banco)

Rows: 918
Columns: 6
$ Age          <int> 40, 49, 37, 48, 54, 39, 45, 54, 37, 48, 37, 58, 39, 49, 4…
$ RestingBP    <int> 140, 160, 130, 138, 150, 120, 130, 110, 140, 120, 130, 13…
$ Cholesterol  <int> 289, 180, 283, 214, 195, 339, 237, 208, 207, 284, 211, 16…
$ MaxHR        <int> 172, 156, 98, 108, 122, 170, 170, 142, 130, 120, 142, 99,…
$ Oldpeak      <dbl> 0.0, 1.0, 0.0, 1.5, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, 0.0, 2.…
$ HeartDisease <fct> Normal, Doença Cardíaca, Normal, Doença Cardíaca, Normal,…

Código

visdat::vis_miss(banco)

• Uma análise Exploratória de maneira mais geral, utilizando a função skim do pacote skimr

Código

skim(banco)

Data summary

Name	banco
Number of rows	918
Number of columns	6
_______________________
Column type frequency:
factor	1
numeric	5
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
HeartDisease	0	1	FALSE	2	Doe: 508, Nor: 410

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Age	0	1	53.51	9.43	28.0	47.00	54.0	60.0	77.0	▁▅▇▆▁
RestingBP	0	1	132.40	18.51	0.0	120.00	130.0	140.0	200.0	▁▁▃▇▁
Cholesterol	0	1	198.80	109.38	0.0	173.25	223.0	267.0	603.0	▃▇▇▁▁
MaxHR	0	1	136.81	25.46	60.0	120.00	138.0	156.0	202.0	▁▃▇▆▂
Oldpeak	0	1	0.89	1.07	-2.6	0.00	0.6	1.5	6.2	▁▇▆▁▁

• Agora, podemos analisar de maneira mais precisa dentro das classes de acordo com algumas medidas (posição e dispersão) de interesse, bem como a visualização gráfica do boxplot dessas variáveis de acordo com o grupo.

Medidas de Posição e Dispersão

As medidas de posição e dispersão que serão utilizadas serão:

• Média

• Mediana

• 1º Quartil

• 3º Quartil

• Mínimo

• Máximo

• Desvio Padrão

• Coeficiente de Variação

Idade

Código

banco %>% 
  group_by(HeartDisease) %>% 
  summarise(media = mean(Age, na.rm = T),
            mediana = median(Age, na.rm = T), 
            quartil_1 = quantile(Age, 0.25, na.rm = T), 
            quartil_3 = quantile(Age, 0.75, na.rm = T), 
            minimo = min(Age, na.rm = T), 
            maximo = max(Age, na.rm = T), 
            desvio = sd(Age, na.rm = T), 
            coeficiente = round(sd(Age, na.rm = T)/mean(Age, na.rm = T)*100,2)) %>% 
  knitr::kable(col.names = c("Grupo", "Média", "Mediana", "1º Quartil", "3º Quartil", "Mínimo", "Máximo", "Desvio Padrão", "Coeficiente de Variação (%)"), caption = "Estatística Descritiva da Idade de acordo com a presença ou ausência de doença cardíaca")

Estatística Descritiva da Idade de acordo com a presença ou ausência de doença cardíaca

Grupo	Média	Mediana	1º Quartil	3º Quartil	Mínimo	Máximo	Desvio Padrão	Coeficiente de Variação (%)
Normal	50.55122	51	43	57	28	76	9.444915	18.68
Doença Cardíaca	55.89961	57	51	62	31	77	8.727056	15.61

Código

plot_ly(banco, x = banco$Age, color = banco$HeartDisease, type = "box") %>% 
  layout(title = "Boxplot da Idade de acordo com a presença ou ausência de doença cardíaca")

Comentário

No boxplot acima, pacientes que apresentaram doenças cardíacas possuem uma variabilidade menor de idade quando comparado com pacientes que não apresentaram. Além disso nota-se a presença de 4 outliers referentes a pacientes que apresentaram doenças cardiovasculares antes dos 35 anos.

Também podemos observar 75% dos pacientes que não apresentaram doenças cardiovasculares são mais novos que a idade mediana dos pacientes que apresentaram doenças cardiovasculares. Isto é, pode-se levantar a hipótese de que a idade talvez tenha uma contribuição significativa para o desenvolvimento de doenças cardíacas.

Frequência Máxima Cardíaca

Código

banco %>% 
  group_by(HeartDisease) %>% 
  summarise(media = mean(MaxHR, na.rm = T),
            mediana = median(MaxHR, na.rm = T), 
            quartil_1 = quantile(MaxHR, 0.25, na.rm = T), 
            quartil_3 = quantile(MaxHR, 0.75, na.rm = T), 
            minimo = min(MaxHR, na.rm = T), 
            maximo = max(MaxHR, na.rm = T), 
            desvio = sd(MaxHR, na.rm = T), 
            coeficiente = round(sd(MaxHR, na.rm = T)/mean(MaxHR, na.rm = T)*100,2)) %>% 
  knitr::kable(col.names = c("Grupo", "Média", "Mediana", "1º Quartil", "3º Quartil", "Mínimo", "Máximo", "Desvio Padrão", "Coeficiente de Variação (%)"), caption = "Estatística Descritiva da Frequência Máxima Cardíaca de acordo com a presença ou ausência de doença cardíaca")

Estatística Descritiva da Frequência Máxima Cardíaca de acordo com a presença ou ausência de doença cardíaca

Grupo	Média	Mediana	1º Quartil	3º Quartil	Mínimo	Máximo	Desvio Padrão	Coeficiente de Variação (%)
Normal	148.1512	150	134	165.00	69	202	23.28807	15.72
Doença Cardíaca	127.6555	126	112	144.25	60	195	23.38692	18.32

Código

plot_ly(banco, x = banco$MaxHR, color = banco$HeartDisease, type = "box") %>% 
  layout(title = "Boxplot da Frequência Máxima Cardíaca de acordo com a presença ou ausência de doença cardíaca")

Comentário

Como o coração de pessoas com doenças cardíacas não estão funcionando de maneira adequada, quando se é necessária uma carga maior de trabalho o coração desse indivíduo não consegue trabalhar de forma tão eficiente quanto o coração de uma pessoa saudável. Por conta disso, 75% dos indíviduos doentes possuem a frequência máxima cardíaca abaixo da mediana da frequência máxima cardíaca do grupo de pessoas saudáveis.

Pressão Arterial em Repouso

Código

banco %>% 
  group_by(HeartDisease) %>% 
  summarise(media = mean(RestingBP, na.rm = T),
            mediana = median(RestingBP, na.rm = T), 
            quartil_1 = quantile(RestingBP, 0.25, na.rm = T), 
            quartil_3 = quantile(RestingBP, 0.75, na.rm = T), 
            minimo = min(RestingBP, na.rm = T), 
            maximo = max(RestingBP, na.rm = T), 
            desvio = sd(RestingBP, na.rm = T), 
            coeficiente = round(sd(RestingBP, na.rm = T)/mean(RestingBP, na.rm = T)*100,2)) %>% 
  knitr::kable(col.names = c("Grupo", "Média", "Mediana", "1º Quartil", "3º Quartil", "Mínimo", "Máximo", "Desvio Padrão", "Coeficiente de Variação (%)"), caption = "Estatística Descritiva da Pressão Arterial em Repouso de acordo com a presença ou ausência de doença cardíaca")

Estatística Descritiva da Pressão Arterial em Repouso de acordo com a presença ou ausência de doença cardíaca

Grupo	Média	Mediana	1º Quartil	3º Quartil	Mínimo	Máximo	Desvio Padrão	Coeficiente de Variação (%)
Normal	130.1805	130	120	140	80	190	16.49958	12.67
Doença Cardíaca	134.1850	132	120	145	0	200	19.82868	14.78

Código

plot_ly(banco, x = banco$RestingBP, color = banco$HeartDisease, type = "box") %>% 
  layout(title = "Boxplot da Pressão Arterial em Repouso de acordo com a presença ou ausência de doença cardíaca")

Comentário

Apesar de ambos os grupos apresentarem dados semelhantes, o grupo que possui doenças cardiovasculares é ligeiramente maior que o grupo de indivíduos saudáveis. Afinal, o coração doente por não apresentar os batimentos tão eficientes quanto um coração saudável, as artérias tendem a compensar esses batimentos cardíacos aumentando sua pressão.

Colesterol Sérico

Código

banco %>% 
  group_by(HeartDisease) %>% 
  summarise(media = mean(Cholesterol, na.rm = T),
            mediana = median(Cholesterol, na.rm = T), 
            quartil_1 = quantile(Cholesterol, 0.25, na.rm = T), 
            quartil_3 = quantile(Cholesterol, 0.75, na.rm = T), 
            minimo = min(Cholesterol, na.rm = T), 
            maximo = max(Cholesterol, na.rm = T), 
            desvio = sd(Cholesterol, na.rm = T), 
            coeficiente = round(sd(Cholesterol, na.rm = T)/mean(Cholesterol, na.rm = T)*100,2)) %>% 
  knitr::kable(col.names = c("Grupo", "Média", "Mediana", "1º Quartil", "3º Quartil", "Mínimo", "Máximo", "Desvio Padrão", "Coeficiente de Variação (%)"), caption = "Estatística Descritiva do Colesterol Sérico de Acordo com a presença ou ausência de doença cardíaca")

Estatística Descritiva do Colesterol Sérico de Acordo com a presença ou ausência de doença cardíaca

Grupo	Média	Mediana	1º Quartil	3º Quartil	Mínimo	Máximo	Desvio Padrão	Coeficiente de Variação (%)
Normal	227.1220	227	197.25	266.75	0	564	74.63466	32.86
Doença Cardíaca	175.9409	217	0.00	267.00	0	603	126.39140	71.84

Código

plot_ly(banco, x = banco$Cholesterol, color = banco$HeartDisease, type = "box") %>% 
  layout(title = "Boxplot do Colesterol Sérico de acordo \ncom a presença ou ausência de doença cardíaca")

Comentário

Devem existir inúmeros fatores que podem implicar uma maior variabilidade do colesterol no grupo de pessoas que possuem doenças cardíacas, uma delas pode estar relacionada com o fato do uso de medicações para diminuir e tentar controlar esse nível do colesterol.

Após a visualização gráfica do boxplot, observamos uma diferença significativa na variação dos dados do colesterol de acordo com a presença ou ausência de doença cardíaca.

Valor númerico medido na depressão

Código

banco %>% 
  group_by(HeartDisease) %>% 
  summarise(media = mean(Oldpeak, na.rm = T),
            mediana = median(Oldpeak, na.rm = T), 
            quartil_1 = quantile(Oldpeak, 0.25, na.rm = T), 
            quartil_3 = quantile(Oldpeak, 0.75, na.rm = T), 
            minimo = min(Oldpeak, na.rm = T), 
            maximo = max(Oldpeak, na.rm = T), 
            desvio = sd(Oldpeak, na.rm = T), 
            coeficiente = round(sd(Oldpeak, na.rm = T)/mean(Oldpeak, na.rm = T)*100,2)) %>% 
  knitr::kable(col.names = c("Grupo", "Média", "Mediana", "1º Quartil", "3º Quartil", "Mínimo", "Máximo", "Desvio Padrão", "Coeficiente de Variação (%)"), caption = "Estatística Descritiva do valor númerico medido na depressão de Acordo com a presença ou ausência de doença cardíaca")

Estatística Descritiva do valor númerico medido na depressão de Acordo com a presença ou ausência de doença cardíaca

Grupo	Média	Mediana	1º Quartil	3º Quartil	Mínimo	Máximo	Desvio Padrão	Coeficiente de Variação (%)
Normal	0.4080488	0.0	0	0.6	-1.1	4.2	0.6997091	171.48
Doença Cardíaca	1.2742126	1.2	0	2.0	-2.6	6.2	1.1518720	90.40

Código

plot_ly(banco, x = banco$Oldpeak, color = banco$HeartDisease, type = "box") %>% 
  layout(title = "Boxplot do banco do valor númerico medido \nna depressão de acordo com a presença ou ausência de doença cardíaca")

Comentário

Podemos observar que no grupo normal, temos a presença de muitos outliers, já no grupo de doença cardíaca, entre o primeiro e terceiro quartil podemos enxergar uma variabilidade maior do que comparando esses mesmos quartis.

Doença Cardíaca

Código

banco %>% 
  dplyr::group_by(HeartDisease) %>% 
  dplyr::summarise(quantidade = n(), 
            proporção = round(n()/dim(banco)[1]*100,2)) %>%
  knitr::kable(caption = "Descritiva da Quantidade de Indívidios com ou sem doença cardíaca", col.names = c("Grupo", "Quantidade", "Proporção"))

Descritiva da Quantidade de Indívidios com ou sem doença cardíaca

Grupo	Quantidade	Proporção
Normal	410	44.66
Doença Cardíaca	508	55.34

Agora, vamos visualizar a matriz de correlação das variáveis preditoras

Código

rho <- banco %>% 
  dplyr::select(where(is.numeric)) %>% 
  cor()

corrplot::corrplot(rho, method = "circle", type = "lower")

Ajuste dos modelos

Particionando o banco de dados

Código

set.seed(2024)
banco_split <- initial_split(data = banco, prop = .75, strata = HeartDisease)
banco_treino <- training(banco_split)
banco_teste <- testing(banco_split)

• Verificando a quantidade de observações dos bancos, de acordo com a variável de interesse.

Código

banco_treino %>%
  dplyr::group_by(HeartDisease) %>% 
  dplyr::summarise(quantidade = n(), 
                   proporção = round(n()/dim(banco_treino)[1]*100,2)) %>% 
  knitr::kable(caption = "Quantidade de Observações por grupo no banco de treino", col.names = c("Grupo", "Quantidade", "Proporção (%)"))

Quantidade de Observações por grupo no banco de treino

Grupo	Quantidade	Proporção (%)
Normal	307	44.62
Doença Cardíaca	381	55.38

Código

banco_teste %>% 
  dplyr::group_by(HeartDisease) %>% 
  dplyr::summarise(quantidade = n(), 
                   proporção = round(n()/dim(banco_teste)[1]*100,2)) %>% 
  knitr::kable(caption = "Quantidade de observações por grupo no banco de teste", col.names = c("Grupo", "Quantidade", "Proporção (%)"))

Quantidade de observações por grupo no banco de teste

Grupo	Quantidade	Proporção (%)
Normal	103	44.78
Doença Cardíaca	127	55.22

Podemos observar que a proporção de dados para o teste do modelo de acordo com a quantidade de observações total é de 74.9455%.

Ajustando os modelos

LDA - Análise Discriminante Linear

Para a análise discriminante linear, vamos utilizar a função lda do pacote MASS.

Código

fit_lda <- lda(HeartDisease ~ ., data = banco_treino)

Podemos agora analisar as médias dos grupos de acordo com as variáveis dependentes que foi estimado pela lda

Código

fit_lda$means

                     Age RestingBP Cholesterol    MaxHR   Oldpeak
Normal          50.60586  130.5277    226.3909 147.1368 0.4117264
Doença Cardíaca 56.02887  134.0394    180.7927 127.3333 1.3002625

Agora, usando o modelo para fazer a predição dos valores do banco de teste:

Código

y_pred_lda <- predict(fit_lda, banco_teste)

Observando a probabilidade posterior dos valores preditos via LDA

Código

y_pred_lda$posterior %>% 
  head(n = 5) %>% 
  knitr::kable()

Normal	Doença Cardíaca
0.1683448	0.8316552
0.9207566	0.0792434
0.3221740	0.6778260
0.0606891	0.9393109
0.4816099	0.5183901

• Verificando a matriz de confusão, bem como algumas métricas trazidas pela função confusionMatrix do pacote caret.

Código

caret::confusionMatrix(y_pred_lda$class, banco_teste$HeartDisease)

Confusion Matrix and Statistics

                 Reference
Prediction        Normal Doença Cardíaca
  Normal              80              28
  Doença Cardíaca     23              99
                                         
               Accuracy : 0.7783         
                 95% CI : (0.719, 0.8302)
    No Information Rate : 0.5522         
    P-Value [Acc > NIR] : 7.469e-13      
                                         
                  Kappa : 0.5537         
                                         
 Mcnemar's Test P-Value : 0.5754         
                                         
            Sensitivity : 0.7767         
            Specificity : 0.7795         
         Pos Pred Value : 0.7407         
         Neg Pred Value : 0.8115         
             Prevalence : 0.4478         
         Detection Rate : 0.3478         
   Detection Prevalence : 0.4696         
      Balanced Accuracy : 0.7781         
                                         
       'Positive' Class : Normal         
                                         

Código

taxa_erro_lda <- 1 - caret::confusionMatrix(y_pred_lda$class, banco_teste$HeartDisease)$overall[["Accuracy"]]

taxa_erro_lda

[1] 0.2217391

Comentário Análise Discriminante Linear

• De acordo com as métricas fornecidas pela matriz de confusão e pela taxa de erro, podemos observar que o modelo não foi bem ajustado, isso pode ter acontecido por causa da utilização apenas das variáveis númericas, pois, a acúracia do modelo foi de 0.778, sendo baixa.

QDA - Análise Discriminante Quadrátrica

Para a aplicação da análise discriminante quadrática, vamos usar a função qda do pacote MASS

Código

fit_qda <- qda(HeartDisease ~ ., data = banco_treino)

Podemos visualizar as médias dos grupos que foi estimada pelo modelo, e as médias que foi estimada para os grupos foi

Código

fit_qda$means

                     Age RestingBP Cholesterol    MaxHR   Oldpeak
Normal          50.60586  130.5277    226.3909 147.1368 0.4117264
Doença Cardíaca 56.02887  134.0394    180.7927 127.3333 1.3002625

• Agora, vamos usar o modelo que foi ajustada no banco de teste para ver a capacidade do modelo em prever novas observações

Código

y_pred_qda <- predict(fit_qda, banco_teste)

Observando a probabilidade posterior de algumas informações se enquadrar em grupos diferentes, temos:

Código

y_pred_qda$posterior %>% 
  head(n = 10) %>% 
  knitr::kable()

Normal	Doença Cardíaca
0.1713286	0.8286714
0.9333100	0.0666900
0.2974631	0.7025369
0.0460539	0.9539461
0.6858007	0.3141993
0.6691053	0.3308947
0.8739605	0.1260395
0.9780778	0.0219222
0.9543109	0.0456891
0.1751045	0.8248955

• Verificando a matriz de confusão, bem como algumas métricas trazidas pela função confusionMatrix do pacote caret.

Código

caret::confusionMatrix(y_pred_qda$class, banco_teste$HeartDisease)

Confusion Matrix and Statistics

                 Reference
Prediction        Normal Doença Cardíaca
  Normal              85              36
  Doença Cardíaca     18              91
                                         
               Accuracy : 0.7652         
                 95% CI : (0.705, 0.8184)
    No Information Rate : 0.5522         
    P-Value [Acc > NIR] : 1.573e-11      
                                         
                  Kappa : 0.533          
                                         
 Mcnemar's Test P-Value : 0.0207         
                                         
            Sensitivity : 0.8252         
            Specificity : 0.7165         
         Pos Pred Value : 0.7025         
         Neg Pred Value : 0.8349         
             Prevalence : 0.4478         
         Detection Rate : 0.3696         
   Detection Prevalence : 0.5261         
      Balanced Accuracy : 0.7709         
                                         
       'Positive' Class : Normal         
                                         

Código

taxa_erro_qda <- 1 - caret::confusionMatrix(y_pred_qda$class, banco_teste$HeartDisease)$overall[["Accuracy"]]

taxa_erro_qda

[1] 0.2347826

Comentário Análise Discriminante Quadrática

• De acordo com as métricas fornecidas pela matriz de confusão e pela taxa de erro, podemos observar que o modelo não foi bem ajustado, isso pode ter acontecido por causa da utilização apenas das variáveis númericas, pois, a acúracia do modelo foi de 0.765, sendo baixa.

Regressão Logística

• Para a regressão logística, vamos utilizar a função glm do pacote stats

Código

fit_lr <- glm(HeartDisease ~., data = banco_treino, family = binomial(link = "logit"))

Observando alguns resultados sobre se as variáveis são relevantes para a estimação.

Código

summary(fit_lr)

Call:
glm(formula = HeartDisease ~ ., family = binomial(link = "logit"), 
    data = banco_treino)

Coefficients:
              Estimate Std. Error z value Pr(>|z|)    
(Intercept)  2.9101514  1.1076329   2.627   0.0086 ** 
Age          0.0162622  0.0111929   1.453   0.1462    
RestingBP    0.0021546  0.0051306   0.420   0.6745    
Cholesterol -0.0039823  0.0009271  -4.295 1.74e-05 ***
MaxHR       -0.0276855  0.0042768  -6.473 9.59e-11 ***
Oldpeak      0.9460773  0.1064520   8.887  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 945.80  on 687  degrees of freedom
Residual deviance: 704.38  on 682  degrees of freedom
AIC: 716.38

Number of Fisher Scoring iterations: 4

Resposta: Podemos observar que duas variáveis ao nível de significância \(\alpha\) de 10% não foi significativo para o modelo, todavia, vamos manter todas as variáveis, pois, já tivemos uma perca com a remoção das variáveis categóricas dos dados.

Código

y_pred_lr <- as.factor(ifelse(predict(fit_lr, banco_teste, type = "response") >.5, "Doença Cardíaca", "Normal"))

Comentário: Definimos o ponto de corte em 0.5, todavia, essa pode não ter sido uma boa estratégia.

Código

caret::confusionMatrix(y_pred_lr, banco_teste$HeartDisease)

Warning in confusionMatrix.default(y_pred_lr, banco_teste$HeartDisease): Levels
are not in the same order for reference and data. Refactoring data to match.

Confusion Matrix and Statistics

                 Reference
Prediction        Normal Doença Cardíaca
  Normal              79              27
  Doença Cardíaca     24             100
                                         
               Accuracy : 0.7783         
                 95% CI : (0.719, 0.8302)
    No Information Rate : 0.5522         
    P-Value [Acc > NIR] : 7.469e-13      
                                         
                  Kappa : 0.5529         
                                         
 Mcnemar's Test P-Value : 0.7794         
                                         
            Sensitivity : 0.7670         
            Specificity : 0.7874         
         Pos Pred Value : 0.7453         
         Neg Pred Value : 0.8065         
             Prevalence : 0.4478         
         Detection Rate : 0.3435         
   Detection Prevalence : 0.4609         
      Balanced Accuracy : 0.7772         
                                         
       'Positive' Class : Normal         
                                         

Código

taxa_erro_lr <- 1 - caret::confusionMatrix(y_pred_lr, banco_teste$HeartDisease)$overall[["Accuracy"]]

Warning in confusionMatrix.default(y_pred_lr, banco_teste$HeartDisease): Levels
are not in the same order for reference and data. Refactoring data to match.

Código

taxa_erro_lr

[1] 0.2217391

Comentário Regressão Logística

• De acordo com as métricas fornecidas pela matriz de confusão e pela taxa de erro, podemos observar que o modelo não foi bem ajustado, isso pode ter acontecido por causa da utilização apenas das variáveis númericas, pois, a acúracia do modelo foi de 0.778, sendo baixa.

• Interessante: Os resultados foram iguais com a análise discriminante linear, inclusive a acurácia.

Naive Bayes

• Ou popularmente como é conhecido, bayes ingênuo, para a utilização do naive bayes, vamos utilizar o pacote e1071 e a função naiveBayes.

Código

fit_naive <- e1071::naiveBayes(HeartDisease ~., data = banco_treino)

O resultado do ajuste por naive bayes, pode ser visto:

Código

fit_naive

Naive Bayes Classifier for Discrete Predictors

Call:
naiveBayes.default(x = X, y = Y, laplace = laplace)

A-priori probabilities:
Y
         Normal Doença Cardíaca 
      0.4462209       0.5537791 

Conditional probabilities:
                 Age
Y                     [,1]     [,2]
  Normal          50.60586 9.384543
  Doença Cardíaca 56.02887 8.813967

                 RestingBP
Y                     [,1]     [,2]
  Normal          130.5277 16.87638
  Doença Cardíaca 134.0394 20.18196

                 Cholesterol
Y                     [,1]     [,2]
  Normal          226.3909  75.3635
  Doença Cardíaca 180.7927 126.7339

                 MaxHR
Y                     [,1]     [,2]
  Normal          147.1368 23.54055
  Doença Cardíaca 127.3333 23.72677

                 Oldpeak
Y                      [,1]      [,2]
  Normal          0.4117264 0.7126719
  Doença Cardíaca 1.3002625 1.1724580

• Ajustando os valores para a predição dos valores do banco de treino.

Código

y_pred_naive <- predict(fit_naive, banco_teste)

Observando os resultados dos valores preditos por Naive Bayes de acordo com as métricas fornecidas pela matriz de confusão

Código

caret::confusionMatrix(y_pred_naive, banco_teste$HeartDisease)

Confusion Matrix and Statistics

                 Reference
Prediction        Normal Doença Cardíaca
  Normal              83              31
  Doença Cardíaca     20              96
                                         
               Accuracy : 0.7783         
                 95% CI : (0.719, 0.8302)
    No Information Rate : 0.5522         
    P-Value [Acc > NIR] : 7.469e-13      
                                         
                  Kappa : 0.5561         
                                         
 Mcnemar's Test P-Value : 0.1614         
                                         
            Sensitivity : 0.8058         
            Specificity : 0.7559         
         Pos Pred Value : 0.7281         
         Neg Pred Value : 0.8276         
             Prevalence : 0.4478         
         Detection Rate : 0.3609         
   Detection Prevalence : 0.4957         
      Balanced Accuracy : 0.7809         
                                         
       'Positive' Class : Normal         
                                         

Código

taxa_erro_naive <- 1 - caret::confusionMatrix(y_pred_naive, banco_teste$HeartDisease)$overall[["Accuracy"]]

taxa_erro_naive

[1] 0.2217391

Comentário Naive Bayes

• De acordo com as métricas fornecidas pela matriz de confusão e pela taxa de erro, podemos observar que o modelo não foi bem ajustado, isso pode ter acontecido por causa da utilização apenas das variáveis númericas, pois, a acúracia do modelo foi de 0.778, sendo baixa.

• Interessante: Mais uma vez podemos observar que a Acurácia e a taxa de erro do Naive Bayes foi igual dos modelos de Regressão Logística e Análise Discriminante Linear (LDA).

KNN - com k = 5

• Para isso vamos utilizar a função knn do pacote class

Código

treino_Heart_Disease <- as.factor(banco_treino$HeartDisease)
y_pred_knn <- knn(train = banco_treino[,-6], 
                  test = banco_teste[,-6], 
                  cl = treino_Heart_Disease, 
                  k = 5)

Observando algumas observações como elas foram classificadas

Código

y_pred_knn %>% 
  head(n = 10)

 [1] Doença Cardíaca Normal          Normal          Normal         
 [5] Normal          Normal          Normal          Normal         
 [9] Doença Cardíaca Doença Cardíaca
Levels: Normal Doença Cardíaca

Partindo para as métricas de avaliação via matriz de confusão, temos:

Código

caret::confusionMatrix(y_pred_knn, banco_teste$HeartDisease)

Confusion Matrix and Statistics

                 Reference
Prediction        Normal Doença Cardíaca
  Normal              68              40
  Doença Cardíaca     35              87
                                          
               Accuracy : 0.6739          
                 95% CI : (0.6092, 0.7341)
    No Information Rate : 0.5522          
    P-Value [Acc > NIR] : 0.0001108       
                                          
                  Kappa : 0.3437          
                                          
 Mcnemar's Test P-Value : 0.6441672       
                                          
            Sensitivity : 0.6602          
            Specificity : 0.6850          
         Pos Pred Value : 0.6296          
         Neg Pred Value : 0.7131          
             Prevalence : 0.4478          
         Detection Rate : 0.2957          
   Detection Prevalence : 0.4696          
      Balanced Accuracy : 0.6726          
                                          
       'Positive' Class : Normal          
                                          

Código

taxa_erro_knn <- 1 - caret::confusionMatrix(y_pred_knn, banco_teste$HeartDisease)$overall[["Accuracy"]]

taxa_erro_knn

[1] 0.326087

Comentário KNN

• De acordo com as métricas fornecidas pela matriz de confusão e pela taxa de erro, podemos observar que o modelo não foi bem ajustado, sendo o pior modelo para os dados ,isso pode ter acontecido por causa da utilização apenas das variáveis númericas, pois, a acúracia do modelo foi de 0.674, sendo baixa.

• As métricas mostram que foi o pior modelo ajustado aos dados, em comparação com os modelos ajustados anteriormente.

Análise Final dos Ajustes

• Depois de ajustado os modelos, utilizamos aqui quatro métodos diferente, sendo eles: Análise Discriminante Linear (LDA), Análise Discriminante Quadrática (QDA), Regressão Logística, Naive Bayes e KNN com \(k = 5\).

Os resultados das taxas de erro, podem ser vistas nessa tabela abaixo:

Código

nomes <- c("Análise Discriminante Linear", "Análise Discriminante Quadrática", "Regressão Logística", "Naive Bayes", "KNN - com k = 5")
valores <- c(taxa_erro_lda, taxa_erro_qda, taxa_erro_lr, taxa_erro_naive, taxa_erro_knn)
banco_resultado <- tibble(nomes, round(valores,4))

banco_resultado %>% 
  knitr::kable(caption = "Tabela com a taxa de erro dos modelos ajustados", col.names = c("Modelo", "Taxa de Erro"))

Tabela com a taxa de erro dos modelos ajustados

Modelo	Taxa de Erro
Análise Discriminante Linear	0.2217
Análise Discriminante Quadrática	0.2348
Regressão Logística	0.2217
Naive Bayes	0.2217
KNN - com k = 5	0.3261

Conclusão Final

• Podemos observar que nenhum dos ajustes ficou de maneira ideal, com uma precisão ideal, exceto o modelo knn, que ficou extremamente ruim. Mais uma vez vale ressaltar que a permanência de variáveis categóricas poderiam dar uma boa contribuição em uma classificar mais precisa dos dados ajustados.