Discplina de Análise de Dados 1- Ciência da Computação UFCG - 2016.1

O clima de amor está no ar. Os dados utlizados nessa análise são referentes a várias rodadas de encontros relâmpagos (Speed Dating) entre 310 jovens americanos. A princípio os dados foram reduzidos, retiradas algumas colunas, para agilizar o processamento, os dados foram coletados por professores da Columbiam Business School. Como a coleta dos dados ocorreu? Os participantes dos encontros preencheram fichas referentes a cada um dos encontros que participou durante a noite, cada encontro durava em torno de 4 minutos. Cada linha da tabela representa um encontro. Vamos iniciar nossa análise dando uma olhada nos dados.

# a correlação dos interesses (int_corr) de p1 e p2 influencia a probabilidade (prob) deles terem um novo encontro?
# quais variaveis mais influenciam na probabilidade de p1 achar que p2 toparia outro encontro?

dados <- read.csv("dados/speed-dating.csv")

#summary(dados)

dados = data.frame(dados$iid, dados$gender, dados$int_corr, dados$attr, dados$reading, dados$museums, dados$art, dados$concerts, dados$shar, dados$like, dados$prob, dados$intel3_s)
names(dados) <- c("id", "gender", "corr", "attr", "reading", "museums", "art", "concerts", "shar", "like", "prob", "selfIntel")

Probabilidade de um novo encontro x Correlação de Interesses

No decorrer do encontro, os pretendentes vão preenchendo uma ficha com algumas informações sobre seus interesses e algumas perguntas sobre o outro. Uma dessas informações é a probabilidade que a pessoa 1 acha que a pessoa 2 aceitaria sair novamente. Utilizando a variável, queremos saber se essa probabilidade é influênciada pela correlação entre os interesses de ambos. Vamos dar uma olhada se existe uma relação entre a probabilidade e a correlação dos interesses.

ggplot(dados, aes(y=dados$prob, x=dados$corr)) +
  geom_point(alpha = 0.1, position = position_jitter(width = 0.3), color="blue") +
  labs(title="C", x= "Correlação", y="Probabilidade")
## Warning: Removed 213 rows containing missing values (geom_point).

Analisando o gráfico, conseguimos ver uma mancha mais escura na região central, o que poderia ser uma correlação relativamente baixa entre os interesses poderia ter uma probabilidade de um encontro futuro em torno de 50% de chances. Definimos agora nosso modelo de regressão linear, onde pretendemos descobrir a significância da relação probabilidade de um novo encontro e correlação de interesses entre os pretendentes realmente existe.

#modelo
probCorrMod = lm(prob ~ corr, data = dados)
summary(probCorrMod)
## 
## Call:
## lm(formula = prob ~ corr, data = dados)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.1958 -1.1518 -0.0045  1.8482  5.1635 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.96832    0.03712 133.853   <2e-16 ***
## corr         0.25845    0.10208   2.532   0.0114 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.16 on 4703 degrees of freedom
##   (213 observations deleted due to missingness)
## Multiple R-squared:  0.001361,   Adjusted R-squared:  0.001149 
## F-statistic: 6.411 on 1 and 4703 DF,  p-value: 0.01138
tidy(probCorrMod, conf.int = TRUE)
##          term  estimate  std.error  statistic    p.value   conf.low
## 1 (Intercept) 4.9683196 0.03711785 133.852566 0.00000000 4.89555125
## 2        corr 0.2584514 0.10207731   2.531918 0.01137633 0.05833203
##   conf.high
## 1 5.0410880
## 2 0.4585707
#plot do modelo
ggplot(dados, aes(dados$corr, dados$prob)) +  geom_point(alpha = 0.1, position = position_jitter(width = 0.3)) + 
  labs(title="Previsão do modelo", x= "Correlação", y="Probabilidade") +  
  geom_line(aes(y = predict(probCorrMod, dados)), colour = "red")
## Warning: Removed 213 rows containing missing values (geom_point).
## Warning: Removed 72 rows containing missing values (geom_path).

Vamos analisar os resíduos agora.

#residuos
ggplot(probCorrMod, aes(corr, .resid)) + 
  labs(title="Resíduos do modelo", x= "Correlação", y="Resíduos") +
  geom_point(alpha = 0.1) +
  geom_hline(yintercept = 0, colour = "blue")

ggplot(probCorrMod, aes(.resid)) + labs(title="Frequência de resíduos", x= "Resíduo", y="Frequência") + 
  geom_freqpoly(binwidth = 0.5)

Conclusões

Analisando os resultados, percebemos que a probabilidade de um possível novo encontro não tem uma relação de significância alta com os interesses em comum. Logo, mesmo que a correlação entre os interesses seja baixa, próxima de zero, a probabilidade de um novo encontro chegar 40% e 50% de chances, ou seja, nada está perdido ainda.