Churn prediction

Regressão logística


In [2]:
df <- read.csv('evasao.csv')
head(df)
str(df)
summary(df)


periodobolsarepetiuematrasodisciplinasfaltasdesempenhoabandonou
2 0.25 8 1 4 0 0.0000001
2 0.15 3 1 3 6 5.3333330
4 0.10 0 1 1 0 8.0000000
4 0.20 8 1 1 0 4.0000001
1 0.20 3 1 1 1 8.0000000
5 0.20 2 1 2 0 3.5000001
'data.frame':	300 obs. of  8 variables:
 $ periodo    : int  2 2 4 4 1 5 9 2 9 5 ...
 $ bolsa      : num  0.25 0.15 0.1 0.2 0.2 0.2 0.1 0.15 0.15 0.15 ...
 $ repetiu    : int  8 3 0 8 3 2 6 3 7 3 ...
 $ ematraso   : int  1 1 1 1 1 1 1 0 1 0 ...
 $ disciplinas: int  4 3 1 1 1 2 1 2 5 1 ...
 $ faltas     : int  0 6 0 0 1 0 1 2 10 1 ...
 $ desempenho : num  0 5.33 8 4 8 ...
 $ abandonou  : int  1 0 0 1 0 1 0 1 0 0 ...
    periodo          bolsa           repetiu         ematraso     
 Min.   : 1.00   Min.   :0.0000   Min.   :0.000   Min.   :0.0000  
 1st Qu.: 3.00   1st Qu.:0.0500   1st Qu.:0.000   1st Qu.:0.0000  
 Median : 5.00   Median :0.1000   Median :2.000   Median :0.0000  
 Mean   : 5.46   Mean   :0.1233   Mean   :2.777   Mean   :0.4767  
 3rd Qu.: 8.00   3rd Qu.:0.2000   3rd Qu.:5.000   3rd Qu.:1.0000  
 Max.   :10.00   Max.   :0.2500   Max.   :8.000   Max.   :1.0000  
  disciplinas        faltas         desempenho       abandonou   
 Min.   :0.000   Min.   : 0.000   Min.   : 0.000   Min.   :0.00  
 1st Qu.:1.000   1st Qu.: 0.000   1st Qu.: 0.400   1st Qu.:0.00  
 Median :2.000   Median : 1.000   Median : 2.000   Median :0.00  
 Mean   :2.293   Mean   : 2.213   Mean   : 2.623   Mean   :0.41  
 3rd Qu.:4.000   3rd Qu.: 4.000   3rd Qu.: 4.000   3rd Qu.:1.00  
 Max.   :5.000   Max.   :10.000   Max.   :10.000   Max.   :1.00  

In [3]:
table(is.na(df))


FALSE 
 2400 

Separando dados de treino e de teste:


In [18]:
n <- nrow(df)
set.seed(42) # Se não fizer isso, verá valores diferentes dos meus
limite <- sample(1:n, size = round(0.75*n), replace = FALSE)
train_df <- df[limite,]
test_df <- df[-limite,]

head(train_df)
length(train_df$periodo)


periodobolsarepetiuematrasodisciplinasfaltasdesempenhoabandonou
275 2 0.150 1 1 0 10.00
281 9 0.002 1 5 0 0.80
86 9 0.103 0 1 2 6.00
247 8 0.158 0 0 0 0.00
190 9 0.256 0 3 0 1.01
15410 0.203 1 2 2 5.00
225

Criando e treinando o modelo:


In [19]:
modelo <- glm('abandonou ~ periodo + bolsa + repetiu + ematraso + disciplinas + faltas + desempenho', data = train_df, family = 'binomial')
summary(modelo)


Call:
glm(formula = "abandonou ~ periodo + bolsa + repetiu + ematraso + disciplinas + faltas + desempenho", 
    family = "binomial", data = train_df)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.1118  -0.8458  -0.4490   0.9895   1.8442  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -1.22157    0.55658  -2.195 0.028180 *  
periodo     -0.03821    0.05343  -0.715 0.474563    
bolsa        0.33331    1.79914   0.185 0.853026    
repetiu      0.38381    0.06928   5.540 3.03e-08 ***
ematraso     0.45097    0.31782   1.419 0.155920    
disciplinas  0.13612    0.10848   1.255 0.209565    
faltas       0.03512    0.06627   0.530 0.596155    
desempenho  -0.26800    0.07315  -3.664 0.000249 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 305.12  on 224  degrees of freedom
Residual deviance: 247.74  on 217  degrees of freedom
AIC: 263.74

Number of Fisher Scoring iterations: 4

Verificando a relevância dos coeficientes com anova():


In [20]:
anova(modelo, test = "Chisq")


DfDevianceResid. DfResid. DevPr(>Chi)
NULLNA NA224 305.1220 NA
periodo 1 0.617576197223 304.5044 4.319494e-01
bolsa 1 0.490419075222 304.0140 4.837404e-01
repetiu 1 35.991536814221 268.0224 1.981764e-09
ematraso 1 1.144289681220 266.8781 2.847477e-01
disciplinas 1 3.025633226219 263.8525 8.195832e-02
faltas 1 0.003532531218 263.8490 9.526056e-01
desempenho 1 16.109767574217 247.7392 5.977494e-05

Vamos criar um novo modelo com apenas as variáveis relevantes: "repetiu" e "desempenho":


In [21]:
train_r <- subset(train_df,select = c('repetiu','desempenho','abandonou'))

modelo2 <- glm('abandonou ~ repetiu + desempenho', data = train_r, family = 'binomial')
summary(modelo2)
anova(modelo2, test = "Chisq")


Call:
glm(formula = "abandonou ~ repetiu + desempenho", family = "binomial", 
    data = train_r)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.1034  -0.8348  -0.5126   1.0583   1.8926  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -0.74067    0.27015  -2.742 0.006113 ** 
repetiu      0.35462    0.06585   5.385 7.23e-08 ***
desempenho  -0.24450    0.06887  -3.550 0.000385 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 305.12  on 224  degrees of freedom
Residual deviance: 254.46  on 222  degrees of freedom
AIC: 260.46

Number of Fisher Scoring iterations: 4
DfDevianceResid. DfResid. DevPr(>Chi)
NULLNA NA 224 305.1220 NA
repetiu 1 35.92344 223 269.1985 2.052247e-09
desempenho 1 14.73577 222 254.4628 1.236775e-04

Testando o modelo:


In [23]:
test_r <- subset(test_df,select = c('repetiu','desempenho','abandonou'))
resultados <- predict(modelo2,newdata = test_r, type = 'response')
resultados_ar <- ifelse(resultados > 0.5, 1, 0)
erroMedio <- mean(resultados_ar != test_r$abandonou)
print(paste('Precisão modelo reduzido:',1 - erroMedio))


[1] "Precisão modelo reduzido: 0.573333333333333"

Não é um resultado muito bom... 57% Mas é melhor do que nada. Talvez, a adição de outras variáveis ou um novo levantamento ajudem a resolver.


In [28]:
df_predicao <- data.frame(desempenho = test_r$desempenho, 
                          repetiu = test_r$repetiu, 
                          abandonou_obs = test_r$abandonou, 
                          abandonou_pred = resultados_ar)

In [29]:
head(df_predicao)


desempenhorepetiuabandonou_obsabandonou_pred
38.0000000 0 0
44.0000008 1 1
72.0000006 0 1
92.8000007 0 1
112.6666675 0 1
179.0000000 0 0

In [ ]: