O problema

O objetivo desse laboratório é utilizar regressão logística com um conjunto de variáveis explicativas (com no mínimo 4 variáveis) para responder o seguinte:

  • Que fatores nos dados têm efeito relevante na chance do casal ter um match? Descreva se os efeitos são positivos ou negativos e sua magnitude.

Os dados

Temos dados descrevendo cerca de 5000 encontros relâmpagos (speed dating) de 4 minutos cada, envolvendo 310 jovens americanos. Após cada encontro, uma ficha de avaliação foi preenchida pelos participantes e cada entrada dos dados representam um desses encontros. Os dados originais foram coletados por professores da Columbia Business School no experimento descrito aqui.

As variáveis utilizadas são:

  • iid : id do participante p1 no encontro
  • gender : sexo do p1, 0 = mulher
  • order : dos vários encontros realizados em uma noite, esse foi o n-ésimo, segundo essa variável
  • pid : id do participante p2
  • int_corr : correlação entre os interesses de p1 e p2
  • samerace : p1 e p2 são da mesma raça?
  • age_o : idade de p2
  • age : idade de p1
  • field : campo de estudo de p1
  • race : raça de p1. O código é Black/African American=1; European/Caucasian-American=2; Latino/Hispanic American=3; Asian/Pacific Islander/Asian-American=4; Native American=5; Other=6
  • from : de onde p1 é
  • career : que carreira p1 quer seguir
  • sports, tvsports, exercise, dining, museums, art, hiking, gaming, clubbing, reading, tv, theater, movies, concerts, music, shopping, yoga : De 1 a 10, quão interessado p1 é em cada uma dessas atividades.
  • attr : quão atraente p1 achou p2
  • sinc : quão sincero p1 achou p2
  • intel : quão inteligente p1 achou p2
  • fun : quão divertido p1 achou p2
  • amb : quão ambicioso p1 achou p2
  • shar : quanto p1 achou que compartilha interesses e hobbies com p2
  • like : no geral, quanto p1 gostou de p2?
  • prob : que probabilidade p1 acha que p2 tem de querer se encontrar novamente com p- (escala 1-10)
  • attr3_s : quanto p1 acha que é atraente
  • sinc3_s : quanto p1 acha que é sincero
  • intel3_s : quanto p1 acha que é inteligente
  • fun3_s : quanto p1 acha que é divertido
  • amb3_s : quanto p1 acha que é ambicioso
  • dec: se houve um match entre os dois participantes do encontro
dados <- read_csv(here("speed-dating/speed-dating2.csv")) %>% 
  select(-iid, -pid, -match_es) %>% 
  mutate(dec = as.factor(dec), 
         gender = as.factor(gender), 
         samerace = as.factor(samerace),
         race = as.factor(race)
         )

Fazendo uma breve análise exploratória dos dados, temos:

skimr::skim(dados)
Data summary
Name dados
Number of rows 4918
Number of columns 41
_______________________
Column type frequency:
character 3
factor 4
logical 5
numeric 29
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
field 20 1.00 3 51 0 148 0
from 36 0.99 2 58 0 172 0
career 46 0.99 2 77 0 218 0

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
gender 0 1 FALSE 2 1: 2464, 0: 2454
samerace 0 1 FALSE 2 0: 2920, 1: 1998
race 20 1 FALSE 5 2: 2843, 4: 1111, 3: 399, 6: 301
dec 0 1 FALSE 2 no: 2873, yes: 2045

Variable type: logical

skim_variable n_missing complete_rate mean count
attr3_s 4918 0 NaN :
sinc3_s 4918 0 NaN :
intel3_s 4918 0 NaN :
fun3_s 4918 0 NaN :
amb3_s 4918 0 NaN :

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
order 0 1.00 9.26 5.67 1.00 4.00 9.00 14.00 22.0 ▇▆▅▃▂
int_corr 72 0.99 0.19 0.31 -0.73 -0.03 0.21 0.43 0.9 ▁▅▇▇▂
age_o 61 0.99 25.79 3.35 18.00 23.00 25.00 28.00 39.0 ▃▇▆▁▁
age 52 0.99 25.78 3.35 18.00 23.00 25.00 28.00 39.0 ▃▇▆▁▁
sports 36 0.99 6.40 2.57 1.00 5.00 7.00 8.00 10.0 ▂▅▆▇▆
tvsports 36 0.99 4.53 2.82 1.00 2.00 4.00 7.00 10.0 ▇▆▅▅▃
exercise 36 0.99 6.12 2.33 1.00 5.00 6.00 8.00 10.0 ▂▃▇▇▃
dining 36 0.99 7.69 1.79 1.00 7.00 8.00 9.00 10.0 ▁▁▃▇▇
museums 36 0.99 6.88 2.08 0.00 6.00 7.00 8.00 10.0 ▁▂▃▇▅
art 36 0.99 6.59 2.29 0.00 5.00 7.00 8.00 10.0 ▁▃▅▇▅
hiking 36 0.99 5.77 2.56 0.00 4.00 6.00 8.00 10.0 ▃▆▇▇▅
gaming 36 0.99 4.02 2.67 0.00 2.00 4.00 6.00 14.0 ▇▇▅▁▁
clubbing 36 0.99 5.73 2.45 0.00 4.00 6.00 8.00 10.0 ▃▅▆▇▃
reading 36 0.99 7.64 2.02 1.00 7.00 8.00 9.00 13.0 ▁▂▇▇▁
tv 36 0.99 5.29 2.45 1.00 3.00 6.00 7.00 10.0 ▅▅▇▇▂
theater 36 0.99 6.72 2.25 0.00 5.00 7.00 8.00 10.0 ▁▃▅▇▆
movies 36 0.99 7.98 1.67 0.00 7.00 8.00 9.00 10.0 ▁▁▂▇▇
concerts 36 0.99 6.82 2.10 0.00 6.00 7.00 8.00 10.0 ▁▂▆▇▅
music 36 0.99 7.78 1.84 1.00 7.00 8.00 9.00 10.0 ▁▁▃▇▇
shopping 36 0.99 5.48 2.57 1.00 3.00 6.00 7.00 10.0 ▆▅▇▆▅
yoga 36 0.99 4.21 2.71 0.00 2.00 4.00 6.00 10.0 ▇▅▅▃▂
attr 118 0.98 6.06 1.95 0.00 5.00 6.00 7.00 10.0 ▁▃▇▇▂
sinc 161 0.97 7.05 1.81 0.00 6.00 7.00 8.00 10.0 ▁▁▅▇▃
intel 166 0.97 7.27 1.59 0.00 6.00 7.00 8.00 10.0 ▁▁▃▇▃
fun 197 0.96 6.29 1.98 0.00 5.00 6.00 8.00 10.0 ▁▂▇▇▂
amb 421 0.91 6.70 1.83 0.00 6.00 7.00 8.00 10.0 ▁▂▇▇▃
shar 643 0.87 5.32 2.16 0.00 4.00 5.00 7.00 10.0 ▂▅▇▅▁
like 122 0.98 6.05 1.85 0.00 5.00 6.00 7.00 10.0 ▁▂▇▇▂
prob 156 0.97 5.02 2.17 0.00 4.00 5.00 7.00 10.0 ▃▅▇▅▁

Análise dos dados

A partir do resumo acima, podemos ver os dados de acordo com os tipos dos dados: textuais, categóricos, booleanos e numéricos.

  • Sobre os dados textuais, vemos que existe uma grande variedade de dados com relação às variáveis desse tipo, como é indicado por n_unique.
  • Com relação aos dados categóricos, vemos que há pouca diferença com relação aos gêneros, havendo apenas 10 homens a mais do que mulheres. Vemos também que na maioria das vezes (2920 ocorrências) os dois participantes são da mesma raça, como mostrado por samerace. A distribuição de race nos mostra que há uma predominancia de pessoas brancas e asiáticas, havendo pouca diversidade racial entre os participantes do estudo. Por fim, observamos pela variável dec que na maioria das vezes não houve match entre os participantes, com 2873 casos.
  • Entre as variáveis booleanas, todas as entradas são NAs e não serão úteis para a análise final.
  • Dos dados numéricos observamos que todas as variáveis estão bem distribuidas, não havendo cassos de muita concentração em determinada faixa de valores. Podemos ressaltar a variável age, mostrando que a maioria dos participantes tem uma idade próxima dos 25 anos, e a variável int_corr, onde vemos que a correlação dos interesses dos participantes geralmente é baixa.

Modelo de regressão logística

Desejamos entender quais fatores têm efeito relevante na chance do casal ter um match e para isso precisamos primeiro obter um subconjunto das variáveis mais relevantes. Para isso, iremos analisar a correlação das variávei e construir um modelo de regressão logística. Esse tipo de regressão será utilizada por conta da variável alvo ser categórica (dec), já que desejamos entender se houve match ou não. As variáveis selecionadas foram: attr, fun, shar e prob. Analisando a correlação entre elas e dec, temos:

dados %>% 
  select(dec, attr, fun, shar, prob) %>% 
  ggpairs()

A matriz de correlação das variáveis selecionadas não indicou nenhum par de variáveis que possui uma correlação muito alta, onde um mesmo efeito seria encontrado pelas mesmas variáveis. Dessa forma, observamos que essa seleção de variáveis é uma opção viável para a construção de um modelo de regressão.

modelo <- glm(dec ~ attr + fun + shar + prob, data = dados %>% select(dec, attr, fun, shar, prob), family = "binomial")
tidy(modelo, conf.int = TRUE, conf.level = 0.95)
## # A tibble: 5 x 7
##   term        estimate std.error statistic   p.value conf.low conf.high
##   <chr>          <dbl>     <dbl>     <dbl>     <dbl>    <dbl>     <dbl>
## 1 (Intercept)   -6.66     0.224     -29.7  2.17e-194  -7.10      -6.23 
## 2 attr           0.547    0.0279     19.6  2.02e- 85   0.492      0.602
## 3 fun            0.119    0.0274      4.36 1.32e-  5   0.0658     0.173
## 4 shar           0.213    0.0239      8.91 5.25e- 19   0.166      0.260
## 5 prob           0.194    0.0208      9.33 1.10e- 20   0.154      0.235

A partir do modelo produzido e tratando as variáveis em conjunto, temos que a variável que mais influencia para o match é attr (quão atraente p1 achou p2), com um efeito estimado de 0.546, com IC de 95% [0.492, 0.601]. Por outro lado, fun (quão divertido p1 achou p2) foi a variável com a menor influencia no match, com um efeito estimado de 0.119, com IC de 95% [0.065, 0.173]. As outras duas variáveis, shar e prob também tem um efeito muito baixo no match, com um efeito menor do que a metade do efeito de attr. Dessa maneira, podemos dizer que considerar uma pessoa atraente tem um efeito muito maior do que achar o outro divertido, compartilhar interesses ou ter uma alta probabilidade de encontrar a pessoa novamente.

Para verificar quão bem o modelo está ajustado aos dados, não podemos utilizar o R2 já que ele é utilizado para modelos de regressão linear. Entretanto, podemos aplicar o R2 de McFadden, ou Pseudo-R2.

pR2(modelo)
## fitting null model for pseudo-r2
##           llh       llhNull            G2      McFadden          r2ML 
## -2105.4318286 -2880.6466072  1550.4295571     0.2691114     0.3071665 
##          r2CU 
##     0.4127103

A partir dessa análise, vemos que o modelo explica cerca de 26% dos dados, o que é uma avaliação ruim do modelo. Logo, selecionar essas variáveis para explicar o match pode não ser uma boa ideia.