Challenge Project 02 - Warm Up: Machine Learning with a Heart¶
29 de março, 2020
1. Descrição geral do problema¶
As doenças cardíacas são a principal causa de morte no mundo. Para aprender a prevenir doenças cardíacas, precisamos primeiro aprender a detectá-las com segurança.
Nosso conjunto de dados é de um estudo de doenças cardíacas que está aberto ao público há muitos anos. O estudo coleta várias medidas sobre a saúde do paciente e as estatísticas cardiovasculares e, é claro, torna as identidades dos pacientes anônimas.
Os dados são fornecidos como cortesia do Cleveland Heart Disease Database) através do repositório UCI Machine Learning.
Prevenir doenças cardíacas é importante. Bons sistemas orientados a dados para prever doenças cardíacas podem melhorar todo o processo de pesquisa e prevenção, garantindo que mais pessoas possam ter uma vida saudável.
Nos Estados Unidos, os Centros de Controle e Prevenção de Doenças são um bom recurso para obter informações sobre doenças cardíacas. De acordo com o site:
- Cerca de 610.000 pessoas morrem de doenças cardíacas nos Estados Unidos a cada ano - isso é 1 em cada 4 mortes.
- As doenças cardíacas são a principal causa de morte para homens e mulheres. Mais da metade das mortes por doenças cardíacas em 2009 ocorreram em homens.
- A doença cardíaca coronária (DCC) é o tipo mais comum de doença cardíaca, matando mais de 370.000 pessoas anualmente.
- Todos os anos, cerca de 735.000 americanos sofrem um ataque cardíaco. Destes, 525.000 são um primeiro ataque cardíaco e 210.000 ocorrem em pessoas que já tiveram um ataque cardíaco.
- As doenças cardíacas são a principal causa de morte para pessoas da maioria das etnias dos Estados Unidos, incluindo afro-americanos, hispânicos e brancos. Para índios americanos ou nativos do Alasca e asiáticos ou ilhéus do Pacífico, as doenças cardíacas perdem apenas para o câncer.
Para obter mais informações, consulte o site dos centros de controle e prevenção de doenças.
Objetivo: utilizar a linguagem R para prever a classe binária heart_disease_present, que representa se um paciente tem ou não uma doença cardíaca utilizando para a avaliação de desempenho dos modelos preditivos a serem criados a métrica Logloss).
2. Carregando Dados¶
2.1 Importando bibliotecas necessárias¶
Vamos começar nosso projeto importanto todas as bilbiotecas necessárias para a realização das fases iniciais de exploração e transformação dos dados (Data Munging).
# Definindo a oculatação de warnings.
options(warn = -1)
# Caso não possua uma das bibliotecas importadas abaixo, a instale com o comando a seguir:
install.packages(c(
'dplyr',
'corrplot',
'ggplot2',
'gmodels',
'vcd',
'pROC',
'e1071'
))
# Importando bibliotecas.
library(dplyr)
library(corrplot)
library(ggplot2)
library(gmodels)
library(vcd)
library(pROC)
library(e1071)
2.2 Carregando dados¶
# Importando os dados do dataset.
dataset <- read.table("/content/datasets/heart.dat")
# Visualizando dados Importados.
head(dataset)
# Renomeando colunas do dataset.
names(dataset) <- c('age', 'sex',
'chest_pain_type',
'resting_blood_pressure',
'serum_cholestoral',
'fasting_blood_sugar',
'resting_electro_results',
'max_heart_rate_achieved',
'exercise_induced_angina',
'oldpeak',
'slope_of_the_peak',
'number_of_major_vessels',
'thal',
'heart_disease')
# Criando uma cópia do dataset.
data <- dataset
3. Data Munging - Preparando dados para a análise exploratória¶
3.1 Visão geral dos dados¶
Segundo as documentações do DrivenData e da UCI Machine Learning Repository) referente ao projeto, cada linha dos dados contém um registro, com as seguintes variáveis:
| Variável | Tipo | Descrição |
|---|---|---|
| heart_disease (Target) | binário | representa se um paciente tem ou não uma doença cardíaca (1: não apresenta doença cardíaca, 2: apresenta doença cardíaca); |
| slope_of_peak | int | é a inclinação do segmento ST do pico do exercício, uma eletrocardiografia lida indicando a qualidade do fluxo sanguíneo no coração; |
| thal | categórico | são os resultados do teste de stress com tálio para o fluxo sanguíneo de medição para o coração, com os valores possíveis: normal, fixed_defect, reversible_defect; |
| resting_blood_pressure | int | é a pressão arterial em repouso; |
| chest_pain_type | int | é o tipo de dor no peito (1-4); |
| number_major_vessels | int | é o número de vasos principais (0-3) coloridos por flourosopy; |
| fasting_blood_sugar | binário | indica se o açúcar no sangue em jejum é > 120 mg/dl; |
| resting_electro_results | int | são os resultados eletrocardiográficos em repouso (0-2); |
| serum_cholesterol | int | é o colestorol sérico em mg/dl; |
| oldpeak | float | oldpeak = depressão do ST induzida pelo exercício em relação ao repouso, é uma medida de anormalidade nos eletrocardiogramas; |
| sex | binário | indica o sexo do paciente (0: feminino, 1: masculino); |
| age | int | indica a idade em anos do paciente; |
| max_heart_rate_achieved | int | é a frequência cardíaca máxima atingida (batimentos por minuto) e; |
| exercise_induced_angina | binário | indica se há dor no peito induzida por exercícios ( 0: falso, 1: verdadeiro). |
Nesta etapa vamos buscar organizar os dados das variáveis para efetuar a análise exploratória e extrair insigths que possam auxiliar no processo de criação dos modelos preditivos.
# Verificando os tipos das colunas carregadas no dataset.
glimpse(data)
Verificamos a existência de 14 variáveis numéricas e 270 observações dentro do dataset.
# Verificando a existência de valores NA no dataset.
print(sapply(data, function(v) {
anyNA(v)
}))
Não foi detectado nenhum valor NA dentro do conjunto de dados.
# Verificando o número de valores únicos presentes em cada uma das variáveis especificadas.
print(sapply(data, function(v) {
length(unique(v))
}))
3.2 Alterando tipos de dados das variáveis¶
A partir da documentação fornecida sobre o conjunto de dados, iremos alterar o tipo de dado de cada variável.
## Alterando o tipo da variável sex.
data$sex <- as.factor(data$sex)
# Alterando as etiquetas dos valores da variável.
levels(data$sex) <- c('F', 'M')
## Alterando o tipo da variável fasting_blood_sugar.
data$fasting_blood_sugar <- as.factor(data$fasting_blood_sugar)
# Alterando as etiquetas dos valores da variável.
levels(data$fasting_blood_sugar) <- c('No', 'Yes')
## Alterando o tipo da variável exercise_induced_angina.
data$exercise_induced_angina <- as.factor(data$exercise_induced_angina)
# Alterando as etiquetas dos valores da variável.
levels(data$exercise_induced_angina) <- c('No', 'Yes')
# Alterando o tipo da variável resting_electro_results.
data$resting_electro_results <- as.factor(data$resting_electro_results)
# Alterando o tipo da variável chest_pain_type.
data$chest_pain_type <- as.factor(data$chest_pain_type)
# Alterando o tipo da variável slope_of_the_peak.
data$slope_of_the_peak <- factor(data$slope_of_the_peak, ordered = T)
## Alterando o tipo da variável thal.
data$thal <- as.factor(data$thal)
# Alterando as etiquetas dos valores da variável.
levels(data$thal) <- c('Normal', 'Fixed defect', 'Reversable defect')
## Alterando o tipo da variável heart_disease.
data$heart_disease <- as.factor(data$heart_disease)
# Alterando as etiquetas dos valores da variável.
levels(data$heart_disease) <- c('No', 'Yes')
# Alterando o tipo da variável age.
data$age <- as.integer(data$age)
# Alterando o tipo da variável resting_blood_pressure.
data$resting_blood_pressure <- as.integer(data$resting_blood_pressure)
# Alterando o tipo da variável serum_cholestoral.
data$serum_cholestoral <- as.integer(data$serum_cholestoral)
# Alterando o tipo da variável max_heart_rate_achieved.
data$max_heart_rate_achieved <- as.integer(data$max_heart_rate_achieved)
# Alterando o tipo da variável number_of_major_vessels.
data$number_of_major_vessels <- as.factor(data$number_of_major_vessels)
# Verificando os tipos das colunas carregadas no dataset.
glimpse(data)
Perfeito, agora podemos ir para as próxima etapas de exploração dos dados.
3.3 Explorando a distribuição de cada variável individualmente¶
Antes de começarmos, queremos deixar claro que quando utilizarmos expressões que descrevam uma pessoa como sendo saudável ou sadia estaremos especificamente declarando que ela não possui registros de doenças cardiovasculares.
Independente do indivíduo apresentar ou não outras doenças, adotaremos esta nomeclatura para aumentar a fluidez na escrita da nossa análise que tem como foco estudar problemas cardíacos.
3.3.1 Criando funções auxiliares¶
3.3.1.1 Funções para a criação de gráficos¶
Criaremos algumas funções para padronizar as plotagens de gráficos que efetuaremos.
# Definindo um função para criar gráficos de barras.
barPlot <- function(col, data, target = 'heart_disease') {
ggplot(data = data, aes(x = data[, col], fill = data[, target])) +
geom_bar(alpha = 0.85, position = 'dodge') +
ggtitle(paste("Bar chart for variable:", col)) +
xlab(col) +
labs(fill = "Heart Disease") +
theme_bw()
}
# Definindo um função para criar gráficos de densidade.
densityPlot <- function(col, data, target = 'heart_disease') {
ggplot(data = data, aes(x = data[, col], fill = data[, target])) +
geom_density(alpha = 0.85) +
ggtitle(paste("Density chart for variable:", col)) +
xlab(col) +
labs(fill = "Heart Disease") +
theme_bw()
}
# Definindo um função para criar gráficos de boxplot.
boxPlot <- function(col, data, target = 'heart_disease') {
ggplot(data = data, aes(x = data[, target], y = data[, col], fill = data[, target])) +
geom_boxplot(alpha = 0.85) +
ggtitle(paste("Boxplot for variable:", col)) +
ylab(col) +
xlab("") +
labs(fill = "Heart Disease") +
theme_bw()
}
3.3.1.2 Funções para calcular estatísticas¶
Criaremos uma função para padronizar as estatísticas que calcularemos para cada uma das variáveis a serem estudadas.
# Definindo um função para gerar um dataframe com as estatísticas de uma variável do dataset.
varStats <- function(col, data, target = 'heart_disease') {
if(!is.factor(data[, col])) {
# Calcula estatísticas de variáveis numéricas.
data %>%
group_by_at(target) %>%
summarize(
Min = min(get(col)),
Q1 = unname(quantile(get(col), probs = c(0.25))),
Median = median(get(col)),
mean = mean(get(col)),
Q3 = unname(quantile(get(col), probs = c(0.75))),
Max = max(get(col)),
Sd = sd(get(col)),
Sk = skewness(get(col)),
Ck = kurtosis(get(col))
)
} else {
# Calcula estatísticas de variáveis categóricas.
l = list()
# Contabiliza o número de registros dentro de cada classe da variável.
l$variableClasses <- data %>%
group_by_at(col) %>%
summarise(
count = n(),
prop = n() / nrow(data) * 100
)
# Contabiliza o número de registros dentro de cada classe da variável e segmenta cada subconjunto a partir
#da variável alvo.
l$variableClassesGroupedByTargetVariable <- data %>%
group_by_at(c(col, target)) %>%
summarise(
count = n(),
prop = n() / nrow(data) * 100
)
# Retorna a lista com as estatísticas computadas.
l
}
}
O coeficente de Assimetria (Skewness) indica como os dados estão distribuídos e para interpretar seu resultado podemos olhar a tabela a seguir:
| Índice de Assimetria | Descrição |
|---|---|
| SK ≈ 0 | Os dados são simétricos. Tanto a cauda do lado direito quanto a do lado esquerdo da função densidade de probabilidade são iguais; |
| SK < 0 | A assimetria é negativa. A cauda do lado esquerdo da função densidade de probabilidade é maior que a do lado direito e; |
| SK > 0 | A assimetria é positiva. A cauda do lado direito da função densidade de probabilidade é maior que a do lado esquerdo. |
O coeficiente de Curtose (Kurtosis) é uma medida que caracteriza o achatamento da curva da função de distribuição e para interpretar seu resultado podemos olhar a tabela a seguir:
| Índice de Curtose | Descrição |
|---|---|
| CK ≈ 0 | A distribuição é normal e é chamada de Curtose Mesocúrtica; |
| CK < 0 | A Cauda é mais leve que a normal. Para um coeficiente de Curtose negativo, tem-se uma Curtose Platicúrtica e; |
| CK > 0 | A Cauda é mais pesada que a normal. Para um coeficiente de Curtose positivo, tem-se uma Curtose Leptocúrtica. |
Atenção: Há diferentes fórmulas para calcular estes coeficientes. Mas, para este estudo utilizamos as funções fornecidas pela biblioteca e1071 com suas respectivas configurações padrão. Em caso de dúvida, consulte a documentação.
3.3.2 Variável age¶
# Definindo o nome da variável a ser analisada.
col <- 'age'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
# Criando um gráfico de densidade para a variável especificada.
densityPlot(col, data)
Os dados dos indivíduos que apresentam problemas cardíacos está mais deslocado para a direita quando comparado ao dos indivíduos que não apresentam estas dificuldades. Isto nos indica que as pessoas com problemas cardiovasculares tendem a ser mais velhas do que aquelas que apresentam um coração sadio.
# Criando um gráfico de boxplot para a variável especificada.
boxPlot(col, data)
O gráfico de boxplot nos permite detectar a presença de outliers dentro dos dados dos indivíduos que apresentam problemas cardíacos.
# Calculando algumas estatísticas para a variável especificada.
varStats(col, data)
Concluímos que há uma diferença mediana de 6 anos entre os índividuos classificados com ou sem problemas cardíacos.
3.3.3 Variável sex¶
# Definindo o nome da variável a ser analisada.
col <- 'sex'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Observamos que dentro do nosso conjunto de dados aproximadamente 32.2% dos registros estão associados a mulheres e 67.8% estão associados a homens.
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
É interessante observar que a proporção de mulheres com problemas cardíacos dentro do conjunto de dados é aproximadamente 3.34 vezes menor do que aquelas que estão saudáveis e 5 vezes menor do que a proporção de homens doentes.
3.3.4 Variável chest_pain_type¶
# Definindo o nome da variável a ser analisada.
col <- 'chest_pain_type'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
Vemos que as pessoas que apresentam dores do tipo 1, 2 e 3 são predominantemente sadias, mas este padrão se inverte para a dor tipo 4 onde a maior parte dos indivíduos que a possuem apresentam problemas cardíacos.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Observamos que as proporções dos registros do tipo de dor crescem de maneira incremental, sendo a dor do tipo 1 a menos frequente (presente em aproximadamente 7.4% dos registros) e a do tipo 4 a mais frequente (presente em aproximadamente 47.8% dos registros).
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
Destacamos que 78.5% dos indivíduos que apresentam a dor do tipo 3 tem um coração saudável enquanto 70.5% dos indivíduos que aprentam a dor do tipo 4 possuem problemas cardíacos.
3.3.5 Variável resting_blood_pressure¶
# Definindo o nome da variável a ser analisada.
col <- 'resting_blood_pressure'
# Criando um gráfico de densidade para a variável especificada.
densityPlot(col, data)
Bom, parece que a pressão arterial de todos os indivíudos em repouso apresenta um valor mediano muito próximo independente da existência de problemas cardiovasculares.
# Criando um gráfico de boxplot para a variável especificada.
boxPlot(col, data)
O boxplot nos confirma que o valor mediano destes conjuntos de dados está muito próximo; nos permite detectar a exitência de outliers e ainda observar a significativa assimetria à direita dos dados dos indivíduos que apresentam doenças cardíacas.
# Calculando algumas estatísticas para a variável especificada.
varStats(col, data)
Veja só! O valor médiano para a pressão arterial dos indivíudos em repouso é o mesmo independente de estarem ou não doentes.
Note que o coeficiente de assimetria (Sk) também comprova nossa teoria de que a distribuição dos indivíduos com problemas cardíacos apresenta uma assimetria à direita.
3.3.6 Variável serum_cholestoral¶
# Definindo o nome da variável a ser analisada.
col <- 'serum_cholestoral'
# Criando um gráfico de densidade para a variável especificada.
densityPlot(col, data)
O gráfico de densidade está indicando que há uma diferença no valor mediano do colestorol sérico em mg/dl entre os individuos classificados com ou sem doenças cardíacas.
# Criando um gráfico de boxplot para a variável especificada.
boxPlot(col, data)
# Calculando algumas estatísticas para a variável especificada.
varStats(col, data)
Concluímos que a diferença mediana entre as classes é de 19.5 mg/dl.
3.3.7 Variável fasting_blood_sugar¶
# Definindo o nome da variável a ser analisada.
col <- 'fasting_blood_sugar'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
Interessante! A maior parte dos indivíduos registrados não possuem uma taxa de açúcar no sangue em jejum maior do que 120 mg/dl.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Aproximadamente 14.8% dos indivíduos registrados apresentam uma taxa de açúcar no sangue em jejum maior do que 120 mg/dl.
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
Está tabela nos informa a proporção de registros em cada uma das classes da variável que avalia a taxa de açúcar no sangue agrupadas em subgrupos que indicam se o índividuo possui ou não problemas cardíacos. Mas, para este caso as informações fornecidas não nos ajudam a extrair muitas informações interessantes.
Por isso, vamos criar outra tabela em que dividimos a coluna count pelo número total de registros classificados em cada grupo da variável fasting_blood_sugar e recalcularemos as proporções. De maneira simples, o que estamos querendo é determinar se a proporção de indivíduos com problemas cardíacos varia muito entre a classe de indivíduos que apresentam ou não uma taxa de açúcar no sangue em jejum maior do que 120 mg/dl.
# Calculando as proporções de indivíduos com ou sem problemas cardíacos dentro de cada classe da variável especificada.
stats$variableClassesGroupedByTargetVariable %>%
group_by(fasting_blood_sugar) %>%
mutate(prop = count / sum(count) * 100)
Vemos que as proporções são bem próximas.
Dentro da classe de indivíduos que não possuem uma taxa de açúcar no sangue em jejum maior do que 120 mg/dl, aproximadamente 55.2% tem um coração sadio enquanto 44.8% possuem doenças.
Dentro da classe de indivíduos que possuem uma taxa de açúcar no sangue em jejum maior do que 120 mg/dl, 57.5% tem um coração sadio enquanto 42.5% possuem doenças.
3.3.8 Variável resting_electro_results¶
# Definindo o nome da variável a ser analisada.
col <- 'resting_electro_results'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
Os resultados eletrocardiográficos em repouso que apresentam valor 0 estão predominantemente associados a indivíduos que não possuem doenças enquanto aqueles classificados com o valor 2 estão predominantemente associados a índivíduos doentes.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Os resultados eletrocardiográficos em repouso que obtiveram o valor 1 são aqueles que apresentam a menor proporção dentro do conjunto de dados, aproximadamente 0.74%.
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
Destacamos que dentro dos resultados eletrocardiográficos em repouso classificados com o valor 0, a quantidade de indivíduos que são sadios é cerca de 1.85 vezes maior do que aqueles que são doentes.
3.3.9 Variável max_heart_rate_achieved¶
# Definindo o nome da variável a ser analisada.
col <- 'max_heart_rate_achieved'
# Criando um gráfico de densidade para a variável especificada.
densityPlot(col, data)
Parece que o número mediano de batimentos cardíacos por minuto dos indivíduos sádios é maior do que o dos indivíduos com doenças.
# Criando um gráfico de boxplot para a variável especificada.
boxPlot(col, data)
Detectamos a existência de outliers dentro dos dois subconjuntos analisados.
# Calculando algumas estatísticas para a variável especificada.
varStats(col, data)
Bom, como suspeitávamos pessoas com doenças cardiovasculares apresentam um número mediano menor de batimentos cardíacos (cerca de 21 batimentos a menos). Também observamos que o conjunto de dados de índividuos sadios tem um desvio-padrão menor.
3.3.10 Variável exercise_induced_angina¶
# Definindo o nome da variável a ser analisada.
col <- 'exercise_induced_angina'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
Vemos que predominantemente não há dor no peito induzida por exercício para os indivíduos sadios, enquanto a maior parte dos doentes registraram sentir algo.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Observamos que em aproximadamente 67% dos registros os indivíduos não sentiram dor no peito.
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
Por fim, verificamos que cerca de 24.4% dos indivíduos apresenta dor no peito induzida por execícios e efetivamente possui doenças cardíacas.
3.3.11 Variável oldpeak¶
# Definindo o nome da variável a ser analisada.
col <- 'oldpeak'
# Criando um gráfico de densidade para a variável especificada.
densityPlot(col, data)
Podemos ver uma clara diferença entre a distribuição desta medida de anormalidade nos eletrocardiogramas entre o conjunto de indivíduos sadios e os doentes.
# Criando um gráfico de boxplot para a variável especificada.
boxPlot(col, data)
Descobrimos a existência de outliers dentro dos conjuntos.
Note que esta medida de anormalidade tende a se concentrar próximo de um valor quando analisamos o conjunto de indivíduos saudáveis.
Quanto estudamos o conjunto de dados de pessoas doentes vemos que esta medida tende a variar muito mais.
# Calculando algumas estatísticas para a variável especificada.
varStats(col, data)
Concluímos destacando a diferença entre os valores medianos dos conjuntos e os altos índices de Assimetria e Curtose do grupo de indivíduos sem doenças.
3.3.12 Variável slope_of_the_peak¶
# Definindo o nome da variável a ser analisada.
col <- 'slope_of_the_peak'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
Bom, o gráfico nos indica que a inclinação do segmento ST do pico do exercício e predominantemente 1 quando o indivíduo é sadio e 2 ou 3 quando apresenta alguma doença.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
A maior parte dos registros apresentam uma inclinação do segmento ST do pico do exercício com valor 1 ou 2.
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
3.3.13 Variável number_of_major_vessels¶
# Definindo o nome da variável a ser analisada.
col <- 'number_of_major_vessels'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
O gráfico gerado por está variável é bem interessante! Veja que a medida que o número de vasos principais coloridos por flourosopy aumenta, a proporção de indivíduos saudáveis diminuiu drasticamente.
Vemos isso ao analisar a coluna 0 e a coluna 1. Quando não há vasos principais coloridos por flourosopy o conjunto de dados é predominantemente de indivíduos sem doenças. Mas, basta que um vaso seja colorido para que essa predominância mude e os indivíduos com doenças passem a se destacar.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Temos em aproximadamente 59.26% dos registros indivíduos que não possuem vasos coloridos por flourosopy.
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
Veja atentamente está tabela!
Quando o número de vasos principais coloridos por flourosopy é 0, a proporção de indivíduos sadios é 3 vezes maior do que a de doentes.
Quando o número de vasos principais coloridos por flourosopy é 1, a predominância muda e a proporção de indivíduos doentes se torna 2 vezes maior do que a dos sadios.
3.3.14 Variável thal¶
# Definindo o nome da variável a ser analisada.
col <- 'thal'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
Detectamos que predominantemente a maior parte dos indivíduos saudáveis apresenta um resutlado normal para o teste de stress com tálio. Porém, quando o resultado é um defeito fixo ou um defeito reversível a predominância é de indivíduos com problemas cardíacos.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Cerca de 56.3% dos registros dos indivíduos apresentou um resultado normal.
# Verificando a distribuição de registros entre as classes da variável especificada agrupadas pela variável alvo.
stats$variableClassesGroupedByTargetVariable
3.3.15 Variável heart_disease¶
# Definindo o nome da variável a ser analisada.
col <- 'heart_disease'
# Criando um gráfico de barras para a variável especificada.
barPlot(col, data)
Detectamos um desbalanceamento entre as classes da variável preditora.
# Calculando algumas estatísticas para a variável especificada.
stats <- varStats(col, data)
# Verificando a distribuição de registros entre as classes da variável.
stats$variableClasses
Deveremos tratar este desbalanceamento antes de prosseguir para a análise preditiva.
4. Feature Engineering¶
4.1 Importando bibliotecas necessárias¶
Importaremos todas as bilbiotecas necessárias para a realização das etapas de modelagem preditiva.
# Caso não possua uma das bibliotecas importadas abaixo, a instale com o comando a seguir:
install.packages(c(
'xgboost',
'MLmetrics',
'ROSE',
'DMwR',
'caret',
'randomForest',
'C50',
'fastAdaboost',
'data.table',
'neuralnet'
))
# Importando bibliotecas.
library(xgboost)
library(MLmetrics)
library(caret)
library(randomForest)
library(C50)
library(fastAdaboost)
library(ROSE)
library(DMwR)
library(neuralnet)
library(data.table)
4.2 Preparando dados para modelagem preditiva¶
Muito bem, como a maior parte dos algoritmos de Machine Learning trabalham melhor com variáveis númericas, iremos criar uma nova cópia do conjunto de dados sem qualquer uma das modificações que implementamos para executar a fase de exploração de dados.
# Carregando dataset não modificado.
data <- dataset
Na fase de exploração dos dados pudemos observar que as variáveis oldpeak, resting_blood_pressure e serum_cholestoral possuem uma assimetria à direita muita acentuada e isso pode atrapalhar a criação dos nossos modelos.
Para contornar este problema de distorção nos dados usaremos a função de transformação log1p (ou log(x + 1)) na variável oldpeak e a função de tranformação log nas outras duas variáveis com o objetivo de diminuir a irregularidade nos dados e tornar os padrões que apresentam mais visíveis.
Para mais informações sobre como a função log atua sobre dados distorcidos consulte este link. Para entender melhor a função log1p consulte este link.
Destacamos que o principal motivo de utilizarmos a função log1p é há existência de valores nulos dentro dos dados da variável oldpeak o que inviabiliza o uso da função log pois o log(0) é um valor indefinido.
# Aplicando a função de transformação log1p aos valores da variável oldpeak.
data$oldpeak <- log1p(data$oldpeak)
# Aplicando a função de transformação log aos valores da variável resting_blood_pressure.
data$resting_blood_pressure <- log(data$resting_blood_pressure)
# Aplicando a função de transformação log aos valores da variável serum_cholestoral.
data$serum_cholestoral <- log(data$serum_cholestoral)
A próxima etapa que iremos efetuar é a de escalar os valores das variáveis preditoras entre 0 e 1.
# Definindo método de pré-processamento.
params <- preProcess(data %>% select(- heart_disease), method = 'range')
# Transformando os dados.
data <- predict(params, data)
# Visualizando as primeiras linhas do dataset.
head(data)
Como estamos trabalhando com um problema de classificação, converteremos a variável a ser prevista para o tipo factor. Caso algum algoritmo solicite um ajuste específico para utilizar o conjunto de dados, faremos a modificação de forma temporária para gerar o modelo em questão e não alterar as variáveis do dataset.
# Convertendo a variável a ser prevista para o tipo factor.
data$heart_disease <- as.factor(data$heart_disease)
5. Modelagem Preditiva¶
5.1 Criando dados de treino e de teste¶
Para iniciar a modelagem preditiva, devemos criar os dados de treino e de teste.
# Definindo um seed.
set.seed(100)
# Criando as partições com dados de treino e de teste.
inTrain <- createDataPartition(data$heart_disease, p = .90, list = F)
# Segmentando dados de treino e de teste por partição.
train <- data[inTrain, ]
test <- data[-inTrain, ]
5.2 Criando funções de busca dos melhores parâmetros para os modelos a serem criados¶
Como não sabemos qual o algoritmo mais adequado para realizar as previsões para o nosso problema nem que valores utilizar em suas configurações, criaremos funções que gerem diferentes modelos com diferentes ajustes baseados nos seguintes algoritmos: Random Forest, C 5.0, Adaboost, XGboost e Neuralnet.
Adotando esta estratégia conseguiremos extrair a melhor performance de cada um dos algoritmos a serem implementados.
5.2.1 Modelo Random Forest¶
Note que está função também tem a capaciade de avaliar a importância de cada variável preditora a ser utilizada no modelo.
# Definindo uma função para gerar diferentes modelos com diferentes valores de parametrização baseados no algoritmo
# Random Forest.
getBetterRandomForestParameters <- function(train, f, test = NULL, positive = NULL, nTree = 1:100, nNode = 1:100,
importance = F, statusPrint = F) {
# Criando o dataframe para salvar os resultados dos modelos.
featuresRF <- data.frame()
# Define o número total de modelos a serem criados.
total <- length(nTree) * length(nNode)
# Capturando o nome da variável a ser prevista.
target <- as.character(f[[2]])
# Define uma varíavel auxiliar para permitir o acompanhamento do progresso na avaliação dos modelos criados.
count <- 0
for(t in nTree) {
for(n in nNode) {
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Cria o modelo Random Forest a ser avaliado.
model <- randomForest(
formula = f,
data = train,
ntree = t,
nodesize = n,
importance = importance
)
# Determina a Confusion Matrix para a avaliação de importância das variáveis preditoras ou para realizar
# previsões.
if(importance) {
# Computa a Confusion Matrix gerada a partir do modelo criado para determinar a importância das variáveis.
cm <- confusionMatrix(table(
data = model$y,
reference = model$predicted
),
positive = positive
)
# Armazena os parâmetros utilizados para criação do modelo e a acurácia obtida no dataframe.
featuresRF <- rbind(featuresRF, data.frame(
nodes = n,
nTree = t,
accuracy = unname(cm$overall['Accuracy'])
))
} else {
# Realizando as previsões com o modelo baseado no algoritmo Random Forest.
pred <- predict(model, test)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(pred = pred, data = test[ , target]), positive = positive)
# Armazena os parâmetros utilizados para criação do modelo, a acurácia e o score da métrica Logloss
# obtidos no dataframe.
featuresRF <- rbind(featuresRF, data.frame(
nodes = n,
nTree = t,
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(predict(model, test, type = 'prob')[, positive], as.integer(test[, target]) - 1)
))
}
# Incrementa o número de modelos avaliados.
count <- count + 1
# Imprime a porcetagem de progresso do treinamento e a melhor acurácia ou valor da métrica logloss já alcançada.
if(statusPrint) {
if(importance) {
print(paste(100 * count / total, '%, best accuracy: ', max(featuresRF$accuracy)))
} else {
print(paste(100 * count / total, '%, best LogLoss: ', min(featuresRF$logloss)))
}
}
}
}
# Retorna o dataframe com os resultados obtidos pelo treinamento de cada modelo.
featuresRF
}
5.2.2 Modelo C 5.0¶
# Definindo uma função para gerar diferentes modelos com diferentes valores de parametrização baseados no algoritmo C 5.0.
getBetterC50Parameters <- function(train, test, cost, f, positive, trials = 1:100, statusPrint = F) {
# Criando o dataframe para salvar os resultados dos modelos.
featuresC50 <- data.frame()
# Define o número total de modelos a serem criados.
total <- length(trials)
# Capturando o nome da variável a ser prevista.
target <- as.character(f[[2]])
# Define uma varíavel auxiliar para permitir o acompanhamento do progresso na avaliação dos modelos criados.
count <- 0
for(t in trials) {
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo C 5.0.
model_c50 <- C5.0(
formula = f,
data = train,
trials = t,
rules = T,
cost = cost,
control = C5.0Control(
winnow = T,
noGlobalPruning = T,
earlyStopping = T
)
)
# Realizando as previsões com o modelo baseado no algoritmo C 5.0.
pred <- predict(model_c50, test)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(pred = pred, data = test[ , target]), positive = positive)
# Armazena os parâmetros utilizados para criação do modelo, a acurácia e o score da métrica Logloss obtidos no
#dataframe.
featuresC50 <- rbind(featuresC50, data.frame(
trials = t,
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(predict(model_c50, test, type = 'prob')[ , positive], as.integer(test[, target]) - 1)
))
# Incrementa o número de modelos avaliados.
count <- count + 1
# Imprime a porcetagem de progresso do treinamento e o melhor valor da métrica logloss já alcançado.
if(statusPrint) {
print(paste(100 * count / total, '%, best LogLoss: ', min(featuresC50$logloss)))
}
}
# Retorna o dataframe com os resultados obtidos pelo treinamento de cada modelo.
featuresC50
}
5.2.3 Modelo Adaboost¶
# Definindo uma função para gerar diferentes modelos com diferentes valores de parametrização baseados no algoritmo
# Adaboost.
getBetterAdaboostParameters <- function(train, test, f, positive, nIters = 1:100, treeDepth = 3, statusPrint = F) {
# Criando o dataframe para salvar os resultados dos modelos.
featuresAdaboost <- data.frame()
# Define o número total de modelos a serem criados.
total <- length(nIters) * length(treeDepth)
# Capturando o nome da variável a ser prevista.
target <- as.character(f[[2]])
# Define uma varíavel auxiliar para permitir o acompanhamento do progresso na avaliação dos modelos criados.
count <- 0
for(n in nIters) {
for(t in treeDepth) {
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo Adaboost.
model_adaboost <- adaboost(
formula = f,
data = train,
nIter = n,
tree_depth = t
)
# Realizando as previsões com o modelo baseado no algoritmo Adaboost.
pred <- predict(model_adaboost, test, type = 'class')
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(pred = pred$class, data = test[ , target]), positive = positive)
# Armazena os parâmetros utilizados para criação do modelo, a acurácia e o score da métrica Logloss obtidos
# no dataframe.
featuresAdaboost <- rbind(featuresAdaboost, data.frame(
nIter = n,
treeDepth = t,
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(predict(model_adaboost, test, type = 'raw')$votes[, 2], as.integer(test[, target]) - 1)
))
# Incrementa o número de modelos avaliados.
count <- count + 1
# Imprime a porcetagem de progresso do treinamento e o melhor valor da métrica logloss já alcançado.
if(statusPrint) {
print(paste(100 * count / total, '%, best LogLoss: ', min(featuresAdaboost$logloss)))
}
}
}
# Retorna o dataframe com os resultados obtidos pelo treinamento de cada modelo.
featuresAdaboost
}
5.2.4 Modelo XGboost¶
# Definindo uma função para gerar diferentes modelos com diferentes valores de parametrização baseados no algoritmo XGboost.
getBetterXGboostParameters <- function(train, trainTarget, test, testTarget, maxDepth = 1:10, nEta = seq(0.1, 1, 0.1),
nRounds = 1:100, threshold = 0.5, statusPrint = F) {
# Criando o dataframe para salvar os resultados dos modelos.
featuresXGboost <- data.frame()
# Define o número total de modelos a serem criados.
total <- length(maxDepth) * length(nEta) * length(nRounds)
# Define uma varíavel auxiliar para permitir o acompanhamento do progresso na avaliação dos modelos criados.
count <- 0
for(m in maxDepth) {
for(e in nEta) {
for(r in nRounds) {
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo XGboost.
model_xgboost <- xgboost(
data = train, # Define as variáveis preditoras.
label = trainTarget, # Define a variável target.
max.depth = m, # Define o tamanho máximo da árvore.
eta = e, # Define a taxa de aprendizado do modelo.
nthread = 16, # Define o número de threads que devem ser usadas.
# Quanto maior for esse número, mais rápido será o treinamento.
nrounds = r, # Define o número de iterações.
objective = "binary:logistic", # Define que o modelo deve ser baseado em uma regressão
# logistica binária.
verbose = F, # Define a exibição da queda da taxa de erro durante o treinamento.
eval_metric = 'logloss', # Define a função de avaliação a ser utilizada.
maximize = F # Define que a pontuação da avaliação deve ser minimizada.
)
# Realizando as previsões com o modelo baseado no algoritmo XGboost.
pred <- predict(model_xgboost, test)
# Definindo o threshold.
for(th in threshold) {
# Classificando os resultados segundo o threshold especificado.
predClass <- ifelse(pred > th, 1, 0)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(
pred = factor(predClass, levels = c(0, 1)),
data = factor(testTarget, levels = c(0, 1))
),
positive = '1'
)
# Armazena os parâmetros utilizados para criação do modelo, a acurácia e o score da métrica Logloss
# obtidos no dataframe.
featuresXGboost <- rbind(featuresXGboost, data.frame(
maxDepth = m,
th = th,
eta = e,
nRounds = r,
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(as.numeric(pred), testTarget)
))
}
# Incrementa o número de modelos avaliados.
count <- count + 1
# Imprime a porcetagem de progresso do treinamento e a melhor acurácia já alcançada.
if(statusPrint) {
print(paste(100 * count / total, '%, best LogLoss: ', min(featuresXGboost$logloss)))
}
}
}
}
# Retorna o dataframe com os resultados obtidos pelo treinamento de cada modelo.
featuresXGboost
}
5.2.5 Modelo Neuralnet¶
# Definindo uma função para gerar diferentes modelos com diferentes valores de parametrização baseados no algoritmo
# Neuralnet.
getBetterNNParameters <- function(train, test, f, neurons = 1:100, thresholdModel = seq(0.05, 1, 0.05),
thresholdClass = 0.5, statusPrint = F) {
# Criando o dataframe para salvar os resultados dos modelos.
featuresNN <- data.frame()
# Define o número total de modelos a serem criados.
total <- length(neurons) * length(thresholdModel)
# Capturando o nome da variável a ser prevista.
target <- as.character(f[[2]])
# Define uma varíavel auxiliar para permitir o acompanhamento do progresso na avaliação dos modelos criados.
count <- 0
for(n in neurons) {
for(r in thresholdModel) {
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo Neuralnet.
nn <- neuralnet(
formula = f,
data = train,
hidden = n,
act.fct = "logistic",
stepmax = 1e+08,
linear.output = FALSE,
threshold = r
)
# Captura score da acurácia e da métrica Logloss para o modelo criado.
metrics = tryCatch({
# Realiza a previsão para os dados de treino com o modelo criado.
pred <- predict(nn, test)
for(th in thresholdClass) {
# Classificando os resultados segundo o threshold especificado.
predClass <- ifelse(pred > th, 1, 0)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(
pred = factor(predClass, levels = c(0, 1)),
data = factor(test[, target], levels = c(0, 1))
),
positive = '1'
)
# Adiciona a configuração e os resultados obtidos pelo modelo avaliado ao dataframe.
featuresNN <- rbind(featuresNN, data.frame(
n = n,
thresholdModel = r,
thresholdClass = th,
Accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(pred, test[, target])
))
}
}, error = function(e) {
# Caso a rede neural não consiga convergir, retorna o valor NA para o score da acurácia e
# da métrica Logloss para o modelo criado.
featuresNN <- rbind(featuresNN, data.frame(
n = n,
thresholdModel = r,
thresholdClass = th,
Accuracy = NA,
logloss = NA
))
})
# Incrementa o número de modelos avaliados.
count <- count + 1
# Imprime a porcetagem de progresso do treinamento e a melhor acurácia já alcançada.
if(statusPrint) {
print(paste(100 * count / total, '%, best LogLoss: ', min(featuresNN$logloss)))
}
}
}
# Eliminando resultados de modelos que não convergiram.
featuresNN <- featuresNN[!is.na(featuresNN$logloss), ]
# Retorna o dataframe com os resultados obtidos pelo treinamento de cada modelo.
featuresNN
}
5.3 Avaliando a importância das variáveis com o algoritmo Random Forest¶
Antes de iniciarmos a criação dos modelos propriamente dita, é interessante definirmos o quanto cada variável dentro do dataset ajuda a prever o valor da variável target.
Para fazermos isto, utilizaremos o algoritmo Random Forest para computar tais valores. Como não sabemos qual o ajuste de parâmetros do algoritmo é mais adequado para o nosso conjunto de dados, criaremos modelos que possuam de 1 a 100 árvores com 1 a 100 nós.
Salvaremos a acurárica de cada modelo em um Dataframe. Note que por ser um processo de treinamento que tende a demandar muito tempo para ser processado, salvaremos os resultados obtidos em um arquivo CSV que pode ser carregado com todos os resultados gerados pelo bloco de código a seguir.
# Gerando diferentes modelos baseados no algoritmo Random Forest para avaliar a importância das variáveis preditoras
# no conjunto de dados.
impFeaturesRF <- getBetterRandomForestParameters(data, f = heart_disease ~ ., importance = T, statusPrint = T)
# Salvando dataframe com os resultados gerados em um arquivo .csv.
fwrite(impFeaturesRF, '/content/outputs/impFeaturesRF.csv')
Caso deseje pular a execução do bloco de código anterior, basta carregar os resultados já processados que estão salvos no arquivo CSV abaixo:
# Carregando dataframe com os resultados obtidos para cada modelo Random Forest criado.
impFeaturesRF <- fread('/content/outputs/impFeaturesRF.csv')
Imprimiremos os registros dos modelos que apresentaram a melhor acurácia.
# Imprimindo registros dos modelos que alcançaram a maior acurácia.
bestRF <- impFeaturesRF[impFeaturesRF$accuracy == max(impFeaturesRF$accuracy), ]
bestRF
Caso mais de um modelo apresente a maior acurácia registrada dentro do dataset, selecionaremos o primeiro que foi listado para ser utilizado nas etapas seguintes.
# Selecionando o primeiro registro dentro do dataframe.
bestRF <- bestRF[1,]
Recriaremos este modelo e imprimiremos suas estatísticas.
# Define um seed para permitir que o mesmo resultado do experimento seja reproduzível.
set.seed(100)
# Criando modelo.
model <- randomForest(
formula = heart_disease ~ .,
data = data,
ntree = bestRF$nTree,
nodesize = bestRF$nodes,
importance = T
)
# Imprimindo o modelo.
model
Agora podemos plotar o modelo em um gráfico e verificar o nível de importância das variáveis do dataset para prever a variável alvo.
# Plotando gráfico para visualizar o nível de importância de cada variável no processo de predição da variável alvo.
v <- as.data.frame(varImpPlot(model, main = 'Predictor variables'))
Também podemos mensurar numericamente o quanto cada variável auxilia no processo de predição da variável alvo.
# Captura em ordem decrescente de nível de importância o nome das variáveis.
names <- rownames(v[order(v[, 'MeanDecreaseAccuracy'], decreasing = T),])
# Imprime o resultado.
v[order(v[, 'MeanDecreaseAccuracy'], decreasing = T), ]
5.4 Feature Selection¶
Bom, vamos considerar a medida MeanDecreaseAccuracy calculada na fase anterior. Sabemos que as variáveis mais importantes para prever a variável alvo são aquelas que apresentam os maiores valores para esta grandeza.
Sendo assim, iremos eliminar as 3 variáveis que apresentaram o menor valor de importância. Como o gráfico anterior nos mostra, o nome destas variáveis preditoras são: serum_cholestoral, fasting_blood_sugar e resting_electro_results.
# Definindo um vetor com o nome das variáveis que devem ser desconsideras pelo modelo a ser treinado.
d <- c('fasting_blood_sugar', 'serum_cholestoral', 'resting_electro_results', 'heart_disease')
# Definindo fórmula a ser utilizada pelo modelo a ser treinado.
f <- heart_disease ~ . - fasting_blood_sugar - serum_cholestoral - resting_electro_results
5.5 Criando modelos¶
5.5.1 Modelo Random Forest¶
# Gerando diferentes modelos baseados no algoritmo Random Forest e determinando sua acurácia e score para a métrica LogLoss.
featuresRF <- getBetterRandomForestParameters(
train = train,
test = test,
f = f,
positive = '2',
statusPrint = T, nTree = 1:200, nNode = 1:200
)
# Salvando dataframe com os resultados gerados em um arquivo .csv.
fwrite(featuresRF, '/content/outputs/featuresRF.csv')
Caso deseje pular a execução do bloco de código anterior, basta carregar os resultados já processados que estão salvos no arquivo CSV abaixo:
# Carregando dataframe com os resultados obtidos para cada modelo Random Forest criado.
featuresRF <- fread('/content/outputs/featuresRF.csv')
Imprimiremos os registros dos modelos que apresentaram o menor score para a métrica Logloss.
# Imprimindo registros dos modelos que alcançaram o menor score para a métrica Logloss.
bestRF <- featuresRF[featuresRF$logloss == min(featuresRF$logloss), ]
bestRF
Caso mais de um modelo apresente o menor score para a métrica Logloss registrado dentro do dataset, selecionaremos o primeiro que foi listado para ser utilizado nas etapas seguintes.
# Selecionando o primeiro registro dentro do dataframe.
bestRF <- bestRF[1,]
Recriaremos este modelo e imprimiremos suas estatísticas.
# Define um seed para permitir que o mesmo resultado do experimento seja reproduzível.
set.seed(100)
# Criando modelo.
model_rf <- randomForest(
formula = f,
data = train,
ntree = bestRF$nTree,
nodesize = bestRF$nodes
)
# Imprimindo o modelo.
model_rf
# Realizando as previsões com o modelo baseado no algoritmo Random Forest.
pred <- predict(model_rf, test)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(pred = pred, data = test$heart_disease), positive = '2')
# Visualizando a Confusion Matrix.
cm
Perfeito, nosso primeiro modelo foi criado! Vamos salvar os scores de sua acurácia e de sua métrica Logloss em um dataframe.
# Salvando scores das métricas analisadas em um dataframe.
scoreModels <- data.frame(
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(predict(model_rf, test, type = 'prob')[, '2'], as.integer(test$heart_disease) - 1),
row.names = 'randomForest'
)
5.5.2 Modelo C 5.0¶
# Definindo a matriz de custos a ser utilizada pelo modelo.
cost <- matrix(c(0, 1, 0.1, 0), nrow = 2, dimnames = list(c("No", "Yes"), c("No", "Yes")))
# Visualizando a matriz.
cost
# Gerando diferentes modelos baseados no algoritmo C 5.0 e determinando sua acurácia e score para a métrica LogLoss.
featuresC50 <- getBetterC50Parameters(
train = train,
test = test,
cost = cost,
f = f,
positive = '2',
statusPrint = T
)
# Salvando dataframe com os resultados gerados em um arquivo .csv.
fwrite(featuresC50, '/content/outputs/featuresC50.csv')
Caso deseje pular a execução do bloco de código anterior, basta carregar os resultados já processados que estão salvos no arquivo CSV abaixo:
# Carregando dataframe com os resultados obtidos para cada modelo C 5.0 criado.
featuresC50 <- fread('/content/outputs/featuresC50.csv')
Imprimiremos os registros dos modelos que apresentaram o menor score para a métrica Logloss.
# Imprimindo registros dos modelos que alcançaram o menor score para a métrica Logloss.
bestC50 <- featuresC50[featuresC50$logloss == min(featuresC50$logloss), ]
bestC50
Caso mais de um modelo apresente o menor score para a métrica Logloss registrado dentro do dataset, selecionaremos o primeiro que foi listado para ser utilizado nas etapas seguintes.
# Selecionando o primeiro registro dentro do dataframe.
bestC50 <- bestC50[1,]
Recriaremos este modelo e imprimiremos suas estatísticas.
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo C 5.0.
model_c50 <- C5.0(
form = f,
data = train,
trials = bestC50$trials,
rules = T,
cost = cost,
control = C5.0Control(
winnow = T,
noGlobalPruning = T,
earlyStopping = T
)
)
# Realizando as previsões com o modelo baseado no algoritmo C 5.0.
pred <- predict(model_c50, test)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(pred = pred, data = test$heart_disease), positive = '2')
# Visualizando a Confusion Matrix.
cm
# Salvando scores das métricas analisadas em um dataframe.
scoreModels <- rbind(scoreModels, data.frame(
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(predict(model_c50, test, type = 'prob')[ , '2'], as.integer(test$heart_disease) - 1),
row.names = 'C5.0'
))
5.5.3 Modelo Adaboost¶
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Gerando diferentes modelos baseados no algoritmo Adaboost e determinando sua acurácia e score para a métrica LogLoss.
featuresAdaboost <- getBetterAdaboostParameters(
train = train,
test = test,
f = f,
positive = '2',
statusPrint = T
)
# Salvando dataframe com os resultados gerados em um arquivo .csv.
fwrite(featuresAdaboost, '/content/outputs/featuresAdaboost.csv')
Caso deseje pular a execução do bloco de código anterior, basta carregar os resultados já processados que estão salvos no arquivo CSV abaixo:
# Carregando dataframe com os resultados obtidos para cada modelo Adaboost criado.
featuresAdaboost <- fread('/content/outputs/featuresAdaboost.csv')
Imprimiremos os registros dos modelos que apresentaram o menor score para a métrica Logloss.
# Imprimindo registros dos modelos que alcançaram o menor score para a métrica Logloss.
bestAdaboost <- featuresAdaboost[featuresAdaboost$logloss == min(featuresAdaboost$logloss), ]
bestAdaboost
Caso mais de um modelo apresente o menor score para a métrica Logloss registrado dentro do dataset, selecionaremos o primeiro que foi listado para ser utilizado nas etapas seguintes.
# Selecionando o primeiro registro dentro do dataframe.
bestAdaboost <- bestAdaboost[1,]
Recriaremos este modelo e imprimiremos suas estatísticas.
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo Adaboost.
model_adaboost <- adaboost(
formula = f,
data = train,
nIter = bestAdaboost$nIter
)
# Realizando as previsões com o modelo baseado no algoritmo Adaboost.
pred <- predict(model_adaboost, test, type = 'class')
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(pred = pred$class, data = test$heart_disease), positive = '2')
# Visualizando a Confusion Matrix.
cm
# Salvando scores das métricas analisadas em um dataframe.
scoreModels <- rbind(scoreModels, data.frame(
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(predict(model_adaboost, test, type = 'raw')$votes[, 2], as.integer(test$heart_disease) - 1),
row.names = 'adaboost'
))
5.5.4 Modelo XGboost¶
# Gerando diferentes modelos baseados no algoritmo Adaboost e determinando sua acurácia e score para a métrica LogLoss.
featuresXGboost <- getBetterXGboostParameters(
train = as.matrix(train %>% select(-d)),
trainTarget = as.integer(train$heart_disease) - 1,
test = as.matrix(test %>% select(-d)),
testTarget = as.integer(test$heart_disease) - 1,
statusPrint = T
)
# Salvando dataframe com os resultados gerados em um arquivo .csv.
fwrite(featuresXGboost, '/content/outputs/featuresXGboost.csv')
Caso deseje pular a execução do bloco de código anterior, basta carregar os resultados já processados que estão salvos no arquivo CSV abaixo:
# Carregando dataframe com os resultados obtidos para cada modelo XGboost criado.
featuresXGboost <- fread('/content/outputs/featuresXGboost.csv')
Imprimiremos os registros dos modelos que apresentaram o menor score para a métrica Logloss.
# Imprimindo registros dos modelos que alcançaram o menor score para a métrica Logloss.
bestXGboost <- featuresXGboost[featuresXGboost$logloss == min(featuresXGboost$logloss), ]
bestXGboost
Caso mais de um modelo apresente o menor score para a métrica Logloss registrado dentro do dataset, selecionaremos o primeiro que foi listado para ser utilizado nas etapas seguintes.
# Selecionando o primeiro registro dentro do dataframe.
bestXGboost <- bestXGboost[1,]
Recriaremos este modelo e imprimiremos suas estatísticas.
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo XGboost.
model_xgboost <- xgboost(
data = as.matrix(train %>% select(-d )) , # Define as variáveis preditoras.
label = as.integer(train$heart_disease) - 1, # Define a variável target.
max.depth = bestXGboost$maxDepth, # Define o tamanho máximo da árvore.
eta = bestXGboost$eta, # Define a taxa de aprendizado do modelo.
nthread = 16, # Define o número de threads que devem ser usadas.
# Quanto maior for esse número, mais rápido será o treinamento.
nrounds = bestXGboost$nRounds, # Define o número de iterações.
objective = "binary:logistic", # Define que o modelo deve ser baseado em uma regressão logistica binária.
verbose = T, # Define a exibição da queda da taxa de erro durante o treinamento.
eval_metric = 'logloss', # Define a função de avaliação a ser utilizada.
maximize = F # Define que a pontuação da avaliação deve ser minimizada.
)
# Realizando as previsões com o modelo baseado no algoritmo XGboost.
pred <- predict(model_xgboost, as.matrix(test %>% select(-d)))
# Definindo o threshold.
th <- bestXGboost$th
# Classificando os resultados segundo o threshold especificado.
predClass <- ifelse(pred > th, 1, 0)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(pred = predClass, data = as.integer(test$heart_disease) - 1), positive = '1')
# Visualizando a Confusion Matrix.
cm
# Salvando scores das métricas analisadas em um dataframe.
scoreModels <- rbind(scoreModels, data.frame(
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(as.numeric(pred), as.matrix(as.integer(test$heart_disease) - 1)),
row.names = 'XGboost'
))
5.5.5 Modelo Neuralnet¶
# Gerando diferentes modelos baseados no algoritmo Neuralnet e determinando sua acurácia e score para a métrica LogLoss.
featuresNN <- getBetterNNParameters(
train = train %>% mutate(heart_disease = as.integer(train$heart_disease) - 1),
test = test %>% mutate(heart_disease = as.integer(test$heart_disease) - 1),
f = f,
statusPrint = T
)
# Salvando dataframe com os resultados gerados em um arquivo .csv.
fwrite(featuresNN, '/content/outputs/featuresNN.csv')
Caso deseje pular a execução do bloco de código anterior, basta carregar os resultados já processados que estão salvos no arquivo CSV abaixo:
# Carregando dataframe com os resultados obtidos para cada modelo Neuralnet criado.
featuresNN <- fread('/content/outputs/featuresNN.csv')
Imprimiremos os registros dos modelos que apresentaram o menor score para a métrica Logloss.
# Imprimindo registros dos modelos que alcançaram o menor score para a métrica Logloss.
bestNN <- featuresNN[featuresNN$logloss == min(featuresNN$logloss), ]
bestNN
Caso mais de um modelo apresente o menor score para a métrica Logloss registrado dentro do dataset, selecionaremos o primeiro que foi listado para ser utilizado nas etapas seguintes.
# Selecionando o primeiro registro dentro do dataframe.
bestNN <- bestNN[1,]
Recriaremos este modelo e imprimiremos suas estatísticas.
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Criando o modelo baseado no algoritmo Neuralnet
nn <- neuralnet(
formula = f,
data = train %>% mutate(heart_disease = as.integer(train$heart_disease) - 1),
hidden = bestNN$n,
act.fct = "logistic",
stepmax = 1e+08,
linear.output = FALSE,
threshold = bestNN$thresholdModel
)
# Realizando as previsões com o modelo baseado no algoritmo Neuralnet.
pred <- predict(nn, test %>% mutate(heart_disease = as.integer(test$heart_disease) - 1))
# Definindo o threshold.
th <- bestNN$thresholdClass
# Classificando os resultados segundo o threshold especificado.
predClass <- ifelse(pred > th, 1, 0)
# Criando a Confusion Matrix a partir das previsões.
cm <- confusionMatrix(table(
pred = predClass,
data = as.integer(test$heart_disease) - 1
),
positive = '1'
)
# Visualizando a Confusion Matrix.
cm
# Salvando scores das métricas analisadas em um dataframe.
scoreModels <- rbind(scoreModels, data.frame(
accuracy = unname(cm$overall['Accuracy']),
logloss = LogLoss(pred, as.integer(test$heart_disease) - 1),
row.names = 'Neuralnet'
))
5.6 Determinando o melhor modelo¶
Determinaremos qual modelo teve o melhor desempenho para o conjunto de dados de teste a partir do score da métrica LogLoss.
A métrica LogLoss quantifica a precisão de um classificador penalizando classificações falsas. Quando minimizamos seu score estamos basicamente maximizando a precisão do modelo. Ou seja, o modelo que apresentar o menor valor para esta métrica será aquele que irá classificar corretamente a maior proporção de pacientes que efetivamente apresentam alguma doença cardíaca.
É interessante refletir sobre isso, pois não queremos classificar indivíduos saudáveis como doentes e submetê-los a tramentos desnecessários, caros ou até mesmo prejudiciais a saúde de pessoas sãs.
# Exibindo dataframe com as métricas de performance dos melhores modelos treinados com cada algoritmo implementado.
scoreModels
# Determinando o modelo que teve o melhor score para a métrica LogLoss.
scoreModels[scoreModels$logloss == min(scoreModels$logloss), ]
Por fim, concluímos que o algoritmo que obteve a melhor performance para os critérios que adotamos foi o Random Forest.
Entre em contato comigo!¶
Caso tenha alguma dúvida, sugestão ou apenas queira trocar uma ideia sobre este projeto, não hesite em entrar em contato comigo!
