Regressão Logística: Utilizando dados românticos

library(tidyverse)
library(broom)

data = read_csv("https://raw.githubusercontent.com/nazareno/ciencia-de-dados-1/master/5-regressao/speed-dating/speed-dating2.csv", col_types = 
               cols(
                      .default = col_double(),
                      field = col_character(),
                      from = col_character(),
                      career = col_character(),
                      dec = col_character()
                    )) %>% 
        mutate(dec = as.factor(dec), gender = as.factor(gender))

Os dados que iremos utilizar para essa análise são dados que descrevem 5000 encontros relâmpagos ou speed dating. Esses encontros ocorrem em uma duração de 4 minutos e envolveram 310 jovens dos Estados Unidos. Logo após esses encontros, os jovens preenchiam uma ficha avaliando as pessoas com quem eles se encontraram.

As fichas preenchidas continham diversas informações, entre elas estão:

• attr: Indica o quão atraente a pessoa_1 achou da pessoa_2
• sinc: Indica o quão sincera a pessoa_1 achou da pessoa_2
• intel: Indica o quão inteligente a pessoa_1 achou da pessoa_2
• fun: Indica o quão divertida a pessoa_1 achou da pessoa_2
• amb: Indica o quão ambiciosa a pessoa_1 achou da pessoa_2
• shar: Indica o quanto a pessoa_1 compartilha de interesses semelhantes com a pessoa_2

A informação que queremos entender desses dados é se elas são um conjunto de variáveis explicativas para predizer o valor de ‘dec’. E o que seria o dec ? É simplesmente se houve um match entre as pessoas nesse encontro.

Para começar, vamos visualizar a distribuição dos valores de cada uma dessas variáveis em relação ao ‘dec’.

Attr:

data %>%
    ggplot(aes(x = dec, y = attr)) +
    geom_violin(aes(fill = dec)) + 
    geom_count() +
    coord_flip()

Warning: Removed 118 rows containing non-finite values (stat_ydensity).
Warning: Removed 118 rows containing non-finite values (stat_sum).

Sinc:

data %>%
    ggplot(aes(x = dec, y = sinc)) +
    geom_violin(aes(fill = dec)) + 
    geom_count() +
    coord_flip()

Warning: Removed 161 rows containing non-finite values (stat_ydensity).
Warning: Removed 161 rows containing non-finite values (stat_sum).

Intel:

data %>%
    ggplot(aes(x = dec, y = intel)) +
    geom_violin(aes(fill = dec)) + 
    geom_count() +
    coord_flip()

Warning: Removed 166 rows containing non-finite values (stat_ydensity).
Warning: Removed 166 rows containing non-finite values (stat_sum).

Fun:

data %>%
    ggplot(aes(x = dec, y = fun)) +
    geom_violin(aes(fill = dec)) + 
    geom_count() +
    coord_flip()

Warning: Removed 197 rows containing non-finite values (stat_ydensity).
Warning: Removed 197 rows containing non-finite values (stat_sum).

Amb:

data %>%
    ggplot(aes(x = dec, y = amb)) +
    geom_violin(aes(fill = dec)) + 
    geom_count() +
    coord_flip()

Warning: Removed 421 rows containing non-finite values (stat_ydensity).
Warning: Removed 421 rows containing non-finite values (stat_sum).

Shar:

data %>%
    ggplot(aes(x = dec, y = shar)) +
    geom_violin(aes(fill = dec)) + 
    geom_count() +
    coord_flip()

Warning: Removed 643 rows containing non-finite values (stat_ydensity).
Warning: Removed 643 rows containing non-finite values (stat_sum).

É interessante ver que para quase todo, as variáveis influenciaram de alguma maneira, nem que seja pouca, para que a pessoa_1 marcasse um match com a pessoa_2. Um variável que das observadas acima que não demonstraram uma diferença visual foi a de Ambição, algo bem interessante!

Podemos portanto, iniciar nosso planejamento em criar um modelo de regressão logística que realize um treinamento sobre os dados presentes e nos informe os valores de coeficientes encontrados!

model_matches = glm(dec ~ attr + sinc + intel + fun + amb + shar, 
                  data = data, 
                  family = "binomial")

tidy(model_matches, conf.int = TRUE, exponentiate = TRUE)

summary(model_matches, conf.int = TRUE, exponentiate = TRUE)

Call:
glm(formula = dec ~ attr + sinc + intel + fun + amb + shar, family = "binomial", 
    data = data)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.5362  -0.8250  -0.3011   0.8392   3.4541  

Coefficients:
             Estimate Std. Error z value Pr(>|z|)    
(Intercept) -5.104342   0.243021 -21.004  < 2e-16 ***
attr         0.562454   0.028511  19.727  < 2e-16 ***
sinc        -0.129343   0.031508  -4.105 4.04e-05 ***
intel        0.006912   0.038536   0.179    0.858    
fun          0.258122   0.030706   8.406  < 2e-16 ***
amb         -0.193363   0.030457  -6.349 2.17e-10 ***
shar         0.323160   0.024189  13.360  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 5625.5  on 4127  degrees of freedom
Residual deviance: 4139.8  on 4121  degrees of freedom
  (790 observations deleted due to missingness)
AIC: 4153.8

Number of Fisher Scoring iterations: 5

Dado o resultado calculado pelo modelo acima, podemos ver que o impacto positivo estão mais associados as variáveis de ‘fun’, ‘attr’ e ‘shar’, ou seja, pessoas divertidas, atraentes e que compartilham os mesmos interesses respectivamente.

Para os valores estimados pelo nosso modelo de regressão logística, temos os seguintes resultados:

attr: Sempre que o attr aumentar uma unidade, as chances do match ocorrer é de 75%. Segundo a nossa amostra, o IC encontrado com uma confiança de 95% pode variar entre [1.63, 1.82], ou seja, chances de 63% a 82%.

sinc: Sempre que o sinc aumentar uma unidade, as chances do match ocorrer é de -12,93%, (os valores podem ser melhor vistos na sumarização disposta na célula acima). Segundo a nossa amostra, o IC encontrado com uma confiança de 95% pode variar entre [0.825, 0.934], ou seja, chances de -0.1740% a -0.0654%.

intel: Sempre que o intel aumentar uma unidade, as chances do match ocorrer é de 0.69%. Segundo a nossa amostra, o IC encontrado com uma confiança de 95% pode variar entre [0.933, 1.085], ou seja, chances de -0.66% a 0.85%.

fun: Sempre que o fun aumentar uma unidade, as chances do match ocorrer é de 29,44%. Segundo a nossa amostra, o IC encontrado com uma confiança de 95% pode variar entre [1.21, 1.37], ou seja, chances de 21% a 37%.

amb: Sempre que o amb aumentar uma unidade, as chances do match ocorrer é de -17,59%. Segundo a nossa amostra, o IC encontrado com uma confiança de 95% pode variar entre [0.776, 0.874], ou seja, chances de -22,4% a -12,6%.

shar: Sempre que o shar aumentar uma unidade, as chances do match ocorrer é de 38,14%. Segundo a nossa amostra, o IC encontrado com uma confiança de 95% pode variar entre [1.31, 1.4490], ou seja, chances de 31% a 44%.