Regressão Romântica
Lorena Pereira
9 de julho de 2019
Atividade
Utilizar regressão logística em um conjunto de variáveis para entender que fatores nos dados têm efeito relevante na chance do casal ter um match? Descrevendo se os efeitos são positivos ou negativos e sua magnitude.
“The context, give me the context!”
Encontros relâmpagos ou speed dating são eventos onde várias pessoas solteiras conversam por 4 minutos e por fim decidem se saíriam novamente com as pessoas que conversaram ou não. Um Tinder presencial… A partir disso
Temos dados descrevendo 5000 encontros relâmpagos de 4 minutos envolvendo 310 jovens americanos. Os dados originais foram coletados por professores da Columbia Business School no experimento descrito aqui.
E nesses dados temos informações como:
- 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
- dec: se houve match entre os dois participantes do encontro
Mãos a obra!
Análise
Descritivo dos dados
dados <- read_csv("../dados/speed-dating2.csv") %>%
mutate(dec = as.factor(dec),
gender = as.factor(gender),
diff_age = abs(age_o - age))## Parsed with column specification:
## cols(
## .default = col_integer(),
## int_corr = col_double(),
## field = col_character(),
## from = col_character(),
## career = col_character(),
## attr = col_double(),
## sinc = col_double(),
## intel = col_double(),
## fun = col_double(),
## amb = col_double(),
## shar = col_double(),
## like = col_double(),
## prob = col_double(),
## match_es = col_double(),
## attr3_s = col_character(),
## sinc3_s = col_character(),
## intel3_s = col_character(),
## fun3_s = col_character(),
## amb3_s = col_character(),
## dec = col_character()
## )## See spec(...) for full column specifications.skim(dados)## Skim summary statistics
## n obs: 4918
## n variables: 45
##
## ── Variable type:character ────────────────────────────────────────────────────────────────────────────────────────────────────
## variable missing complete n min max empty n_unique
## amb3_s 2874 2044 4918 1 2 0 8
## attr3_s 2874 2044 4918 4 5 0 9
## career 46 4872 4918 2 77 0 218
## field 20 4898 4918 3 51 0 148
## from 36 4882 4918 2 58 0 172
## fun3_s 2874 2044 4918 1 2 0 8
## intel3_s 2874 2044 4918 4 5 0 7
## sinc3_s 2874 2044 4918 4 5 0 8
##
## ── Variable type:factor ───────────────────────────────────────────────────────────────────────────────────────────────────────
## variable missing complete n n_unique top_counts
## dec 0 4918 4918 2 no: 2873, yes: 2045, NA: 0
## gender 0 4918 4918 2 1: 2464, 0: 2454, NA: 0
## ordered
## FALSE
## FALSE
##
## ── Variable type:integer ──────────────────────────────────────────────────────────────────────────────────────────────────────
## variable missing complete n mean sd p0 p25 p50 p75 p100 hist
## age 52 4866 4918 25.78 3.35 18 23 25 28 39 ▁▇▆▇▃▁▁▁
## age_o 61 4857 4918 25.79 3.35 18 23 25 28 39 ▁▇▆▇▃▁▁▁
## art 36 4882 4918 6.59 2.29 0 5 7 8 10 ▁▁▃▆▃▆▇▇
## clubbing 36 4882 4918 5.73 2.45 0 4 6 8 10 ▃▂▃▇▅▆▆▅
## concerts 36 4882 4918 6.82 2.1 0 6 7 8 10 ▁▁▂▅▆▆▇▇
## diff_age 112 4806 4918 3.43 2.76 0 1 3 5 17 ▇▅▂▂▁▁▁▁
## dining 36 4882 4918 7.69 1.79 1 7 8 9 10 ▁▁▁▂▂▅▅▇
## exercise 36 4882 4918 6.12 2.33 1 5 6 8 10 ▅▃▃▇▇▇▇▇
## gaming 36 4882 4918 4.02 2.67 0 2 4 6 14 ▆▇▆▆▂▁▁▁
## hiking 36 4882 4918 5.77 2.56 0 4 6 8 10 ▂▃▅▇▅▅▆▆
## iid 0 4918 4918 274.67 183.91 1 88 273 431 552 ▇▇▁▆▃▆▃▇
## movies 36 4882 4918 7.98 1.67 0 7 8 9 10 ▁▁▁▁▁▃▅▇
## museums 36 4882 4918 6.88 2.08 0 6 7 8 10 ▁▁▂▅▃▇▇▇
## music 36 4882 4918 7.78 1.84 1 7 8 9 10 ▁▁▁▂▂▃▅▇
## order 0 4918 4918 9.26 5.67 1 4 9 14 22 ▇▇▅▇▅▃▅▂
## pid 10 4908 4918 274.98 183.97 1 88 273 431 552 ▇▇▁▆▃▆▃▇
## race 20 4898 4918 2.73 1.22 1 2 2 4 6 ▁▇▁▁▃▁▁▁
## reading 36 4882 4918 7.64 2.02 1 7 8 9 13 ▁▁▁▅▃▇▁▁
## samerace 0 4918 4918 0.41 0.49 0 0 0 1 1 ▇▁▁▁▁▁▁▆
## shopping 36 4882 4918 5.48 2.57 1 3 6 7 10 ▇▃▅▆▆▆▅▆
## sports 36 4882 4918 6.4 2.57 1 5 7 8 10 ▃▂▃▃▃▅▅▇
## theater 36 4882 4918 6.72 2.25 0 5 7 8 10 ▁▁▂▆▃▆▅▇
## tv 36 4882 4918 5.29 2.45 1 3 6 7 10 ▇▃▃▆▇▆▅▃
## tvsports 36 4882 4918 4.53 2.82 1 2 4 7 10 ▇▃▂▂▂▂▂▃
## yoga 36 4882 4918 4.21 2.71 0 2 4 6 10 ▇▆▆▇▅▃▂▃
##
## ── Variable type:numeric ──────────────────────────────────────────────────────────────────────────────────────────────────────
## variable missing complete n mean sd p0 p25 p50 p75 p100
## amb 421 4497 4918 6.7 1.83 0 6 7 8 10
## attr 118 4800 4918 6.06 1.95 0 5 6 7 10
## fun 197 4721 4918 6.29 1.98 0 5 6 8 10
## int_corr 72 4846 4918 0.19 0.31 -0.73 -0.03 0.21 0.43 0.9
## intel 166 4752 4918 7.27 1.59 0 6 7 8 10
## like 122 4796 4918 6.05 1.85 0 5 6 7 10
## match_es 460 4458 4918 3.17 2.36 0 2 3 4 10
## prob 156 4762 4918 5.02 2.17 0 4 5 7 10
## shar 643 4275 4918 5.32 2.16 0 4 5 7 10
## sinc 161 4757 4918 7.05 1.81 0 6 7 8 10
## hist
## ▁▁▁▇▇▇▇▆
## ▁▁▂▇▆▆▅▃
## ▁▁▂▇▇▇▆▃
## ▁▂▅▆▇▇▅▁
## ▁▁▁▃▅▇▇▆
## ▁▁▂▇▇▇▅▂
## ▇▇▆▇▁▁▁▂
## ▂▂▂▇▃▃▂▁
## ▁▂▂▇▅▃▂▂
## ▁▁▁▅▆▇▇▆A fim de facilitar um possível entendimento dos fatores de maior sucesso nos matchs vamos diminuir o escopo para os seguintes campos:
- shar: Será que os opostos se atraem mesmo?
- diff_age (diferença de idades entre p1 e p2, calculada a partir dos campos existente): E como a diferença de idade pode intervir nisso?
- intel: Inteligência conta?
- fun: Ser divertido com certeza… Né? Bom, vamos ver!
Como já sabemos quais dados vamos investigar, vamos tentar visualizar uma correlação entre eles. Mas primeiro vamos retirar os resgistros com valores nulos.
dados <- dados %>%
select(shar, diff_age, intel, fun, dec)
dados <- na.omit(dados)
skim(dados)## Skim summary statistics
## n obs: 4157
## n variables: 5
##
## ── Variable type:factor ───────────────────────────────────────────────────────────────────────────────────────────────────────
## variable missing complete n n_unique top_counts
## dec 0 4157 4157 2 no: 2380, yes: 1777, NA: 0
## ordered
## FALSE
##
## ── Variable type:integer ──────────────────────────────────────────────────────────────────────────────────────────────────────
## variable missing complete n mean sd p0 p25 p50 p75 p100 hist
## diff_age 0 4157 4157 3.37 2.71 0 1 3 5 17 ▇▅▂▂▁▁▁▁
##
## ── Variable type:numeric ──────────────────────────────────────────────────────────────────────────────────────────────────────
## variable missing complete n mean sd p0 p25 p50 p75 p100 hist
## fun 0 4157 4157 6.28 1.99 0 5 6 8 10 ▁▁▂▇▇▇▆▅
## intel 0 4157 4157 7.26 1.59 0 6 7 8 10 ▁▁▁▃▅▇▇▆
## shar 0 4157 4157 5.32 2.16 0 4 5 7 10 ▁▂▂▇▅▃▂▂Visualizando correlação
ggpairs(dados %>% select(shar, diff_age, intel, fun))
Gerando o modelo:
match_model = glm(dec ~ shar + diff_age + intel + fun,
data = dados,
family = "binomial")
tidy(match_model, conf.int = TRUE, exponentiate = TRUE, conf.level = .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) 0.0249 0.205 -18.1 6.05e-73 0.0166 0.0370
## 2 shar 1.38 0.0218 14.8 1.30e-49 1.32 1.44
## 3 diff_age 0.979 0.0132 -1.63 1.04e- 1 0.954 1.00
## 4 intel 0.907 0.0287 -3.39 6.93e- 4 0.857 0.960
## 5 fun 1.45 0.0265 14.1 2.86e-45 1.38 1.53Todas as variáveis tiveram efeito positivo no modelo. Mas considerando sua magnitude as que mais se destacaram foram: O quanto se considera a pessoa divertida obtendo 1,45 com 95% CI [1,38; 1,53], e o quanto se acredita compartilhar interesses com a pessoa obtendo 1,38 com 95% CI [1,32; 1,44]. Os demais atributos de diferença de idade que obteve 0,98 com 95% CI [0,95; 1,00] e inteligencia que obteve 0,91 com 95% CI [0,86; 0,96] tiveram um desempenho menos impactante no modelo.
pR2(match_model)## llh llhNull G2 McFadden r2ML
## -2339.1072012 -2837.5236072 996.8328120 0.1756519 0.2132118
## r2CU
## 0.2863191Analisando o modelo considerando o pseudo R2 de McFadden vemos que o nosso modelo explica 17% dos nossos dados. Ou seja no nosso modelo ser divertido é o que mais importa, já ser inteligente nem tanto, mas ainda não temos um poder de explicação tão grande entre os matchs.