A regressão logística é usada para prever uma classe, ou seja, uma probabilidade. A regressão logística pode prever um resultado binário com precisão.

Imagine que você deseja prever se um empréstimo será negado/aceito com base em muitos atributos. Neste cao, a resposta na regressão logística é da forma 0/1. \(Y = 0\) se um empréstimo for rejeitado e \(Y = 1\) se aceito, dizemos então, que o sucesso acontecerá quando um epressário é aceito. Observemos que nada impede de que o sucesso seja exatamente o contrário; tudo depende do interesse da pesquisa.

Um modelo de regressão logística difere do modelo de regressão linear de duas maneiras:

Observemos que a função sigmóide retorna valores entre 0 a 1. Para a tarefa de classificação, precisamos de uma saída discreta de 0 ou 1. 

par(mfrow=c(1,2))
t = seq(9,10,by=0.01)
plot(t, sig(t), type = "l", col = "red", ylab = expression(frac(1,1+e^(-t))))
grid()
t = seq(-10,-9,by=0.01)
plot(t, sig(t), type = "l", col = "red", ylab = expression(frac(1,1+e^(-t))))
grid()

Para converter um fluxo contínuo em valor discreto, podemos definir um limite de decisão em 0.5, ou seja, \[\begin{equation*} \widehat{Y}=\left\{ \begin{array}{rcl} 1, & \mbox{ se } & \widehat{\mu}>0.5 \\[0.8em] 0, & \mbox{ se } & \widehat{\mu}<0.5 \end{array}\right.\cdot \end{equation*}\] Todos os valores acima deste limite serão classificados como 1 e 0, caso contrário. Para outro critério de classificação utilizamos a curva ROC.

Exemplo

Vamos usar um conjunto de dados de adultos para ilustrar a regressão logística. O “adulto” é um ótimo conjunto de dados para a tarefa de classificação. O objetivo é prever se a renda anual em dólares de um indivíduo será superior a 50.000.

O conjunto de dados contém 46.033 observações e dez recursos:

entre outros 

library(dplyr)
data_adult <- read.csv("https://raw.githubusercontent.com/guru99-edu/R-Programming/master/adult.csv")
glimpse(data_adult)
## Rows: 48,842
## Columns: 10
## $ x               <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,~
## $ age             <int> 25, 38, 28, 44, 18, 34, 29, 63, 24, 55, 65, 36, 26, 58~
## $ workclass       <chr> "Private", "Private", "Local-gov", "Private", "?", "Pr~
## $ education       <chr> "11th", "HS-grad", "Assoc-acdm", "Some-college", "Some~
## $ educational.num <int> 7, 9, 12, 10, 10, 6, 9, 15, 10, 4, 9, 13, 9, 9, 9, 14,~
## $ marital.status  <chr> "Never-married", "Married-civ-spouse", "Married-civ-sp~
## $ race            <chr> "Black", "White", "White", "Black", "White", "White", ~
## $ gender          <chr> "Male", "Male", "Male", "Male", "Female", "Male", "Mal~
## $ hours.per.week  <int> 40, 50, 40, 40, 30, 30, 40, 32, 40, 10, 40, 40, 39, 35~
## $ income          <chr> "<=50K", "<=50K", ">50K", ">50K", "<=50K", "<=50K", "<~

Vamos proceder da seguinte forma:

A tarefa é prever qual indivíduo terá uma receita superior a 50 mil.

Neste tutorial, cada etapa será detalhada para realizar uma análise em um conjunto de dados real.

Etapa 1: Verificar as variáveis contínuas. 

continuous <-select_if(data_adult, is.numeric)
summary(continuous)
##        x              age        educational.num hours.per.week 
##  Min.   :    1   Min.   :17.00   Min.   : 1.00   Min.   : 1.00  
##  1st Qu.:12211   1st Qu.:28.00   1st Qu.: 9.00   1st Qu.:40.00  
##  Median :24422   Median :37.00   Median :10.00   Median :40.00  
##  Mean   :24422   Mean   :38.64   Mean   :10.08   Mean   :40.42  
##  3rd Qu.:36632   3rd Qu.:48.00   3rd Qu.:12.00   3rd Qu.:45.00  
##  Max.   :48842   Max.   :90.00   Max.   :16.00   Max.   :99.00

Explicação do código:

Na tabela acima, podemos ver que os dados têm escalas e horas totalmente diferentes hours.per.weeks tem grandes valores discrepantes, ou seja, observe o último quartil e o valor máximo.

Podemos lidar com isso seguindo duas etapas:

Etapa 2: Verificar as variáveis fatores.

Esta etapa tem dois objetivos:

Vamos dividir esta etapa em três partes:

Podemos selecionar as colunas fatores com o código abaixo:

# Selecionando as coluna categóricas
factor <- data.frame(select_if(data_adult_rescale, is.character))
ncol(factor)
## [1] 6
head(factor)
##   workclass    education     marital.status  race gender income
## 1   Private         11th      Never-married Black   Male  <=50K
## 2   Private      HS-grad Married-civ-spouse White   Male  <=50K
## 3 Local-gov   Assoc-acdm Married-civ-spouse White   Male   >50K
## 4   Private Some-college Married-civ-spouse Black   Male   >50K
## 5         ? Some-college      Never-married White Female  <=50K
## 6   Private         10th      Never-married White   Male  <=50K

As variáveis identificadas são to tipo character, o que não significa sejam fatores. As transformamos em fatores da seguinte forma:

factor <- as.data.frame(lapply(factor, as.factor))
str(factor)
## 'data.frame':    48314 obs. of  6 variables:
##  $ workclass     : Factor w/ 9 levels "?","Federal-gov",..: 5 5 3 5 1 5 1 7 5 5 ...
##  $ education     : Factor w/ 16 levels "10th","11th",..: 2 12 8 16 16 1 12 15 16 6 ...
##  $ marital.status: Factor w/ 7 levels "Divorced","Married-AF-spouse",..: 5 3 3 3 5 5 5 3 5 3 ...
##  $ race          : Factor w/ 5 levels "Amer-Indian-Eskimo",..: 3 5 5 3 5 5 3 5 5 5 ...
##  $ gender        : Factor w/ 2 levels "Female","Male": 2 2 2 2 1 2 2 2 1 2 ...
##  $ income        : Factor w/ 2 levels "<=50K",">50K": 1 1 2 2 1 1 1 2 1 1 ...

Explicação do código

O conjunto de dados contém 6 variáveis categóricas. A segunda etapa é mais habilidosa. Desejamos traçar um gráfico de barras para cada coluna no fator do quadro de dados. É mais conveniente automatizar o processo, especialmente quando há muitas colunas. 

# Criando um gráfico para cada coluna
graph <- lapply(names(factor), function(x) 
    ggplot(factor, aes(get(x))) + geom_bar() + xlab((x)) + theme(axis.text.x = element_text(angle = 90)))

Explicação do código

A última etapa é relativamente fácil. Você deseja imprimir os 6 gráficos.

# Imprimindo os gráficos
graph
## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

Etapa 3: Engenharia de recursos

Reforma da educação

No gráfico acima, você pode ver que a variável education (educação) possui 16 níveis. Isso é substancial e alguns níveis têm um número relativamente baixo de observações. Se você deseja melhorar a quantidade de informações que pode obter dessa variável, pode reformulá-la para um nível superior. Ou seja, você cria grupos maiores (em número de observações) com nível de educação semelhante. Por exemplo, baixo nível de educação será convertido em evasão. Os níveis mais elevados de educação serão alterados para mestre.

Nível antigo Novo nível
Preschool Dropout
10th Dropout
11th Dropout
12th Dropout
1st-4th Dropout
5th-6th Dropout
7th-8th Dropout
9th Dropout
HS-Grad HighGrad
Some-college Community
Assoc-acdm Community
Assoc-voc Community
Bachelors Bachelors
Masters Masters
Doctorate PhD

Para fazermos a transformação sugerida utilizamos o seguinte código: 

recast_data <- data_adult_rescale %>%   select(-x) %>% mutate(education = 
                    factor(ifelse(education == "Preschool" | education == "10th" | education == "11th" | 
                                  education == "12th" | education == "1st-4th" | education == "5th-6th" | 
                                  education == "7th-8th" | education == "9th", "Dropout", 
                    ifelse(education == "HS-grad", "HighGrad", ifelse(education == "Some-college" | 
                                  education == "Assoc-acdm" | education == "Assoc-voc", "Community",
                    ifelse(education == "Bachelors", "Bachelors", 
                    ifelse(education == "Masters" | education == "Prof-school", "Master", "PhD")))))))

Explicação do código: 

recast_data %>% 
    group_by(education) %>% 
  summarize(average_educ_year = mean(educational.num), count = n()) %>% arrange(average_educ_year)
## # A tibble: 6 x 3
##   education average_educ_year count
##   <fct>                 <dbl> <int>
## 1 Dropout              -1.74   6340
## 2 HighGrad             -0.419 15608
## 3 Community             0.111 14396
## 4 Bachelors             1.14   7968
## 5 Master                1.62   3427
## 6 PhD                   2.31    575

Reformulação do estado civil: