A Universidade Federal de Campina Grande (UFCG), assim como muitas universidades brasileiras, sofre com o problema da evasão de alunos. Tendo como motivação o problema que deixa um número relevante de vagas ociosas no ensino público, neste relatório será feito um modelo de predição na intenção de descobrir, antecipadamente, quando um aluno irá ou não abandonar o seu curso, considerando que ele está cursando o primeiro período. Ao final da análise, será gerado um arquido com os dados da predição do modelo promovido, que será submetido em uma competição no Kaggle disponível neste link.
Os dados utilizados fazem parte de uma amostra disciplinas cursadas por alunos da Universidade Federal de Campina Grande, dos cursos de Engenharia Elétrica e Enfermagem, e a predição será feita através de um modelo construído a partir dos dados fornecidos na amostra.
Segue abaixo um sumário da amostra.
library(dplyr, quietly = TRUE)
library(ggplot2, quietly = TRUE)
library(caret)
library(C50)training_evasao <- read.csv(file = "training_evasao.csv", header=TRUE, sep=",")
summary(training_evasao)## ID MATRICULA COD_CURSO
## Min. : 1 Min. : 2636462 Min. :12204100
## 1st Qu.: 4739 1st Qu.:249727234 1st Qu.:14123100
## Median : 9478 Median :508993893 Median :14123100
## Mean : 9581 Mean :501522998 Mean :13677419
## 3rd Qu.:14216 3rd Qu.:745324313 3rd Qu.:14123100
## Max. :19536 Max. :999280527 Max. :14123100
##
## CURSO PERIODO CODIGO
## ENFERMAGEM - D : 4402 Min. :2002 Min. :1105013
## ENGENHARIA ELÉTRICA:14552 1st Qu.:2009 1st Qu.:1109103
## Median :2011 Median :1201136
## Mean :2010 Mean :1246218
## 3rd Qu.:2012 3rd Qu.:1404139
## Max. :2013 Max. :1503072
##
## DISCIPLINA CREDITOS
## INTRODUCAO A PROGRAMACAO : 1436 Min. :0.000
## INTRODUCAO A ENGENHARIA ELETRICA : 1392 1st Qu.:3.000
## CIÊNCIAS DO AMBIENTE : 1377 Median :4.000
## EXPRESSAO GRAFICA : 1355 Mean :3.536
## ÁLGEBRA VETORIAL E GEOMETRIA ANALÍTICA: 1341 3rd Qu.:4.000
## CALCULO DIFERENCIAL E INTEGRAL I : 1334 Max. :8.000
## (Other) :10719
## DEPARTAMENTO MEDIA
## UNID. ACAD. DE CIÊNCIAS DA SAÚDE (UACS):4402 Min. : 0.000
## UNID. ACAD. DE ENGENHARIA ELÉTRICA :3494 1st Qu.: 4.000
## UNID. ACAD. DE MATEMÁTICA :3374 Median : 7.000
## UNID. ACAD. DE FÍSICA :2102 Mean : 5.904
## UNID. ACAD. DE SISTEMAS E COMPUTAÇÃO :1695 3rd Qu.: 8.200
## UNID. ACAD. DE ENGENHARIA CIVIL :1420 Max. :10.000
## (Other) :2467 NA's :529
## SITUACAO PERIODO_INGRESSO PERIODO_RELATIVO
## Aprovado :13438 Min. :2002 Min. :1.000
## Reprovado : 2906 1st Qu.:2008 1st Qu.:1.000
## Reprovado por Falta: 2049 Median :2010 Median :1.000
## Trancado : 561 Mean :2009 Mean :2.141
## 3rd Qu.:2011 3rd Qu.:5.000
## Max. :2013 Max. :5.000
##
## COD_EVASAO
## Min. :0.00000
## 1st Qu.:0.00000
## Median :0.00000
## Mean :0.09291
## 3rd Qu.:0.00000
## Max. :1.00000
## Para o processo de predição, foram consideradas relevantes as variáveis “CURSO”, “MEDIA” e “SITUACAO”, devido a sua importância para a identificação dos perfis dos universitários.
alunos_fera <- training_evasao %>% filter(PERIODO_RELATIVO == 1)
alunos_fera <- alunos_fera %>% select(ID,MATRICULA,CURSO, MEDIA, SITUACAO, COD_EVASAO)
alunos_fera$COD_EVASAO <- as.factor(alunos_fera$COD_EVASAO)
alunos_fera$MATRICULA <- as.factor(alunos_fera$MATRICULA)
str(alunos_fera)## 'data.frame': 13546 obs. of 6 variables:
## $ ID : int 2 4 5 6 11 13 15 16 17 18 ...
## $ MATRICULA : Factor w/ 1871 levels "2636462","2714857",..: 1386 1386 1386 1386 1386 1386 1386 35 35 35 ...
## $ CURSO : Factor w/ 2 levels "ENFERMAGEM - D",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ MEDIA : num 8.3 9.5 9.8 8.2 7.9 8.6 8 9.3 9.1 7.7 ...
## $ SITUACAO : Factor w/ 4 levels "Aprovado","Reprovado",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ COD_EVASAO: Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...Além das variáveis escolhidas, também é necessária a utilização de outras informações, ainda não disponibilizadas diretamente pelo dataset, para o treinamento do modelo de predição. Para tanto, foram geradas novas variáveis através do processo de sumarização. Segue abaixo a listagem e descrição de cada variável criada e o codigo utilizado.
df <- alunos_fera %>% group_by(MATRICULA, CURSO, COD_EVASAO) %>% summarise(
MEDIA = round(sum(MEDIA, na.rm = TRUE)/(n() -(ifelse(NA %in% MEDIA, count_NAs(MEDIA) ,0))),digits=2),
TEM_APROVACAO=ifelse("Aprovado" %in% SITUACAO, TRUE, FALSE),
TEM_REPROV_POR_NOTA=ifelse("Reprovado" %in% SITUACAO, TRUE, FALSE),
TEM_REPROV_POR_FALTA=ifelse("Reprovado por Falta" %in% SITUACAO,TRUE,FALSE),
MEDIA_ZERO=ifelse(MEDIA == 0, TRUE, FALSE),
REP_POR_FALTA_E_MEDIA_ZERO = ( TEM_REPROV_POR_FALTA && MEDIA_ZERO))
summary(df)## MATRICULA CURSO COD_EVASAO MEDIA
## 2636462: 1 ENFERMAGEM - D : 384 0:1668 Min. :0.000
## 2714857: 1 ENGENHARIA ELÉTRICA:1487 1: 203 1st Qu.:4.662
## 2791762: 1 Median :6.485
## 3521919: 1 Mean :5.815
## 5062803: 1 3rd Qu.:7.610
## 5604386: 1 Max. :9.600
## (Other):1865 NA's :37
## TEM_APROVACAO TEM_REPROV_POR_NOTA TEM_REPROV_POR_FALTA MEDIA_ZERO
## Mode :logical Mode :logical Mode :logical Mode :logical
## FALSE:194 FALSE:937 FALSE:1439 FALSE:1723
## TRUE :1677 TRUE :934 TRUE :432 TRUE :111
## NA's :0 NA's :0 NA's :0 NA's :37
##
##
##
## REP_POR_FALTA_E_MEDIA_ZERO
## Mode :logical
## FALSE:1762
## TRUE :109
## NA's :0
##
##
## df <- df[c(2,4,5,6,7,8,9,3)] #Reordenando as colunas
df$TEM_APROVACAO <- as.factor(df$TEM_APROVACAO)
df$TEM_REPROV_POR_NOTA <- as.factor(df$TEM_REPROV_POR_NOTA)
df$TEM_REPROV_POR_FALTA <- as.factor(df$TEM_REPROV_POR_FALTA)
df$MEDIA_ZERO <- as.factor(df$MEDIA_ZERO)
df$REP_POR_FALTA_E_MEDIA_ZERO <- as.factor(df$REP_POR_FALTA_E_MEDIA_ZERO)
df <- data.frame(df)
str(df)## 'data.frame': 1871 obs. of 8 variables:
## $ CURSO : Factor w/ 2 levels "ENFERMAGEM - D",..: 1 2 2 1 2 2 2 1 2 1 ...
## $ MEDIA : num 0 7.84 5.37 7 7.87 8.23 3.35 7.34 7.73 7.78 ...
## $ TEM_APROVACAO : Factor w/ 2 levels "FALSE","TRUE": 1 2 2 2 2 2 2 2 2 2 ...
## $ TEM_REPROV_POR_NOTA : Factor w/ 2 levels "FALSE","TRUE": 1 2 2 1 1 1 2 2 1 1 ...
## $ TEM_REPROV_POR_FALTA : Factor w/ 2 levels "FALSE","TRUE": 2 1 1 1 1 1 2 1 1 1 ...
## $ MEDIA_ZERO : Factor w/ 2 levels "FALSE","TRUE": 2 1 1 1 1 1 1 1 1 1 ...
## $ REP_POR_FALTA_E_MEDIA_ZERO: Factor w/ 2 levels "FALSE","TRUE": 2 1 1 1 1 1 1 1 1 1 ...
## $ COD_EVASAO : Factor w/ 2 levels "0","1": 2 1 1 1 1 1 1 1 1 1 ...Agora que temos um dataframe com todas as variáveis consideradas interessantes para analisar o modelo, dividiremos o conjunto de dados em conjuntos de treino e teste. Será feito, então, um treinamento do modelo com uma parte dos dados da amostra e, em seguida, este será testado com a outra parte da amostra, afim de verificar o nível de acerto das suas predições.
trainIndex <- createDataPartition(df$COD_EVASAO, p = .9, list = FALSE, times = 1)
dfTrain <- df[trainIndex,]
dfTest <- df[-trainIndex,]O modelo será treinado através da técnica de floresta de árvores aleatórias.
modelo_de_teste <- C5.0(dfTrain[-8],dfTrain$COD_EVASAO, trials = 10)
modelo_de_teste##
## Call:
## C5.0.default(x = dfTrain[-8], y = dfTrain$COD_EVASAO, trials = 10)
##
## Classification Tree
## Number of samples: 1685
## Number of predictors: 7
##
## Number of boosting iterations: 10 requested; 6 used due to early stopping
## Average tree size: 2.2
##
## Non-standard options: attempt to group attributessummary(modelo_de_teste)##
## Call:
## C5.0.default(x = dfTrain[-8], y = dfTrain$COD_EVASAO, trials = 10)
##
##
## C5.0 [Release 2.07 GPL Edition] Wed Jul 29 19:21:32 2015
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 1685 cases (8 attributes) from undefined.data
##
## ----- Trial 0: -----
##
## Decision tree:
##
## TEM_APROVACAO = FALSE: 1 (172/40)
## TEM_APROVACAO = TRUE: 0 (1513/51)
##
## ----- Trial 1: -----
##
## Decision tree:
##
## REP_POR_FALTA_E_MEDIA_ZERO = FALSE: 0 (1579.5/292.9)
## REP_POR_FALTA_E_MEDIA_ZERO = TRUE: 1 (105.5/35.9)
##
## ----- Trial 2: -----
##
## Decision tree:
##
## MEDIA <= 4.67: 1 (689.5/303.2)
## MEDIA > 4.67: 0 (995.5/201.7)
##
## ----- Trial 3: -----
##
## Decision tree:
##
## MEDIA <= 3.17: 1 (491.2/227.5)
## MEDIA > 3.17: 0 (1193.8/292.6)
##
## ----- Trial 4: -----
##
## Decision tree:
##
## TEM_APROVACAO = FALSE: 0 (397.7/185)
## TEM_APROVACAO = TRUE:
## :...MEDIA <= 1.99: 1 (102.7/40.1)
## MEDIA > 1.99: 0 (1184.6/331.6)
##
## ----- Trial 5: -----
##
## Decision tree:
##
## TEM_APROVACAO = FALSE: 1 (470.5/185.8)
## TEM_APROVACAO = TRUE: 0 (1214.5/416.5)
##
## ----- Trial 6: -----
##
## Decision tree:
## 0 (1663/574.2)
##
## *** boosting reduced to 6 trials since last classifier is very inaccurate
##
##
## Evaluation on training data (1685 cases):
##
## Trial Decision Tree
## ----- ----------------
## Size Errors
##
## 0 2 62( 3.7%)
## 1 2 69( 4.1%)
## 2 2 290(17.2%)
## 3 2 106( 6.3%)
## 4 3 159( 9.4%)
## 5 2 62( 3.7%)
## boost 60( 3.6%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 1507 24 (a): class 0
## 36 118 (b): class 1
##
##
## Attribute usage:
##
## 100.00% TEM_APROVACAO
## 100.00% REP_POR_FALTA_E_MEDIA_ZERO
## 97.98% MEDIA
##
##
## Time: 0.0 secsFaçamos agora o teste de predição através da função predict. Seguem abaixo os resultados obtidos.
teste_predicao <- predict(modelo_de_teste, dfTest)
summary(teste_predicao)## 0 1
## 168 18summary(dfTest$COD_EVASAO)## 0 1
## 166 20Percentual de acerto:
num_acertos <- sum(teste_predicao == dfTest$COD_EVASAO)
num_acertos/length(dfTest$COD_EVASAO)## [1] 0.9139785Para avaliar a precisão da predição, será utilizado como métrica o F-mesure, que consiste em uma média ponderada de precisao e recall. Seguem abaixo a matriz de confusão utilizada para o cálculo e o F-measure.
df_resp <- data.frame(teste_predicao, COD_EVASAO=dfTest$COD_EVASAO, row.names=NULL)
matriz_de_confusao <- table(df_resp)
matriz_de_confusao## COD_EVASAO
## teste_predicao 0 1
## 0 159 9
## 1 7 11#A matriz eh usada pra calcular o F-Measure. F-measure eh a metrica que ele pede no checkpoint pra calcular.df_resp$teste_predicao <- as.numeric(df_resp$teste_predicao) - 1
df_resp$COD_EVASAO <- as.numeric(df_resp$COD_EVASAO) - 1
str(df_resp)## 'data.frame': 186 obs. of 2 variables:
## $ teste_predicao: num 0 0 0 0 0 0 0 0 1 1 ...
## $ COD_EVASAO : num 0 0 0 0 0 0 0 0 0 1 ...summary(df_resp)## teste_predicao COD_EVASAO
## Min. :0.00000 Min. :0.0000
## 1st Qu.:0.00000 1st Qu.:0.0000
## Median :0.00000 Median :0.0000
## Mean :0.09677 Mean :0.1075
## 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :1.00000 Max. :1.0000retrieved <- sum(df_resp$teste_predicao)
precision <- matriz_de_confusao[4]/(matriz_de_confusao[4] + matriz_de_confusao[2])
recall <- matriz_de_confusao[4] / (matriz_de_confusao[4] + matriz_de_confusao[3])
F_measure <- 2 * (precision * recall) / (precision + recall)
F_measure## [1] 0.5789474Agora, os dados que anteriormente foram divididos em grupos de treino e teste serão utilizados inteiramente para teste e será feita a predição em um segundo dataset. Desta forma, será criado um nomo modelo, que será utilizado para os dados deste novo dataset.
modelo_de_submissao <- C5.0(df[-8],df$COD_EVASAO, trials = 10)
modelo_de_submissao##
## Call:
## C5.0.default(x = df[-8], y = df$COD_EVASAO, trials = 10)
##
## Classification Tree
## Number of samples: 1871
## Number of predictors: 7
##
## Number of boosting iterations: 10 requested; 3 used due to early stopping
## Average tree size: 2
##
## Non-standard options: attempt to group attributessummary(modelo_de_submissao)##
## Call:
## C5.0.default(x = df[-8], y = df$COD_EVASAO, trials = 10)
##
##
## C5.0 [Release 2.07 GPL Edition] Wed Jul 29 19:21:32 2015
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 1871 cases (8 attributes) from undefined.data
##
## ----- Trial 0: -----
##
## Decision tree:
##
## TEM_APROVACAO = FALSE: 1 (194/48)
## TEM_APROVACAO = TRUE: 0 (1677/57)
##
## ----- Trial 1: -----
##
## Decision tree:
##
## REP_POR_FALTA_E_MEDIA_ZERO = FALSE: 0 (1741.5/319.1)
## REP_POR_FALTA_E_MEDIA_ZERO = TRUE: 1 (129.5/54.5)
##
## ----- Trial 2: -----
##
## Decision tree:
##
## MEDIA <= 3.17: 1 (557.6/224)
## MEDIA > 3.17: 0 (1313.4/300.7)
##
## ----- Trial 3: -----
##
## Decision tree:
## 0 (1871/657.6)
##
## *** boosting reduced to 3 trials since last classifier is very inaccurate
##
##
## Evaluation on training data (1871 cases):
##
## Trial Decision Tree
## ----- ----------------
## Size Errors
##
## 0 2 105( 5.6%)
## 1 2 116( 6.2%)
## 2 2 156( 8.3%)
## boost 106( 5.7%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 1638 30 (a): class 0
## 76 127 (b): class 1
##
##
## Attribute usage:
##
## 100.00% TEM_APROVACAO
## 100.00% REP_POR_FALTA_E_MEDIA_ZERO
## 98.02% MEDIA
##
##
## Time: 0.0 secsNo código abaixo, é feita a sumarização novamente, desta vez para os novos dados de teste necessários para realizar a prediçao.
test_first_round_kaggle <- read.csv(file = "test_first_round_kaggle.csv", header=TRUE, sep=",")
df_teste <- test_first_round_kaggle %>% group_by(MATRICULA, CURSO) %>% summarise(
MEDIA = round(sum(MEDIA, na.rm = TRUE)/(n() -(ifelse(NA %in% MEDIA, count_NAs(MEDIA) ,0))),digits=2),
TEM_APROVACAO=ifelse("Aprovado" %in% SITUACAO, TRUE, FALSE),
TEM_REPROV_POR_NOTA=ifelse("Reprovado" %in% SITUACAO, TRUE, FALSE),
TEM_REPROV_POR_FALTA=ifelse("Reprovado por Falta" %in% SITUACAO,TRUE,FALSE),
MEDIA_ZERO=ifelse(MEDIA == 0, TRUE, FALSE),
REP_POR_FALTA_E_MEDIA_ZERO = ( TEM_REPROV_POR_FALTA && MEDIA_ZERO))
df_teste$TEM_APROVACAO <- as.factor(df_teste$TEM_APROVACAO)
df_teste$TEM_REPROV_POR_NOTA <- as.factor(df_teste$TEM_REPROV_POR_NOTA)
df_teste$TEM_REPROV_POR_FALTA <- as.factor(df_teste$TEM_REPROV_POR_FALTA)
df_teste$MEDIA_ZERO <- as.factor(df_teste$MEDIA_ZERO)
df_teste$REP_POR_FALTA_E_MEDIA_ZERO <- as.factor(df_teste$REP_POR_FALTA_E_MEDIA_ZERO)
df_teste <- data.frame(df_teste)
str(df_teste)## 'data.frame': 123 obs. of 8 variables:
## $ MATRICULA : int 1565650 8696570 9822368 11928230 35551592 38116320 38449794 51710560 58841481 59967279 ...
## $ CURSO : Factor w/ 2 levels "ENFERMAGEM - D",..: 2 1 2 2 2 1 2 2 1 2 ...
## $ MEDIA : num 3.36 8.34 5 7.81 4.37 1.73 9.21 9.41 7.64 6.29 ...
## $ TEM_APROVACAO : Factor w/ 2 levels "FALSE","TRUE": 2 2 2 2 2 2 2 2 2 2 ...
## $ TEM_REPROV_POR_NOTA : Factor w/ 2 levels "FALSE","TRUE": 2 1 2 1 2 1 1 1 1 2 ...
## $ TEM_REPROV_POR_FALTA : Factor w/ 2 levels "FALSE","TRUE": 1 1 1 1 1 2 1 1 1 1 ...
## $ MEDIA_ZERO : Factor w/ 2 levels "FALSE","TRUE": 1 1 1 1 1 1 1 1 1 1 ...
## $ REP_POR_FALTA_E_MEDIA_ZERO: Factor w/ 2 levels "FALSE","TRUE": 1 1 1 1 1 1 1 1 1 1 ...Em seguida, é feito o teste de predição através da função predict, como exposto abaixo.
predicao <- predict(modelo_de_submissao, df_teste)
summary(predicao)## 0 1
## 118 5Por último, podemos gerar o arquivo que será submetido à competição aberta no Kaggle.
pred <- cbind(df_teste["MATRICULA"], COD_EVASAO=predicao)
ids <- test_first_round_kaggle[c("ID","MATRICULA")]
submissao <- left_join(x=ids, y=pred, by="MATRICULA")
submissao <- submissao[c("ID", "COD_EVASAO")]
write.table(submissao, file="arquivo_submissao-round1.csv", row.names=FALSE, sep=",")