Regressão logistica

Regressão Romântica

Os dados

Temos dados descrevendo 5000 encontros relâmpagos (speed dating, procura no google) de 4 minutos envolvendo 310 jovens americanos. Os dados originais foram coletados por professores da Columbia Business School no experimento descrito aqui. Aqui estamos usando uma versão com menos colunas para agilizar para vocês.

Os participantes tinham vários encontros de 4 minutos por noite. Após cada um, preenchiam fichas avaliando aqueles com quem se encontraram. Cada linha nos dados representa um desses encontros.

As perguntas

O que causa atração à primeira vista? E como isso varia para diferentes sexos? Pessoas de diferentes backgrounds? O que são as características mais e menos importantes para um homem/mulher ser percebido bem em um speed date? Que grupos são mais otimistas e pessimistas após o encontro?

As variáveis

OBS : NAs serão omitidas.

• 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 probabiliade 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

dados <- read_csv("speed-dating/speed-dating2.csv")

Rows: 4918 Columns: 44
-- Column specification ---------------------------------------------------------------------------------------
Delimiter: ","
chr  (4): field, from, career, dec
dbl (40): iid, gender, order, pid, int_corr, samerace, age_o, age, race, sports, tvsports, exercise, dining...

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.

dados <- dados %>%
  select(dec, attr, intel, music, fun) %>% 
  na.omit() %>% 
  mutate(dec = as.factor(dec))
#ggpairs(dados, progress = F)
glimpse(dados)

Rows: 4,649
Columns: 5
$ dec   <fct> yes, yes, yes, yes, yes, no, yes, no, yes, yes, no, no, no, yes, no, no, yes, no, yes, yes, no,~
$ attr  <dbl> 6, 7, 5, 7, 5, 4, 7, 4, 7, 5, 5, 8, 5, 7, 6, 8, 7, 5, 7, 6, 7, 9, 7, 9, 9, 8, 8, 7, 9, 8, 4, 8,~
$ intel <dbl> 7, 7, 9, 8, 7, 7, 7, 7, 8, 6, 8, 6, 9, 7, 7, 8, 9, 7, 8, 8, 10, 9, 9, 9, 10, 10, 10, 9, 9, 9, 8~
$ music <dbl> 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 7, 7,~
$ fun   <dbl> 7, 8, 8, 7, 7, 4, 4, 6, 9, 8, 4, 6, 6, 6, 9, 3, 6, 5, 9, 7, 7, 8, 7, 7, 10, 7, 7, 8, 9, 7, 5, 1~

EDA

Para nossa análise, utilizaremos apenas as variáveis:

• attr : quão atraente p1 achou p
• fun : quão divertido p1 achou p2
• intel : quão inteligente p1 achou p2
• music : o quanto participante gosta de música

a = dados %>% 
  ggplot(aes(x = music, fill = dec)) + 
  geom_bar(position = "dodge")

b = dados %>% 
  ggplot(aes(x = attr, fill = dec)) + 
  geom_bar(position = "dodge")

c = dados %>% 
  ggplot(aes(x = intel, fill = dec)) + 
  geom_bar(position = "dodge")

d = dados %>% 
  ggplot(aes(x = fun, fill = dec)) + 
  geom_bar(position = "dodge")

grid.arrange(a,b,c,d)

Com o gráfico apresentado acima, podemos observar que ser atraente e divertido com pontuações acima de 7 tem mais chances de acontecer um match, enquanto que gostar de música tem peso um pouco menos relevante na hora dos participantes ecolherem se encontrar de novo. Já se a pessoa é inteligente, começa ter um peso um pouco maior (para match positivo) quando a pontuação passa dos 8, porém esses casos acontecem com menor frequência.

Fit

Há um processo semelhante a OLS para encontrar \(b_0\) e \(b_1\) em um modelo do tipo y = exp(b0 + b1 * x) / (1 + exp(b0 + b1 * x)), ou \(y = \frac{e^{b_0 + b_1.X_1}}{1 + e^{b_0 + b_1.X_1}}\).

Ele se chama máxima verossimilhança, ou maximum likelihood. Não vamos discutí-lo em detalhes, mas vale saber que não há forma fechada para os coeficientes, mas há solução eficiente mesmo para muitas variáveis.

Interpretação

Lembre que temos escrito \(y\), mas nossa variável de resposta é \(p(y = 1 | x)\), ou seja, a probabilidade de \(y=1\) dado o valor de \(x\). Para facilitar, vamos escrever \(p(x)\) para significar \(p(y = 1 | x)\). Se manipularmos \(p(x) = \frac{e^{b_0 + b_1.X_1}}{1 + e^{b_0 + b_1.X_1}}\), chegamos facilmente em:

\(\frac{p(x)}{1-p(x)} = e^{b_0 + b_1.X_1} = e^{b_0}. e^{b_1.X_1}\) O termo \(\frac{p(x)}{1-p(x)}\) tem uma interpretação: ele é o odds do evento \(y = 1\), que é a razão entre a probabilidade de y ser 1 e de y ser 0 quando x tem um certo valor. Ou “quão maior é a chance de y ser 1 do que ser 0”, dado x.

Isso é útil porque \(X_1\) tem um efeito interpretável no odds:

\(x =0: odds = e^{b_0}. e^{b_1.0} = e^{b_0}\\ x =1: odds = e^{b_0}. e^{b_1.1} = e^{b_0}. e^{b_1}\\ x =2: odds = e^{b_0}. e^{b_1.2} = e^{b_0}. e^{b_1}. e^{b_1}\\\)

Ou seja, aumentar uma unidade em \(X_1\) multiplica o odds por $e^{b_1}$. Repare que essa não é uma interpretação do efeito de $X_1$ em $p(x)$. A relação entre $X_1$ em $p(x)$ é mais complexa e não tem uma interpretação mais intuitiva que essa. Por isso tipicamente usamos o odds pra discutir modelos logísticos.

Multivariada:

bm <- glm(dec ~ attr + music + fun + intel, 
          data = dados_t, 
          family = "binomial")

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

#glance(bm)
#pR2(bm)

A partir dos valores gerados na tabela acima, a formula que representa o modelo dos dados é a seguinte:

\(p(match) = \frac{e^{0.0062 + attr*1.74 + music*0.97 + fun*1.39 + intel*0.91}}{1 + e^{0.0062 + attr*1.74 + music*0.97 + fun*1.39 + intel*0.91}}\)

\(\frac{p(match)}{1 - p(match)} = e^{0.0062} e^{attr*1.74} e^{music*0.97} e^{fun*1.4} e^{intel*0.91}\)

Todas as variáveis abordadas têm avaliação em escala que varia de 1 a 10, ou seja, para cada variável que aumenta em 1 ponto podemos observar que a variável attr possui um oddis de 74% de chances a mais para acontecer um match. Já o music apresentou um oddis de 3% de chances de ambos escolherem se encontrar de novo. O fun tem 40% a mais da chance de acontercer um match. Por fim, o intel tem 9% de a menos de chance de acontecer um match. Com isso, podemos deduzir que ser atraente tende a ter um peso maior na decisão de ambos optarem por se encontrar de novo. Para reafirmar essa hipotese, vamos verificar os ICs (com confiança de 95%) a seguir:

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

• attr [IC 65%, 83%]: mostrou ter um efeito grande positivamente na decisão de um próximo encontro.
• music [IC -7%, 0,5%]: apresentou um efeito pequeno que pode ser positivo com pouca ou nenhuma relevancia ou ter efeito pequeno e negativo para que aconteça um match.
• fun [IC 33%, 47%]: apresenta um efeito com variação consideravelmente grande e positivo na decisão de ambos quererem um novo encontro.
• intel [IC -14%, -3%]: Apresenta um efeito que varia de 3% a 14% negativamente nas chanches de acontecer um futuro encontro novamente.

A seguir podemos verificar o quanto que o modelo criado representa sobre os dados:

pR2(bm)

fitting null model for pseudo-r2
          llh       llhNull            G2      McFadden          r2ML          r2CU 
-2451.4202082 -3170.2966484  1437.7528804     0.2267537     0.2660106     0.3573833 

Para regressão logística não há R2, mas podemos estimar um pseudo R2 para um modelo logístico. Sendo assim, verificamos através do método de McFadden e descobrimos que o modelo explica apenas 23% dos dados. Isso pode significar que ser atraente/ divertido/ gostar de musica/ ser inteligente pode não ter uma forte influência na chance de acontecer um match.