Análise dos Dados de Coronavírus do Hospital Albert Einstein: 90% de Acurácia e Porque isso é Ruim

Introdução

Recentemente, o Hospital Albert Einstein compartilhou um conjunto de dados com observações de 5644 pacientes. Os dados possuem 111 características relacionadas a exames médicos, como sangue, urina e muito mais. A tarefa que me propus a resolver foi classificar os pacientes testados em dois grupos, aqueles que posssuem e aqueles que não possuem coronavírus. Farei isso a partir a partir dos resultados dos exames laboratoriais, sem utilizar informação alguma sobre o diagnóstico realizado em relação à contaminação do vírus.

Caso a técnica utilizada neste posto não tenha ficado muito clara, recomendo a leitura do meu post Tutorial: Como Fazer o Seu Primeiro Projeto de Data Science, que mostra com mais detalhes como ajustar o modelo random forest a um conjunto de dados.

Os dados utilizados aqui, bem como o código utilizado nesta análise, estão disponíveis em meu github.

Análise Exploratória dos Dados

O primeiro passo em qualquer análise de dados é a análise exploratória. É possível gerar ideias e insights apenas olhando para os dados plotados. Vou começar minha análise exploratória carregando alguns pacotes no R:

library(tidyverse)
theme_set(theme_bw())
library(naniar)
library(readxl)
library(caret)
library(reshape2)
library(GGally)
library(mice)

Com os pacotes carregados, vou ler os dados e realizar pequenas correções neles. Cada passo a seguir foi explicado com um comentário dentro do próprio código.

dataset <- read_excel(path = "data/dataset.xlsx")

# fix column names

names(dataset) <- make.names(names(dataset), unique = TRUE)

#################################
### exploratory data analysis ###
#################################

# first look at the dataset

glimpse(dataset)
## Rows: 5,644
## Columns: 111
## $ Patient.ID                                            <chr> "44477f75e8169d…
## $ Patient.age.quantile                                  <dbl> 13, 17, 8, 5, 1…
## $ SARS.Cov.2.exam.result                                <chr> "negative", "ne…
## $ Patient.addmited.to.regular.ward..1.yes..0.no.        <dbl> 0, 0, 0, 0, 0, …
## $ Patient.addmited.to.semi.intensive.unit..1.yes..0.no. <dbl> 0, 0, 0, 0, 0, …
## $ Patient.addmited.to.intensive.care.unit..1.yes..0.no. <dbl> 0, 0, 0, 0, 0, …
## $ Hematocrit                                            <dbl> NA, 0.2365154, …
## $ Hemoglobin                                            <dbl> NA, -0.02234027…
## $ Platelets                                             <dbl> NA, -0.51741302…
## $ Mean.platelet.volume                                  <dbl> NA, 0.01067657,…
## $ Red.blood.Cells                                       <dbl> NA, 0.1020042, …
## $ Lymphocytes                                           <dbl> NA, 0.318365753…
## $ Mean.corpuscular.hemoglobin.concentration..MCHC.      <dbl> NA, -0.9507903,…
## $ Leukocytes                                            <dbl> NA, -0.09461035…
## $ Basophils                                             <dbl> NA, -0.22376651…
## $ Mean.corpuscular.hemoglobin..MCH.                     <dbl> NA, -0.29226932…
## $ Eosinophils                                           <dbl> NA, 1.4821582, …
## $ Mean.corpuscular.volume..MCV.                         <dbl> NA, 0.1661924, …
## $ Monocytes                                             <dbl> NA, 0.35754666,…
## $ Red.blood.cell.distribution.width..RDW.               <dbl> NA, -0.6250727,…
## $ Serum.Glucose                                         <dbl> NA, -0.1406481,…
## $ Respiratory.Syncytial.Virus                           <chr> NA, "not_detect…
## $ Influenza.A                                           <chr> NA, "not_detect…
## $ Influenza.B                                           <chr> NA, "not_detect…
## $ Parainfluenza.1                                       <chr> NA, "not_detect…
## $ CoronavirusNL63                                       <chr> NA, "not_detect…
## $ Rhinovirus.Enterovirus                                <chr> NA, "detected",…
## $ Mycoplasma.pneumoniae                                 <lgl> NA, NA, NA, NA,…
## $ Coronavirus.HKU1                                      <chr> NA, "not_detect…
## $ Parainfluenza.3                                       <chr> NA, "not_detect…
## $ Chlamydophila.pneumoniae                              <chr> NA, "not_detect…
## $ Adenovirus                                            <chr> NA, "not_detect…
## $ Parainfluenza.4                                       <chr> NA, "not_detect…
## $ Coronavirus229E                                       <chr> NA, "not_detect…
## $ CoronavirusOC43                                       <chr> NA, "not_detect…
## $ Inf.A.H1N1.2009                                       <chr> NA, "not_detect…
## $ Bordetella.pertussis                                  <chr> NA, "not_detect…
## $ Metapneumovirus                                       <chr> NA, "not_detect…
## $ Parainfluenza.2                                       <chr> NA, "not_detect…
## $ Neutrophils                                           <dbl> NA, -0.6190860,…
## $ Urea                                                  <dbl> NA, 1.19805908,…
## $ Proteina.C.reativa.mg.dL                              <dbl> NA, -0.1478949,…
## $ Creatinine                                            <dbl> NA, 2.0899284, …
## $ Potassium                                             <dbl> NA, -0.3057871,…
## $ Sodium                                                <dbl> NA, 0.8625116, …
## $ Influenza.B..rapid.test                               <chr> NA, "negative",…
## $ Influenza.A..rapid.test                               <chr> NA, "negative",…
## $ Alanine.transaminase                                  <dbl> NA, NA, NA, NA,…
## $ Aspartate.transaminase                                <dbl> NA, NA, NA, NA,…
## $ Gamma.glutamyltransferase.                            <dbl> NA, NA, NA, NA,…
## $ Total.Bilirubin                                       <dbl> NA, NA, NA, NA,…
## $ Direct.Bilirubin                                      <dbl> NA, NA, NA, NA,…
## $ Indirect.Bilirubin                                    <dbl> NA, NA, NA, NA,…
## $ Alkaline.phosphatase                                  <dbl> NA, NA, NA, NA,…
## $ Ionized.calcium.                                      <dbl> NA, NA, NA, NA,…
## $ Strepto.A                                             <chr> NA, NA, NA, NA,…
## $ Magnesium                                             <dbl> NA, NA, NA, NA,…
## $ pCO2..venous.blood.gas.analysis.                      <dbl> NA, NA, NA, NA,…
## $ Hb.saturation..venous.blood.gas.analysis.             <dbl> NA, NA, NA, NA,…
## $ Base.excess..venous.blood.gas.analysis.               <dbl> NA, NA, NA, NA,…
## $ pO2..venous.blood.gas.analysis.                       <dbl> NA, NA, NA, NA,…
## $ Fio2..venous.blood.gas.analysis.                      <lgl> NA, NA, NA, NA,…
## $ Total.CO2..venous.blood.gas.analysis.                 <dbl> NA, NA, NA, NA,…
## $ pH..venous.blood.gas.analysis.                        <dbl> NA, NA, NA, NA,…
## $ HCO3..venous.blood.gas.analysis.                      <dbl> NA, NA, NA, NA,…
## $ Rods..                                                <dbl> NA, NA, NA, NA,…
## $ Segmented                                             <dbl> NA, NA, NA, NA,…
## $ Promyelocytes                                         <dbl> NA, NA, NA, NA,…
## $ Metamyelocytes                                        <dbl> NA, NA, NA, NA,…
## $ Myelocytes                                            <dbl> NA, NA, NA, NA,…
## $ Myeloblasts                                           <dbl> NA, NA, NA, NA,…
## $ Urine...Esterase                                      <chr> NA, NA, NA, NA,…
## $ Urine...Aspect                                        <chr> NA, NA, NA, NA,…
## $ Urine...pH                                            <chr> NA, NA, NA, NA,…
## $ Urine...Hemoglobin                                    <chr> NA, NA, NA, NA,…
## $ Urine...Bile.pigments                                 <chr> NA, NA, NA, NA,…
## $ Urine...Ketone.Bodies                                 <chr> NA, NA, NA, NA,…
## $ Urine...Nitrite                                       <chr> NA, NA, NA, NA,…
## $ Urine...Density                                       <dbl> NA, NA, NA, NA,…
## $ Urine...Urobilinogen                                  <chr> NA, NA, NA, NA,…
## $ Urine...Protein                                       <chr> NA, NA, NA, NA,…
## $ Urine...Sugar                                         <lgl> NA, NA, NA, NA,…
## $ Urine...Leukocytes                                    <chr> NA, NA, NA, NA,…
## $ Urine...Crystals                                      <chr> NA, NA, NA, NA,…
## $ Urine...Red.blood.cells                               <dbl> NA, NA, NA, NA,…
## $ Urine...Hyaline.cylinders                             <chr> NA, NA, NA, NA,…
## $ Urine...Granular.cylinders                            <chr> NA, NA, NA, NA,…
## $ Urine...Yeasts                                        <chr> NA, NA, NA, NA,…
## $ Urine...Color                                         <chr> NA, NA, NA, NA,…
## $ Partial.thromboplastin.time..PTT..                    <lgl> NA, NA, NA, NA,…
## $ Relationship..Patient.Normal.                         <dbl> NA, NA, NA, NA,…
## $ International.normalized.ratio..INR.                  <dbl> NA, NA, NA, NA,…
## $ Lactic.Dehydrogenase                                  <dbl> NA, NA, NA, NA,…
## $ Prothrombin.time..PT...Activity                       <lgl> NA, NA, NA, NA,…
## $ Vitamin.B12                                           <dbl> NA, NA, NA, NA,…
## $ Creatine.phosphokinase..CPK..                         <dbl> NA, NA, NA, NA,…
## $ Ferritin                                              <dbl> NA, NA, NA, NA,…
## $ Arterial.Lactic.Acid                                  <dbl> NA, NA, NA, NA,…
## $ Lipase.dosage                                         <lgl> NA, NA, NA, NA,…
## $ D.Dimer                                               <lgl> NA, NA, NA, NA,…
## $ Albumin                                               <dbl> NA, NA, NA, NA,…
## $ Hb.saturation..arterial.blood.gases.                  <dbl> NA, NA, NA, NA,…
## $ pCO2..arterial.blood.gas.analysis.                    <dbl> NA, NA, NA, NA,…
## $ Base.excess..arterial.blood.gas.analysis.             <dbl> NA, NA, NA, NA,…
## $ pH..arterial.blood.gas.analysis.                      <dbl> NA, NA, NA, NA,…
## $ Total.CO2..arterial.blood.gas.analysis.               <dbl> NA, NA, NA, NA,…
## $ HCO3..arterial.blood.gas.analysis.                    <dbl> NA, NA, NA, NA,…
## $ pO2..arterial.blood.gas.analysis.                     <dbl> NA, NA, NA, NA,…
## $ Arteiral.Fio2                                         <dbl> NA, NA, NA, NA,…
## $ Phosphor                                              <dbl> NA, NA, NA, NA,…
## $ ctO2..arterial.blood.gas.analysis.                    <dbl> NA, NA, NA, NA,…
# remove columns that won't help on diagnosis

dataset_clean <- dataset %>%
  select(-Patient.ID, 
         -Patient.addmited.to.regular.ward..1.yes..0.no.,
         -Patient.addmited.to.semi.intensive.unit..1.yes..0.no.,
         -Patient.addmited.to.intensive.care.unit..1.yes..0.no.)

# convert level Urine...Leukocytes <1000 to 1000

dataset_clean$Urine...Leukocytes[dataset_clean$`Urine...Leukocytes` == "<1000"] <- 1000
dataset_clean$`Urine...Leukocytes` <- as.numeric(dataset_clean$`Urine...Leukocytes`)

# fix Urine...pH

dataset_clean$`Urine...pH`[dataset_clean$`Urine...pH` == "Não Realizado"] <- NA
dataset_clean$`Urine...pH` <- as.numeric(dataset_clean$`Urine...pH`)

# Urine...Hemoglobin

dataset_clean$`Urine...Hemoglobin`[dataset_clean$`Urine...Hemoglobin` == "not_done"] <- NA

# Urine...Aspect

dataset_clean$`Urine...Aspect` <- factor(dataset_clean$`Urine...Aspect`, 
                                         levels = c("clear", "lightly_cloudy", "cloudy", "altered_coloring"))

# Strepto A

dataset_clean$`Strepto.A`[dataset_clean$`Strepto.A` == "not_done"] <- NA

# transform character to factor

dataset_clean_num <- dataset_clean %>%
  select_if(is.numeric)

dataset_clean_cat <- dataset_clean %>%
  select_if(negate(is.numeric)) %>%
  mutate_all(as.factor)

dataset_clean <- base::cbind(dataset_clean_num, dataset_clean_cat)

# fix factor levels

# sort(sapply(dataset_clean[,sapply(dataset_clean, is.factor)], nlevels))

Com os dados lidos e processados, eu dou uma olhada nos dados faltantes:

# let's take a look on missing data

missing_values <- dataset_clean %>%
  gather(key = "key", value = "val") %>%
  mutate(is.missing = is.na(val)) %>%
  group_by(key, is.missing) %>%
  summarise(num.missing = n()) %>%
  filter(is.missing == TRUE) %>%
  select(-is.missing) %>%
  ungroup() %>%
  mutate(key = reorder(key, -num.missing)) %>%
  arrange(desc(num.missing)) %>%
  print(n = Inf)
## Warning: attributes are not identical across measure variables;
## they will be dropped
## `summarise()` regrouping output by 'key' (override with `.groups` argument)
## # A tibble: 105 x 2
##     key                                              num.missing
##     <fct>                                                  <int>
##   1 D.Dimer                                                 5644
##   2 Mycoplasma.pneumoniae                                   5644
##   3 Partial.thromboplastin.time..PTT..                      5644
##   4 Prothrombin.time..PT...Activity                         5644
##   5 Urine...Sugar                                           5644
##   6 Fio2..venous.blood.gas.analysis.                        5643
##   7 Urine...Nitrite                                         5643
##   8 Vitamin.B12                                             5641
##   9 Lipase.dosage                                           5636
##  10 Albumin                                                 5631
##  11 Arteiral.Fio2                                           5624
##  12 Phosphor                                                5624
##  13 Ferritin                                                5621
##  14 Arterial.Lactic.Acid                                    5617
##  15 Base.excess..arterial.blood.gas.analysis.               5617
##  16 ctO2..arterial.blood.gas.analysis.                      5617
##  17 Hb.saturation..arterial.blood.gases.                    5617
##  18 HCO3..arterial.blood.gas.analysis.                      5617
##  19 pCO2..arterial.blood.gas.analysis.                      5617
##  20 pH..arterial.blood.gas.analysis.                        5617
##  21 pO2..arterial.blood.gas.analysis.                       5617
##  22 Total.CO2..arterial.blood.gas.analysis.                 5617
##  23 Magnesium                                               5604
##  24 Ionized.calcium.                                        5594
##  25 Urine...Ketone.Bodies                                   5587
##  26 Urine...Esterase                                        5584
##  27 Urine...Protein                                         5584
##  28 Urine...Hyaline.cylinders                               5577
##  29 Urine...Granular.cylinders                              5575
##  30 Urine...Hemoglobin                                      5575
##  31 Urine...pH                                              5575
##  32 Urine...Urobilinogen                                    5575
##  33 Urine...Aspect                                          5574
##  34 Urine...Bile.pigments                                   5574
##  35 Urine...Color                                           5574
##  36 Urine...Crystals                                        5574
##  37 Urine...Density                                         5574
##  38 Urine...Leukocytes                                      5574
##  39 Urine...Red.blood.cells                                 5574
##  40 Urine...Yeasts                                          5574
##  41 Relationship..Patient.Normal.                           5553
##  42 Metamyelocytes                                          5547
##  43 Myeloblasts                                             5547
##  44 Myelocytes                                              5547
##  45 Promyelocytes                                           5547
##  46 Rods..                                                  5547
##  47 Segmented                                               5547
##  48 Lactic.Dehydrogenase                                    5543
##  49 Creatine.phosphokinase..CPK..                           5540
##  50 International.normalized.ratio..INR.                    5511
##  51 Base.excess..venous.blood.gas.analysis.                 5508
##  52 Hb.saturation..venous.blood.gas.analysis.               5508
##  53 HCO3..venous.blood.gas.analysis.                        5508
##  54 pCO2..venous.blood.gas.analysis.                        5508
##  55 pH..venous.blood.gas.analysis.                          5508
##  56 pO2..venous.blood.gas.analysis.                         5508
##  57 Total.CO2..venous.blood.gas.analysis.                   5508
##  58 Alkaline.phosphatase                                    5500
##  59 Gamma.glutamyltransferase.                              5491
##  60 Direct.Bilirubin                                        5462
##  61 Indirect.Bilirubin                                      5462
##  62 Total.Bilirubin                                         5462
##  63 Serum.Glucose                                           5436
##  64 Alanine.transaminase                                    5419
##  65 Aspartate.transaminase                                  5418
##  66 Strepto.A                                               5313
##  67 Sodium                                                  5274
##  68 Potassium                                               5273
##  69 Urea                                                    5247
##  70 Creatinine                                              5220
##  71 Proteina.C.reativa.mg.dL                                5138
##  72 Neutrophils                                             5131
##  73 Mean.platelet.volume                                    5045
##  74 Monocytes                                               5043
##  75 Basophils                                               5042
##  76 Eosinophils                                             5042
##  77 Leukocytes                                              5042
##  78 Lymphocytes                                             5042
##  79 Mean.corpuscular.hemoglobin..MCH.                       5042
##  80 Mean.corpuscular.hemoglobin.concentration..MCHC.        5042
##  81 Mean.corpuscular.volume..MCV.                           5042
##  82 Platelets                                               5042
##  83 Red.blood.cell.distribution.width..RDW.                 5042
##  84 Red.blood.Cells                                         5042
##  85 Hematocrit                                              5041
##  86 Hemoglobin                                              5041
##  87 Influenza.A..rapid.test                                 4824
##  88 Influenza.B..rapid.test                                 4824
##  89 Adenovirus                                              4292
##  90 Bordetella.pertussis                                    4292
##  91 Chlamydophila.pneumoniae                                4292
##  92 Coronavirus.HKU1                                        4292
##  93 Coronavirus229E                                         4292
##  94 CoronavirusNL63                                         4292
##  95 CoronavirusOC43                                         4292
##  96 Inf.A.H1N1.2009                                         4292
##  97 Metapneumovirus                                         4292
##  98 Parainfluenza.1                                         4292
##  99 Parainfluenza.2                                         4292
## 100 Parainfluenza.3                                         4292
## 101 Parainfluenza.4                                         4292
## 102 Rhinovirus.Enterovirus                                  4292
## 103 Influenza.A                                             4290
## 104 Influenza.B                                             4290
## 105 Respiratory.Syncytial.Virus                             4290
missing_values %>%
  ggplot() +
  geom_bar(aes(x = key, y = 100*num.missing/dim(dataset_clean)[1]), stat = "identity") +
  labs(x = "Variable", y="Percent of missing values") +  
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 8))

Este gráfico mostra quais são as variáveis com maior quantidade de dados faltantes. Note que algumas delas possuem quase 100% de dados faltantes! Veja o gráfico a seguir para que tenhamos uma ideia melhor da magnitude da falta de dados que estamos enfrentando:

vis_miss(dataset_clean) +
  theme(axis.text.x = element_text(size = 6))

Mais de 91% de dados faltantes é muita coisa. Este tipo de informação não me dá muita esperança em encontrar um modelo bom para estes dados. Mesmo assim, vou tentar algo e ver o que acontece. Para isso, vou manter no conjunto a ser analisado apenas as colunas com pelo menos 1000 observações. Ou seja, vou retirar todas as colunas com muito poucos dados registrados.

# keep only columns with at least n observations

n <- 1000

dataset_clean <- dataset_clean[, which(dim(dataset_clean)[1] - apply(apply(dataset_clean, 2, is.na), 2, sum) >= n)]

# remove quantitative variables with variance equal to zero 

dataset_model_num <- dataset_clean %>%
  select_if(is.numeric)

if (sum(apply(dataset_model_num, 2, var, na.rm = TRUE) == 0) != 0) {
  dataset_model_num <- dataset_model_num[, which(apply(dataset_model_num, 2, var, na.rm = TRUE) == 0)]
}

# remove categorical variables with only one level 

dataset_model_cat <- dataset_clean %>%
  select_if(negate(is.numeric))

dataset_model_cat <- dataset_model_cat[, sapply(dataset_model_cat, nlevels) > 1]
  
# final dataset

dataset_model <- base::cbind(dataset_model_num, dataset_model_cat)

vis_miss(dataset_model) + # it needs naniar package
  theme(axis.text.x = element_text(size = 6))

É possíver ver que há uma proporção menor de dados faltantes neste conjunto processado. Baixamos a proporção de dados faltantes de 91,4% para 68%. Ainda é um valor bastante alto, mas está um pouco menos pior do que o original.

Abaixo coloco mais alguns gráficos que tentam relacionar as variáveis que restaram no conjunto de dados, mas aparentemente não há relação alguma entre elas.

# some other plots

ggpairs(dataset_model[, c(1:10)])
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4290 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).
## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

ggpairs(dataset_model[, c(11:ncol(dataset_model))])
## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

## Warning: Removed 4292 rows containing non-finite values (stat_g_gally_count).

# it seems there is no relation between any pair of variables

Modelagem 1

Poucos modelos de aprendizagem de máquina conseguem lidar com dados faltantes. Por este motivo, decidi escolher um modelo chamado CART (Classification and Regression Tree - Árvore de Classificação e Regressão). Abaixo estão os resultados obtidos, após a separação do conjunto de dados original em treinamento e teste. Os resultados reportados foram obtidos após a aplicação do modelo ajustado no conjunto de teste. Para saber mais porque fazer isso, recomendo novamente meu post Tutorial: Como Fazer o Seu Primeiro Projeto de Data Science.

################
### modeling ###
################

# train/test split

covid <- dataset_model

set.seed(1)

index       <- createDataPartition(covid$SARS.Cov.2.exam.result, 
                                   p = 0.75, 
                                   list = FALSE)
covid_train <- covid[ index, ]
covid_test  <- covid[-index, ]

dim(covid_train)
table(covid_train$SARS.Cov.2.exam.result)

dim(covid_test)
table(covid_test$SARS.Cov.2.exam.result)

# parameters for cart

fitControl <- trainControl(method = "cv",
                           number = 5,
                           savePred = TRUE, 
                           classProb = TRUE)

tune.grid <- expand.grid(mincriterion = seq(from = 0.01, 
                                            to = .99, 
                                            by = 0.01))

set.seed(1)

x <- covid_train %>%
  select(-SARS.Cov.2.exam.result)

y <- covid_train %>%
  select(SARS.Cov.2.exam.result) %>%
  unlist()

covid_ctree <- train(x, y,
                     method = "ctree", 
                     tuneGrid = tune.grid,
                     trControl = fitControl)
ggplot(covid_ctree)

prediction <- predict(covid_ctree, covid_test)

confusionMatrix(prediction, covid_test$SARS.Cov.2.exam.result)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction negative positive
##   negative     1271      139
##   positive        0        0
##                                           
##                Accuracy : 0.9014          
##                  95% CI : (0.8847, 0.9165)
##     No Information Rate : 0.9014          
##     P-Value [Acc > NIR] : 0.5226          
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.0000          
##             Specificity : 0.0000          
##          Pos Pred Value : 0.9014          
##          Neg Pred Value :    NaN          
##              Prevalence : 0.9014          
##          Detection Rate : 0.9014          
##    Detection Prevalence : 1.0000          
##       Balanced Accuracy : 0.5000          
##                                           
##        'Positive' Class : negative        
## 
# 90% accuracy seems good, but No Information Rate is also 90%
# so, using this model or a random process gives the same answer
# high sensitivity, but very low specificity :(

Note que obtive 90% de acurácia no meu modelo. Ou seja, ele acerta 90% das tentativas de classificar um paciente como positivo ou negativo em relação ao coronavírus. Parece um resultado muito bom, mas não é. Ele é péssimo, na realidade.

No conjunto de dados original, aproximadamente 90% dos pacientes não possuem coronavírus, enquanto 10% estão infectados. O meu modelo encontra, com 100% de certeza, quem não tem coronavírus (é o valor de Sensitivity no output acima). Entretanto, encontra 0% dos pacientes com coronavírus (é o valor de Specificity no output acima). Ou seja, ele vai mandar para casa todo mundo que chegar no hospital, tendo coronavírus ou não.

Isso me fez partir para uma segunda modelagem.

Modelagem 2

Vimos que a primeira modelagem não deu bons resultados. Com o intuito de tentar obter resultados melhores, vou proceder com a imputação de dados. Se for tentar rodar o código abaixo em seu computador, prepare-se para esperar uns bons minutos.

#######################
### data imputation ###
#######################

covid_imp <- mice(covid, meth = "rf", ntree = 5) # be patient

covid <- complete(covid_imp)
################
### modeling ###
################

# train/test split

set.seed(1)

index       <- createDataPartition(covid$SARS.Cov.2.exam.result, 
                                   p = 0.75, 
                                   list = FALSE)
covid_train <- covid[ index, ]
covid_test  <- covid[-index, ]

dim(covid_train)
table(covid_train$SARS.Cov.2.exam.result)

dim(covid_test)
table(covid_test$SARS.Cov.2.exam.result)

# parameters for random forest

fitControl <- trainControl(method = "cv",
                           number = 5,
                           savePred = TRUE, 
                           classProb = TRUE)

tune.grid <- expand.grid(mtry = 1:35)

set.seed(1)

x <- covid_train %>%
  select(-SARS.Cov.2.exam.result)

y <- covid_train %>%
  select(SARS.Cov.2.exam.result) %>%
  unlist()

covid_rf <- train(x, y,
                  method = "rf", 
                  tuneGrid = tune.grid,
                  trControl = fitControl)
ggplot(covid_rf)

prediction <- predict(covid_rf, covid_test)

confusionMatrix(prediction, covid_test$SARS.Cov.2.exam.result)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction negative positive
##   negative     1271      139
##   positive        0        0
##                                           
##                Accuracy : 0.9014          
##                  95% CI : (0.8847, 0.9165)
##     No Information Rate : 0.9014          
##     P-Value [Acc > NIR] : 0.5226          
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.0000          
##             Specificity : 0.0000          
##          Pos Pred Value : 0.9014          
##          Neg Pred Value :    NaN          
##              Prevalence : 0.9014          
##          Detection Rate : 0.9014          
##    Detection Prevalence : 1.0000          
##       Balanced Accuracy : 0.5000          
##                                           
##        'Positive' Class : negative        
## 
# high sensitivity, but very low specificity :(

De novo, o mesmo problema: alta sensitividade e baixíssima especificidade neste modelo. Ou seja, não é melhor do que o modelo anterior ou uma seleção aleatória de diagnóstico.

Conclusão

Eu cheguei no meu modelo final. 90% de acurácia usando random forest. Mas como a variável resposta é desbalanceada, com 90% para uma classe e 10% para outra, este meu modelo não serve pra nada.

Mesmo tentando abordagens diversas, como filtragem de dados faltantes e imputação, nada deu certo pra mim. Aparentemente este é um resultado geral para este problema. Os outros participantes deste desafio no kaggle criaram várias análises diferentes, com muitas abordagens interessantes, mas ninguém consegue uma boa detecção de verdadeiros positivos.

Tenho pouca esperança que, com este conjunto de dados específico, seja possível fazer algo preditivo de qualidade. Talvez com uma feature engineering muito boa? Pode ser, mas não podemos esquecer que são muitos dados faltantes. No conjunto original, sem pré-processamento, são 91% de dados faltantes. Não dá pra fazer milagre.

Como sempre, o código utilizado nesta análise está disponível em meu github.


comments powered by Disqus