O speed dating é um modelo de encontros muito conhecido nos Estados Unidos. Nele, um grande grupo se divide em pares onde cada par tem 4 minutos para se conhecer. Após o término desse tempo os pares são rotacionados e tudo se repete. A ideia é que no final alguns casais se formem e passem para um encontro mais demorado (e sem competições).
O objetivo deste relatório é analisar quais fatores nos dados têm efeito relevante na chance do casal ter um match.
dados = read_csv(here("speed-dating/speed-dating2.csv"))
dates = dados %>%
mutate(dec = as.factor(dec),
gender = as.factor(gender))
Para entedermos melhor o público participante do speed dating, analisaremos informações sobre gênero, raça e idade dos participantes.
dates %>%
group_by(gender) %>%
summarise(n = n()) %>%
ggplot(aes(x = gender, y = n)) +
geom_bar(stat = "identity") +
labs(x = "", y = "Número de participantes") +
scale_x_discrete(labels = c('Feminino', 'Masculino'))
dates %>%
group_by(gender, age) %>%
summarise(n = n()) %>%
ggplot(aes(x = age, y = n, fill = gender)) +
geom_bar(stat = "identity") +
labs(x = "Idade", y = "Número de participantes", fill = "Gênero") +
scale_fill_discrete(labels = c('Feminino', 'Masculino'))
dates %>%
group_by(race) %>%
summarise(n = n()) %>%
na.omit() %>%
ggplot(aes(x = as.factor(race), y = n)) +
geom_bar(stat = "identity") +
labs(x = "Raça", y = "Número de participantes") +
scale_x_discrete(labels = c('1' = 'African American', '2' = 'Caucasian American','3' ='Hispanic American','4' = 'Asian American','5' ='Native American', '6' = 'Other'))
Com base nas visualizações acima, vemos que nos dados temos uma grande quantidade de pessoas caucasianas e jovens.
Nós utilizaremos um modelo de regressão logística que é semelhante ao modelo de regressão linear. No entanto, no modelo logístico a variável resposta é binária. Uma variável binária assume dois valores, como por exemplo, denominados “fracasso” e “sucesso”, respectivamente. Neste caso, nossa variável de resposta é dec, ela possui dois valores yes e no, indicando se houve match ou não.
Após analisarmos os dados e suas variáveis, decidimos utilizar as seguintes variáveis:
Iremos, inicialmente, analisar a correlação dessas variáveis.
dates.resumo <- dates %>%
select(shar, attr, intel, fun, dec)
ggpairs(dates.resumo)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Observando a matriz de correlação, vemos que as variáveis fun e shar tem um correlação mais forte, assim como as variavéis fun e attr. Isso pode mostrar que quanto mais a pessoa é divertida, mais hobbies e interesses em comum ela tem com a outra e mais atraente ela é.
Agora iremos criar o modelo para avaliar a relação entre dec (houve match ou não) e as variávies escolhidas.
modelo = glm(dec ~ shar + attr + intel + fun,
data = dates.resumo,
family = "binomial")
tidy(modelo, conf.int = TRUE, exponentiate = TRUE, conf.level = .95)
De acordo com os resultados acima, o quão inteligente é uma pessoa não tem um relação relevante com a variável dec (o valor estimado é de 0.85031 com IC de 95%[0.800512709, 0.902824140]). As variáveis shar e fun (hobbies e interesses em comum e quão engraçada o outro participante era, respectivamente) apresentaram uma relação razoável. Com valor estimado de 1.3404 com IC de 95%[1.281296430, 1.403136349] para shar e valor estimado de 1.2260 com IC de 95%[1.158777101, 1.297710948] para fun. A variável com efeito relevante para definir se houve um match (dec) é attr, que mostra o quão atraente o outro é. Ela teve valor estimado de 1.7263 com IC de 95%[1.635985600, 1.823788697].
pR2(modelo)
## fitting null model for pseudo-r2
## llh llhNull G2 McFadden r2ML
## -2145.3372779 -2888.2944334 1485.9143112 0.2572304 0.2959214
## r2CU
## 0.3975478
Avaliando o modelo com o R2 de McFadden vemos que o modelo explica apenas 26% dos nossos dados.