Disciplina de Estatística Aplicada

Aula 4 - Regressão Logística.

Abstract

Aula 4 da disciplina de Estatística Aplicada do curso de Especialização em Big Data, Data Science e Data Analytics. Esta aula contém um exemplo da análise de regressão logística onde busca-se avaliar a chance do evento acontecer em função de variáveis preditoras.

1 Bibliotecas.

library(descr)
library(car)
library(carData)
library(sciplot)
library(tidyverse)
library(dplyr)
library(ggplot2)
library(GGally)
library(DT)
library(readxl)
library(xlsx)
library(relaimpo)
library(hrbrthemes)
library(corrr)
library(broom)
library(caret)
library(ROCR)
library(kableExtra)

2 Regressão Logística.

Etapas principais para a modelagem de regressão:

1. Definir a variável dependente;

2. Selecionar variáveis independentes;

3. Seleção da Amostra de Treino e Amostra de Teste.

4. Executar o desenvolvimento do modelo e avaliar o resultado inicial na base Treino;

5. Eliminar variáveis que não se mostraram significativas para o modelo;

6. Executar o desenvolvimento do modelo novamente e avaliar o resultado na base Treino;

7. Interpretação do modelo.

8. Avaliação do modelo através de curva ROC, estatística KS.

9. Construção de Matrizes de Confusão com pontos de corte arbitrários.

10. Aplicação do modelo para toda a base de dados, amostra Treino + Teste.

11. Considerações finais sobre o modelo.

12. Exportação dos dados gerados no modelo.

2.1 Introdução.

A análise de regressão logística pode ser uma ferramenta estatística para modelar cenários de predições de possibilidades de um evento ocorrer. Nesta análise a evasão de estudantes de cursos de gradução estão inseridos como uma variável resposta (Y) do modelo em função de uma série de variáveis independentes explicativas (Xn).

O objetivo desta tafera é montar um modelo através de regressão logística para estimar a probabilidade de evasão escolar de alunos de uma instituição de ensino por meio da seleção de algumas variáveis independentes explicativas da base de dados dessa instituição, disponibilizados em material da disciplina de Estaística Aplicada do curso de Especialização em Big Data, Data Science e Data Analytis da Unisinos.

2.2 Base de dados: bd_evasao.

Os dados utilizados para realização do trabalho foram disponibilizados através da importação do material no conteúdo da disciplina de Estatística Aplicada do curso de Especialização em Big Data, Data Science e Data Analytics da Unisinos.

aula_4 <- read_excel("C:/LEONARDO/Rpubs/estatistica_aplicada_aula4_leonardo.xlsx", 
                     col_types = c("text", "text", "text", 
                "text", "numeric", "numeric", "numeric", 
                "text", "numeric", "numeric", "numeric", 
                "numeric", "numeric"))

datatable(
  aula_4, extensions = 'Buttons', options = list(
    dom = 'Bfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print')
  )
)

2.3 Seleção da variável resposta no modelo (Y).

A variável escolhida como resposta do modelo de regressão logística foi a evasão escolar (Y_evasao).

Os valores de 0 (zero) indicam os casos que não houve evasão escolar do aluno. Os valores de 1 são os casos que aconteceu evasão. Os casos “vazios” são os que não se tem resposta e buscamos prever através da contrução do modelo de regressão logística.

No Quadro 1 são observados os dados de frequência da distribuição dos casos de evasão na amostra de alunos.

freq <- freq(aula_4$Y_evasao, ylim=c(0,250), main="Frequência da Evasão", 
             xlab="0 = Não | 1 = Sim")

datatable(freq, caption = 'Quadro 1: Frequência da variável evasão na base de dados, aula_4.')

Observa-se que a base de dados apresenta 245 observações com resultado 0 para a variável evasão escolar, ou seja, não houve abandono do curso. Foram registrados 88 observações resultando 1 para a variável evasão escolar, casos que aconteceu o abandono do curso. E são observados 37 resultados em branco “NAs”.

2.4 Fixação dos dados aleatórios com set.seed().

Neste exemplo, busca-se fazer esta atividade de modelagem em grupo. Portando, através da função set.seed() fixa-se os dados aleatórios que serão gerados para formar um banco de dados para treino do modelo e depois para teste. com isso os resultados observados serão os mesmos para todos os participantes da disciplina.

set.seed(1111)

2.5 Amostra de Treino e Amostra de Teste.

O modelo de regressão logística será montado em uma base de dados considerada amostra de treino. A partir dos resultados do modelo na amostra de treino, aplica-se na amostra de teste.

Portanto, organiza-se uma base de dados que será a amostra de treino e amostra de teste. Ambas as amostras apresentarão dados aleatórios na proporção de 70% das observações para a amostra de treino e 30% das observações para a amostra de teste.

As observações com dados “vazios” (NAs) para evasão serão retirados para o desenvolvimento do modelo.

A seleção aleatórioa de 70% das observações para a amostra de treino será realizado através da função createDataPartition() do pacote caret.

#casos <- subset(aula_4, Y_evasao>-1)
#remover NAs
casos <- subset(aula_4, Y_evasao!="NA")
#amostra de treino com 70% das observações
indice.treino <- createDataPartition(y=casos$Y_evasao, p=0.70, list=FALSE)
#df treino e df teste
treino <- casos[indice.treino, ]
teste <- casos[-indice.treino, ]

Observa-se abaixo a frequência do casos de evasão nas amostras de treino e teste. O ideal para desenvolvimento de modelos de regressão é utilizar balanceamento de proporções da frequência de dados da variável resposta de 1:1.

par(mfrow=c(1,2))
freq.treino <- freq(treino$Y_evasao, ylim=c(0,200), main="Frequência da Evasão - Treino", 
             xlab="0 = Não | 1 = Sim")
freq.teste <- freq(teste$Y_evasao, ylim=c(0,100), main="Frequência da Evasão - Teste", 
             xlab="0 = Não | 1 = Sim")

No Quadro 2 e 3, são observados os valores absolutos utilizados na amostra de treino e teste.

datatable(freq.treino, caption = 'Quadro 2: Frequência da variável evasão na base de dados treino.')

datatable(freq.teste, caption = 'Quadro 3: Frequência da variável evasão na base de dados teste.')

2.6 Seleção das variáveis explicativas para o modelo (Xn).

n.variaveis <- dim(casos)[2]

A base de dados apresenta 13 variáveis. Foram selecionadas as seguintes variáveis iniciar o modelo de regressão logística: X1_Curso; X2_Disc; X4_modal.; X5_notas_ant; X6_num_disc_eva; X7_men_atr; X8_sexo; X9_idade; X10_dist.

2.7 Desenvolvimento do primeiro modelo e obtenção dos coeficientes da equação e valor-p.

Com as variáveis explicativas selecionadas, parte-se para o desenvolvimento de um modelo inicial por meio da regressão logística com a utilização da função glm().

Foi utilizado nove variáveis das treze presentes na base de dados. O objetivo inicial é verificar quais variáveis apresentam os melhores coeficientes e valores p para serem selecionadas utilizadas no modelo.

reg_log1 <- (glm(Y_evasao ~
                X1_Curso 
              + X2_Disc
              + X4_modal. 
              + X5_notas_ant
              + X6_num_disc_eva
              + X7_men_atr 
              + X8_sexo 
              + X9_idade
              + X10_dist,
              family=binomial(link="logit"), data=treino))
summary(reg_log1)

## 
## Call:
## glm(formula = Y_evasao ~ X1_Curso + X2_Disc + X4_modal. + X5_notas_ant + 
##     X6_num_disc_eva + X7_men_atr + X8_sexo + X9_idade + X10_dist, 
##     family = binomial(link = "logit"), data = treino)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.3889  -0.5578  -0.2824   0.1852   2.4000  
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                           0.23048    2.38318   0.097 0.922956    
## X1_CursoEngenharia de Produção        0.43769    0.67613   0.647 0.517410    
## X1_CursoGestão da Produção            0.09251    0.50340   0.184 0.854192    
## X2_DiscCálculo B                     -0.85786    1.24837  -0.687 0.491967    
## X2_DiscComportamento do consumidor   -1.24282    1.10989  -1.120 0.262810    
## X2_DiscEstratégias de marketing      -4.13669    1.33802  -3.092 0.001990 ** 
## X2_DiscGestão de Projetos            -1.06563    0.71408  -1.492 0.135621    
## X2_DiscMatemática financeira         -0.29200    0.73740  -0.396 0.692119    
## X2_DiscMétodos Estatísticos          -0.53942    0.66805  -0.807 0.419410    
## X2_DiscPlanejamento contábil        -17.93799 1294.37876  -0.014 0.988943    
## X4_modal.2                            1.49202    0.52088   2.864 0.004178 ** 
## X5_notas_ant                          0.17638    0.20590   0.857 0.391658    
## X6_num_disc_eva                       1.11069    0.22100   5.026 5.01e-07 ***
## X7_men_atr                            0.50147    0.13238   3.788 0.000152 ***
## X8_sexoM                              0.16917    0.41542   0.407 0.683851    
## X9_idade                             -0.19083    0.06494  -2.938 0.003299 ** 
## X10_dist                              0.39053    0.27379   1.426 0.153760    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 274.58  on 233  degrees of freedom
## Residual deviance: 165.12  on 217  degrees of freedom
## AIC: 199.12
## 
## Number of Fisher Scoring iterations: 17

Observa-se que apenas as variáveis X2_Disc, X4_modal., X6_num_disc_eva, X7_men_atr e X9_idade apresentaram-se como siginificativas.

Neste sentido um novo modelo de regressão é desenvolvido, com apenas as variáveis que apresentaram valor de p menor que 0.05 (significativo).

2.8 Desenvolvimento do segundo modelo e obtenção dos coeficientes da equação e valor-p.

Com as variáveis que apresentaram valor p menor que 0.05 foi desenvolvido uma segunda regressão logística a qual servirá como modelo preditivo da variável evasão.

reg_log2 <- (glm(Y_evasao ~ 
                X2_Disc 
              + X4_modal.
              + X6_num_disc_eva 
              + X7_men_atr
              + X9_idade,
              family=binomial(link="logit"), data=treino))
summary(reg_log2)

## 
## Call:
## glm(formula = Y_evasao ~ X2_Disc + X4_modal. + X6_num_disc_eva + 
##     X7_men_atr + X9_idade, family = binomial(link = "logit"), 
##     data = treino)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5046  -0.5937  -0.2929   0.2152   2.2355  
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                           2.60301    1.49811   1.738  0.08229 .  
## X2_DiscCálculo B                     -0.87022    1.17639  -0.740  0.45946    
## X2_DiscComportamento do consumidor   -1.55503    1.09230  -1.424  0.15455    
## X2_DiscEstratégias de marketing      -4.28954    1.34791  -3.182  0.00146 ** 
## X2_DiscGestão de Projetos            -1.15781    0.66433  -1.743  0.08136 .  
## X2_DiscMatemática financeira         -0.39934    0.68068  -0.587  0.55742    
## X2_DiscMétodos Estatísticos          -0.59608    0.62822  -0.949  0.34271    
## X2_DiscPlanejamento contábil        -18.03474 1300.57414  -0.014  0.98894    
## X4_modal.2                            1.33069    0.47122   2.824  0.00474 ** 
## X6_num_disc_eva                       1.00817    0.19670   5.125 2.97e-07 ***
## X7_men_atr                            0.50922    0.13003   3.916 8.99e-05 ***
## X9_idade                             -0.19228    0.06449  -2.981  0.00287 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 274.58  on 233  degrees of freedom
## Residual deviance: 168.40  on 222  degrees of freedom
## AIC: 192.4
## 
## Number of Fisher Scoring iterations: 17

Para realizar a interpretação do modelo é necessário fazer o cálculo de obtenção da função exponencial de cada um dos coeficientes gerados do modelo. Essa função exponencial apresenta como base o número de Euler (2.7182). O Quadro 4 mostra os dados dos coeficientes gerados e seus valores exponenciais.

exp.coef <- data.frame(exp(coef(reg_log2)))
coef.reg_log2 <- reg_log2$coefficients
dados.1.reg_log2 <- data.frame(coef.reg_log2, exp.coef)
datatable(dados.1.reg_log2, caption = 'Quadro 4: Coeficientes e Exponencial dos coeficientes da regressão logística')

2.9 Interpretação do modelo.

O modelo apresenta apenas variáveis preditoras significativas.

Utiliza-se os resuldados da exponencial dos coeficientes no Quadro 4 na interpretação.

• Disciplina (X2_Disc): Dependendo da disciplina disciplina que o aluno está cursando, existe uma maior ou menor chance de evasão. Pois algumas disciplinas apresentaram resultado significativo para o modelo. A base é Calculo A (ordem alfabética gerada no banco de dados do R).

#X2_DiscCálculo B:
exp.coef.calculoB <- exp(coef(reg_log2))[2]
#quanto de chance
chance.calculoB <- round((1-exp.coef.calculoB)*100, digits = 2)

X2_DiscCálculo B: Sempre que o resultado da exponencial do coeficiente apresentar um resultado menor que 1, nesse caso 0.4188607, signigica que cursar Cálculo B apresenta uma chance menor de evasão que cursar Cálculo A (base).

Portanto, o aluno que cursa Cálculo B, considerando todos os outros fatores fixos (iguais), apresenta 58.11% de chance a menos de evadir do que comparado do que alguém que esteja cursando Cálculo A.

#X2_DiscComportamento do consumidor:
exp.coef.cc <- exp(coef(reg_log2))[3]
#quanto de chance
chance.cc <- round((1-exp.coef.cc)*100, digits = 2)

X2_DiscComportamento do consumidor: Sempre que o resultado da exponencial do coeficiente apresentar um resultado menor que 1, nesse caso 0.2111835, signigica que cursar Comportamento do Consumidor apresenta uma chance menor de evasão que cursar Cálculo A (base). Portanto, o aluno que cursa Comportamento do Consumidor, considerando todos os outros fatores fixos (iguais), apresenta 78.88% de chance a menos de evadir do que comparado do que alguém que esteja cursando Cálculo A.

#X2_DiscEstratégias de marketing:
exp.coef.em <- exp(coef(reg_log2))[4]
#quanto de chance
chance.em <- round((1-exp.coef.em)*100, digits = 2)

X2_DiscEstratégias de marketing: Sempre que o resultado da exponencial do coeficiente apresentar um resultado menor que 1, nesse caso 0.0137113, signigica que cursar Estratégias de marketing apresenta uma chance menor de evasão que cursar Cálculo A (base). Portanto, o aluno que cursa Estratégias de marketing, considerando todos os outros fatores fixos (iguais), apresenta 98.63% de chance a menos de evadir do que comparado do que alguém que esteja cursando Cálculo A.

#X2_DiscGestão de Projetos:
exp.coef.gp <- exp(coef(reg_log2))[5]
#quanto de chance
chance.gp <- round((1-exp.coef.gp)*100, digits = 2)

X2_DiscGestão de Projetos: Sempre que o resultado da exponencial do coeficiente apresentar um resultado menor que 1, nesse caso 68.58, signigica que cursar Gestão de Projetos apresenta uma chance menor de evasão que cursar Cálculo A (base). Portanto, o aluno que cursa Gestão de Projetos, considerando todos os outros fatores fixos (iguais), apresenta 68.58% de chance a menos de evadir do que comparado do que alguém que esteja cursando Cálculo A.

#X2_DiscMatemática financeira:
exp.coef.mf <- exp(coef(reg_log2))[6]
#quanto de chance
chance.mf <- round((1-exp.coef.mf)*100, digits = 2)

X2_DiscMatemática financeira: Sempre que o resultado da exponencial do coeficiente apresentar um resultado menor que 1, nesse caso 0.6707638, signigica que cursar Matemática financeira apresenta uma chance menor de evasão que cursar Cálculo A (base). Portanto, o aluno que cursa Matemática financeira, considerando todos os outros fatores fixos (iguais), apresenta 32.92% de chance a menos de evadir do que comparado do que alguém que esteja cursando Cálculo A.

#X2_DiscMétodos Estatísticos:
exp.coef.me <- exp(coef(reg_log2))[7]
#quanto de chance
chance.me <- round((1-exp.coef.me)*100, digits = 2)

X2_DiscMétodos Estatísticos: Sempre que o resultado da exponencial do coeficiente apresentar um resultado menor que 1, nesse caso 0.5509692, signigica que cursar Métodos Estatísticos apresenta uma chance menor de evasão que cursar Cálculo A (base). Portanto, o aluno que cursa Métodos Estatísticos, considerando todos os outros fatores fixos (iguais), apresenta 44.9% de chance a menos de evadir do que comparado do que alguém que esteja cursando Cálculo A.

#X2_DiscPlanejamento contábil:
exp.coef.pc <- exp(coef(reg_log2))[8]
#quanto de chance
chance.pc <- round((1-exp.coef.pc)*100, digits = 2)

X2_DiscPlanejamento contábil: Sempre que o resultado da exponencial do coeficiente apresentar um resultado menor que 1, nesse caso 1.470997810^{-8}, signigica que cursar Planejamento contábil apresenta uma chance menor de evasão que cursar Cálculo A (base). Portanto, o aluno que cursa Planejamento contábil, considerando todos os outros fatores fixos (iguais), apresenta 100% de chance a menos de evadir do que comparado do que alguém que esteja cursando Cálculo A.

#interpretacao X4_modal.
coef.X4_modal. <- coef(reg_log2)[9]
exp.coef.X4_modal. <- exp(coef(reg_log2))[9]

• Modalidade (X4_modal.): A modalidade 1 significa “presencial” a modalidade 2 “ead”. A base para cálculo do coeficiente B do modelo foi modalidade 1, presencial. Portanto, comparando disciplinas modalidade 2 (ead) apresentam uma chance maior de evasão comparado a disciplinas modalidade 1 (presencial), pois o valor do coeficiente para modalidade 2 é positivo (>0), apresentado valor de 1.3306868. Portanto, o aluno que cursa na modalidade 2 (ead), mantendo todo o restante do perfil fixo (igual), apresenta 3.7836411 vezes mais chance de evadir que um aluno que cursa na modalidade 1 (presencial).

#interpretacao X6_num_disc_eva
coef.X6_num_disc_eva <- coef(reg_log2)[10]
exp.coef.X6_num_disc_eva <- exp(coef(reg_log2))[10]

• Número de disciplinas evadidas (X6_num_disc_eva): Para cada disciplina evadida que o aluno apresenta em seu histórico, aumenta a chance de evasão em 2.7405874 vezes.

#interpretacao X7_men_atr
coef.X7_men_atr <- coef(reg_log2)[11]
exp.coef.X7_men_atr <- exp(coef(reg_log2))[11]

• Mensalidades atrasadas (X7_men_atr): O resultado do coeficiente foi positivo, 0.5092208, o que significa que quanto maior o número de mensalidades em atraso, maior a chance de evasão. Para cada registro de mensalidade atrasada observado por aluno, aumenta a chance de evasão em 1.6639941 vezes. Ou seja, 66% a mais de chance de evadir.

#interpretacao X9_idade
coef.X9_idade <- coef(reg_log2)[12]
exp.coef.X9_idade <- exp(coef(reg_log2))[12]
#quanto de chance
chance.X9_idade <- round((1-exp.coef.X9_idade)*100, digits = 2)

• Idade (X9_idade): O resultado da exponencial do coeficiente para a variável Idade apresentou um resultado menor que 1, nesse caso 0.825075, signigica que a cada ano a mais que o aluno apresenta a chance de evasão diminui em 17.49% da idade anterior.

2.10 Avaliação do modelo de Regressão Logística.

A sequência de comando busca prepar os dados para a Matriz de Confusão, ou seja a matriz de acertividade do modelo.

Utiliza-se agora a base de dados teste.

Por meio da aplicação da equação gerada no modelo de regressão logística serão calculados a probabilidade de acontecer os casos evasão com a base de dados Teste.

#utilização do modelo para prever valores de evasão na base teste
pred.Teste <- predict(reg_log2,teste, type = "response")
#cola os resultados de previsão em uma nova coluna chamada teste_v2
Teste_v2 <- cbind(teste,pred.Teste)
pred.val <- prediction(pred.Teste ,Teste_v2$Y_evasao)

2.11 Cálculo da Área abaixo da Curva (AUC) e Estatística KS.

Utiliza-se o gráfico da área abaixo da curva, curva “ROC”. No eixo X observa-se a taxa de falsos positivos. Onde buscamos o mais próximo de 0, ou seja a curva deve seguir o mais próximo de 0 no eixo X. No eixo Y se observa a taxa de verdadeiros positivos, onde busca-se o mais próximo de 1.

# cálculo da auc (area under the curve)
auc <- performance(pred.val,"auc")
# Plota curva ROC
performance <- performance(pred.val, "tpr", "fpr")
plot(performance, col = "blue", lwd = 5, main = "Curva ROC")

Na sequência calculou-se a estatística KS (Kolmogorov-Smirnov). Busca-se um valor para esse parâmetro de >= 0.5.

#Cálculo Estatística Kolmogorov-Smirnov
ks <- max(attr(performance, "y.values")[[1]] - (attr(performance, "x.values")[[1]]))
ks # buscamos um valor >0.5, 0.5 já é aceitável.

## [1] 0.6783333

O resultado para a estatística KS apresentou 0.6783333. Portanto, o resultado é maior que 0.5, ou seja o modelo de regressão logística está adequado e satisfatório.

2.12 Matriz de Confusão.

n.obs.teste <- dim(Teste_v2)[1]

A matriz de confusão é construida com todas as observações da amostra de teste, 99 observações. Nesta base de dados da amostra teste, foi adicionado a variável pred.Teste a qual registra a porcentagem de chance do aluno evadir criado através do modelo de regressão logística.

Nota-se a seguir uma série de matrizes de confusão criadas, todas essas matrizes foram construidas através da escolha de pontos de corte.

A Matriz de Confusão 1 apresentou ponto de corte de 50%. O que siginifica que estamos considerando que quando o resultado de pred.Teste for maior que 0.5, assume-se que o aluno evade através do modelo.

A Matriz de Confusão 2 apresentou ponto de corte de 40%.

A Matriz de Confusão 3 apresentou ponto de corte de 30%.

#confusion matrix com ponto de corte em 50%
mc.1 <- table(teste$Y_evasao, pred.Teste > 0.5)
#confusion matrix com ponto de corte em 40%
mc.2 <- table(teste$Y_evasao, pred.Teste > 0.4)
#confusion matrix com ponto de corte em 35%
mc.3 <- table(teste$Y_evasao, pred.Teste > 0.3)

kable(list(mc.1, mc.2, mc.3), caption = "Matriz de Confusão 1 (esquerda), 2 (centro) e 3 (direita)") %>%
  kable_styling(bootstrap_options = "striped", full_width = T) %>%
  footnote(general = "Matriz de Confusão 1 apresenta ponto de corte de 50%. A Matriz de Confusão 2 apresenta ponto de corte de 40%. A Matriz de Confusão 3 apresenta ponto de corte de 30%.", 
  number = c("Linha 0 = Alunos que concluíram; ", "Linha 1 = Alunos que evardiram; "), 
  alphabet = c("Coluna FALSE = Alunos que concluíram no MODELO; ", "Coluna TRUE = Alunos que evadiram no MODELO; "))

Matriz de Confusão 1 (esquerda), 2 (centro) e 3 (direita)

FALSE TRUE 0 66 9 1 14 10	FALSE TRUE 0 63 12 1 7 17	FALSE TRUE 0 58 17 1 6 18
Note:
Matriz de Confusão 1 apresenta ponto de corte de 50%. A Matriz de Confusão 2 apresenta ponto de corte de 40%. A Matriz de Confusão 3 apresenta ponto de corte de 30%.
1 Linha 0 = Alunos que concluíram;
2 Linha 1 = Alunos que evardiram;
a Coluna FALSE = Alunos que concluíram no MODELO;
b Coluna TRUE = Alunos que evadiram no MODELO;

#matriz de confusão 1
total.evasao.modelo.1 <- mc.1[1] + mc.1[4]
acertividade.geral.mc1 <- round((total.evasao.modelo.1/n.obs.teste)*100, digits = 2)

A Matriz de Confusão 1 apresenta o modelo gerado com ponto de corte de 50% (0.5). Nota-se 19 observações (9+10) de que o aluno evade pelo modelo. Esse resultado mostra que 10 estão corretas e 9 estão incorretas. Portanto, nos resultados do modelo para ponto de corte de 0.5 o resultado 9 é Falso Positivo de evasão e o resultado 10 é Positivo Positivo de evasão. O índice de acertividade geral do modelo ficou em 76.77%, com ponto de corte 50%.

#matriz de confusão 2
total.evasao.modelo.2 <- mc.2[1] + mc.2[4]
acertividade.geral.mc2 <- round((total.evasao.modelo.2/n.obs.teste)*100, digits = 2)

A Matriz de Confusão 2 apresenta o modelo gerado com ponto de corte de 40% (0.4). Nota-se 29 observações (12+17) de que o aluno evade pelo modelo. Esse resultado mostra que 17 estão corretas e 12 estão incorretas. Portanto, nos resultados do modelo para ponto de corte de 0.4 o resultado 12 é Falso Positivo de evasão e o resultado 17 é Positivo Positivo de evasão. O índice de acertividade geral do modelo ficou em 80.81%, com ponto de corte 40%.

#matriz de confusão 3
total.evasao.modelo.3 <- mc.3[1] + mc.3[4]
acertividade.geral.mc3 <- round((total.evasao.modelo.3/n.obs.teste)*100, digits = 2)

A Matriz de Confusão 3 apresenta o modelo gerado com ponto de corte de 30% (0.3). Nota-se 35 observações (17+18) de que o aluno evade pelo modelo. Esse resultado mostra que 18 estão corretas e 17 estão incorretas. Portanto, nos resultados do modelo para ponto de corte de 0.3 o resultado 17 é Falso Positivo de evasão e o resultado 18 é Positivo Positivo de evasão. O índice de acertividade geral do modelo ficou em 76.77%, com ponto de corte 30%.

O melhor resultado da Matriz de Confusão foi obtido com a Matriz de Confusão 2, com uma acertividade de 80.81%, com ponto de corte 40%.

#confusion matrix com ponto de corte em 50%
mc.1.prop <- round(prop.table(mc.1), digits = 4)
#confusion matrix com ponto de corte em 40%
mc.2.prop <- round(prop.table(mc.2), digits = 4)
#confusion matrix com ponto de corte em 35%
mc.3.prop <- round(prop.table(mc.3), digits = 4)

acerto.mc.1 <- sum(diag(mc.1.prop))
acerto.mc.2 <- sum(diag(mc.2.prop))
acerto.mc.3 <- sum(diag(mc.3.prop))

acertividade <- cbind(c(acerto.mc.1,acerto.mc.2,acerto.mc.3))
mc <- cbind(c("Matriz Confusão 1", "Matriz Confusão 2", "Matriz Confusão 3"))
acerto.mc <- data.frame(mc, acertividade)

datatable(acerto.mc, colnames = c('Matriz de Confusão', 'Percentual de Acertividade do Modelo'), caption = 'Matrizes de Confusão com os pontos de corte de 50%, 40% e 30% e acertividade do modelo conforme o ponto de corte.') %>% 
  formatStyle("acertividade", backgroundColor = styleInterval(c(0.50,0.80), c("red", "white", "lightgreen"))) %>% formatPercentage('acertividade', 2)

2.13 Aplicação do Modelo para toda a base de dados e diagrama de dispersão para representação.

Para visualização do modelo de forma gráfica, foi montado um diagrama de disperção onde os pontos em coloração azul representam os alunos que evadiram e os pontos em coloração vermelha representam os alunos que não evadiram, ou seja concluíram. No eixo y, observa-se a probabilididade calculada pelo modelo para o aluno (observação) evadir.

#Insere a probabilidade de evasao para toda a base de dados, inclusive os casos sem a informação Y.
aula_4$predict <- predict(reg_log2, newdata=aula_4, type="response")
#gerar ID para observações
aula_4 <- tibble::rowid_to_column(aula_4, "ID")
#fator com a situação definida pelo modelo
aula_4$sit <- as.factor(aula_4$Y_evasao)
aula_4 <- aula_4 %>% 
  mutate(sit2 = case_when(Y_evasao == 1 ~ "Evasao", 
                           Y_evasao == 0 ~ "Conclusao", 
                           Y_evasao == "NA" ~ "NA"))

#gráfico ggplot 2
h <- 0.4
ggplot(aula_4, aes(x=ID, y=predict, color=sit2)) + 
  geom_point(size=2) + 
  theme_ipsum() + geom_hline(yintercept = 0.4, colour = "black", size =1.2) + 
  scale_color_manual(values=c('#de2d26','#2c7fb8')) + geom_text(aes(0, h, label="40%", vjust=-0.5), colour = "black") + 
  ggtitle("Dispersão de evasão e ponto de corte") +
  xlab("observações - alunos") + 
  ylab("Percentual de chance de evadir")

#Matriz de confusão final, com toda a base.
mc.total <- table(aula_4$Y_evasao, aula_4$predict > 0.4)

kable(mc.total, caption = "Matriz de Confusão Final, com toda a base de dados, treino e teste.") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>%
  footnote(general = "Matriz de Confusão Final, apresenta ponto de corte de 40%.", 
  number = c("Linha 0 = Alunos que concluíram; ", "Linha 1 = Alunos que evardiram; "), 
  alphabet = c("Coluna FALSE = Alunos que concluíram no MODELO; ", "Coluna TRUE = Alunos que evadiram no MODELO; "))

Matriz de Confusão Final, com toda a base de dados, treino e teste.

	FALSE	TRUE
0	213	32
1	31	57
Note:
Matriz de Confusão Final, apresenta ponto de corte de 40%.
1 Linha 0 = Alunos que concluíram;
2 Linha 1 = Alunos que evardiram;
a Coluna FALSE = Alunos que concluíram no MODELO;
b Coluna TRUE = Alunos que evadiram no MODELO;

#confusion matrix com ponto de corte em 40%
mc.total.prop <- round(prop.table(mc.total), digits = 4)

acerto.mc.total <- sum(diag(mc.total.prop))

mc.total.nome <- cbind("Matriz Confusão Final")

acerto.mc.final <- data.frame(mc.total.nome, acerto.mc.total)

datatable(acerto.mc.final, colnames = c('Matriz de Confusão', 'Percentual de Acertividade do Modelo'), caption = 'Acertividade do modelo com 40% no ponto de corte.') %>% formatPercentage('acerto.mc.total', 2)

2.14 Considerações finais sobre o modelo desenvolvido.

O modelo de predição da variável resposta Y_evasao através de regressão logística das variáveis selecionadas, X2_Disc, X4_modal., X6_num_disc_eva, X7_men_atr e X9_idade signigicativo para cada uma das variáveis e o modelo apresentou acertividade geral de 80.08%.

Portanto, para cada 10 alunos observados o modelo é capaz de acertar 8 classificações de evasão.

2.15 Exportação de dados dos resultados.

#dados para download
datatable(aula_4, extensions = 'Buttons', 
          options = list(dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print')  )
)