Regressão Romântica

As variáveis usadas neste experimento são: attr, que indica o quão atraente a pessoa 1 (P1) achou a pessoa 2 (P2); sinc, que indica o quão P1 achou P2 sincero; intel, que indica o quão P1 achou P2 inteligente; e a variável fun, que indica o quão P1 achou P2 divertido. A ideia é descobrir qual o efeito dessas variáveis na chance do casal ter match. No caso, nossa variável de interesse é a dec, que indica se houve match entre os dois participantes do encontro.

bm <- glm(dec ~ attr + sinc + intel + fun , 
          data = dados, 
          family = "binomial")
glimpse(bm)

Abaixo, a tabela nos mostra que a estimativa o odds é multiplicado por 1.76 quando P1 acha P2 atraente, ou seja, aumenta o odds em 76%, logo essa variável tem um efeito positivo relevante sobre a variável de resposta. Já a variável sinceridade o odds é multiplicado por 0.92, ou seja, diminui o odds em 8%, logo essa variável tem um efeito negativo sobre a variável de resposta. A variável de inteligência multiplica o odds em 0.95, ou seja, diminui o odds em 5%, logo essa variável tem um efeito negativo sobre a variável de resposta. Por fim, a variável fun multiplica o odds em 1.40, ou seja, aumenta o odds em 40%, logo essa variável tem um efeito positivo sobre a variável de resposta. Assim, P1 achar P2 atranente é a variável que mais tem efeito na chance de o match acontecer entre os participantes.

tidy(bm, conf.int = TRUE, exponentiate = TRUE) %>% select(-p.value)

NA

Nesse tipo de análise com regressão logística não temos um R² análogo ao R² da regressão linear. Aqui, temos um pseudo-R² onde usaremos o R² McFadden que é mais ou menos equivalente ao da regressão linear, mas com limitações. Vendo esse dado, temos que o modelo se ajusta aos dados em 0.228 (22,8%), ou seja, o modelo não se adequa tão bem aos dados.

pR2(bm)

fitting null model for pseudo-r2
          llh       llhNull            G2      McFadden          r2ML          r2CU 
-2451.7238932 -3176.1314982  1448.8152102     0.2280786     0.2672651     0.3591209 

Deixando as variáveis sinc e intel fixas, podemos observar melhor os efeitos que attr e fun exercem sobre o odds de dar match. O gráfico abaixo mostra justamente isso. Nele, podemos ver que as duas variáveis tem muita influência positiva, pois ambas aumentam à medida que aumenta o fitted. Além disso, podemos notar que fun exerce uma influência um pouco menor pois cresce um pouco mais lento que attr.

m = dados %>%
  data_grid(attr  , 
            sinc = median(sinc) ,
            intel= median(intel),
            fun)

mm = augment(bm, 
             newdata = m, 
             type.predict = "response")

bm %>% 
  augment(newdata = m, type.predict = "response")  %>% 
  ggplot(aes(x = fun, colour = factor(attr))) + 
  geom_line(aes(y = .fitted)) 

Deixando as variáveis attr e fun fixas, podemos observar melhor os efeitos que attr e fun exercem sobre odds de dar match. O gráfico abaixo mostra justamente isso. Nele, podemos ver que as duas variáveis tem influência negativa, pois ambas diminuem à medida que aumenta o fitted. Além disso, podemos notar que o grau de influência delas são muito parecidas.

m = dados %>%
  data_grid(attr  = median(attr), 
            sinc ,
            intel,
            fun = median(fun))

mm = augment(bm, 
             newdata = m, 
             type.predict = "response")

bm %>% 
  augment(newdata = m, type.predict = "response")  %>% 
  ggplot(aes(x = intel, colour = factor(sinc))) + 
  geom_line(aes(y = .fitted)) 

Em relação aos intervalos de confiança, podemos observar que sinc está completamente abaixo de 1 indicando que essa variável tem efeito negativo e diminui o odds de dar match entre os participantes. Já em relação a intel, não podemos falar muito porque, apesar de da maior parte do intervalo de confiança estar abaixo de 1, ainda tem valores acima de 1. Portanto, o efeito pode ser negativo ou positivo e, por isso, não podemos dizer nada. Já as variáveis fun e attr tem efeito positivo muito relevante, onde attr tem o maior efeito. Logo, attr e fun influenciam positivamente o odds de dar match entre os participantes.

tidy(bm, conf.int = TRUE, exponentiate = TRUE) %>% 
  filter(term != "(Intercept)") %>% 
  ggplot(aes(x = term, y = estimate, ymin = conf.low, ymax = conf.high)) + 
  geom_point() + 
  geom_linerange() + 
  coord_flip()