Para responder à pergunta sobre quais fatores nos dados têm um efeito relevante na chance do casal ter um “match” (combinação) durante um encontro de speed dating, podemos utilizar a regressão logística. Vamos realizar uma análise exploratória dos dados e, em seguida, criar um modelo de regressão logística usando um conjunto de variáveis explicativas para prever a ocorrência de “matches”.
1. Análise Exploratória dos Dados
Primeiro, vamos carregar os dados de treinamento do arquivo “speed-dating2.csv” e realizar uma análise exploratória para entender melhor as variáveis e sua distribuição.
# Carregar os dados de treinamento
train_data <- read.csv("C:/Users/amand/OneDrive/Documentos/speed-dating.csv")
# Visualizar as primeiras linhas dos dados
head(train_data)## iid gender order pid int_corr samerace age_o age field race from career
## 1 1 0 4 11 0.14 0 27 21 Law 4 Chicago lawyer
## 2 1 0 3 12 0.54 0 22 21 Law 4 Chicago lawyer
## 3 1 0 10 13 0.16 1 22 21 Law 4 Chicago lawyer
## 4 1 0 5 14 0.61 0 23 21 Law 4 Chicago lawyer
## 5 1 0 7 15 0.21 0 24 21 Law 4 Chicago lawyer
## 6 1 0 6 16 0.25 0 25 21 Law 4 Chicago lawyer
## sports tvsports exercise dining museums art hiking gaming clubbing reading tv
## 1 9 2 8 9 1 1 5 1 5 6 9
## 2 9 2 8 9 1 1 5 1 5 6 9
## 3 9 2 8 9 1 1 5 1 5 6 9
## 4 9 2 8 9 1 1 5 1 5 6 9
## 5 9 2 8 9 1 1 5 1 5 6 9
## 6 9 2 8 9 1 1 5 1 5 6 9
## theater movies concerts music shopping yoga attr sinc intel fun amb shar like
## 1 1 10 10 9 8 1 6 9 7 7 6 5 7
## 2 1 10 10 9 8 1 7 8 7 8 5 6 7
## 3 1 10 10 9 8 1 5 8 9 8 5 7 7
## 4 1 10 10 9 8 1 7 6 8 7 6 8 7
## 5 1 10 10 9 8 1 5 6 7 7 6 6 6
## 6 1 10 10 9 8 1 4 9 7 4 6 4 6
## prob match_es attr3_s sinc3_s intel3_s fun3_s amb3_s dec
## 1 6 4 NA NA NA NA NA yes
## 2 5 4 NA NA NA NA NA yes
## 3 NA 4 NA NA NA NA NA yes
## 4 6 4 NA NA NA NA NA yes
## 5 6 4 NA NA NA NA NA yes
## 6 5 4 NA NA NA NA NA no# Verificar a estrutura dos dados
str(train_data)## 'data.frame': 4918 obs. of 44 variables:
## $ iid : int 1 1 1 1 1 1 1 1 1 1 ...
## $ gender : int 0 0 0 0 0 0 0 0 0 0 ...
## $ order : int 4 3 10 5 7 6 1 2 8 9 ...
## $ pid : int 11 12 13 14 15 16 17 18 19 20 ...
## $ int_corr: num 0.14 0.54 0.16 0.61 0.21 0.25 0.34 0.5 0.28 -0.36 ...
## $ samerace: int 0 0 1 0 0 0 0 0 0 0 ...
## $ age_o : int 27 22 22 23 24 25 30 27 28 24 ...
## $ age : int 21 21 21 21 21 21 21 21 21 21 ...
## $ field : chr "Law" "Law" "Law" "Law" ...
## $ race : int 4 4 4 4 4 4 4 4 4 4 ...
## $ from : chr "Chicago" "Chicago" "Chicago" "Chicago" ...
## $ career : chr "lawyer" "lawyer" "lawyer" "lawyer" ...
## $ sports : int 9 9 9 9 9 9 9 9 9 9 ...
## $ tvsports: int 2 2 2 2 2 2 2 2 2 2 ...
## $ exercise: int 8 8 8 8 8 8 8 8 8 8 ...
## $ dining : int 9 9 9 9 9 9 9 9 9 9 ...
## $ museums : int 1 1 1 1 1 1 1 1 1 1 ...
## $ art : int 1 1 1 1 1 1 1 1 1 1 ...
## $ hiking : int 5 5 5 5 5 5 5 5 5 5 ...
## $ gaming : int 1 1 1 1 1 1 1 1 1 1 ...
## $ clubbing: int 5 5 5 5 5 5 5 5 5 5 ...
## $ reading : int 6 6 6 6 6 6 6 6 6 6 ...
## $ tv : int 9 9 9 9 9 9 9 9 9 9 ...
## $ theater : int 1 1 1 1 1 1 1 1 1 1 ...
## $ movies : int 10 10 10 10 10 10 10 10 10 10 ...
## $ concerts: int 10 10 10 10 10 10 10 10 10 10 ...
## $ music : int 9 9 9 9 9 9 9 9 9 9 ...
## $ shopping: int 8 8 8 8 8 8 8 8 8 8 ...
## $ yoga : int 1 1 1 1 1 1 1 1 1 1 ...
## $ attr : num 6 7 5 7 5 4 7 4 7 5 ...
## $ sinc : num 9 8 8 6 6 9 6 9 6 6 ...
## $ intel : num 7 7 9 8 7 7 7 7 8 6 ...
## $ fun : num 7 8 8 7 7 4 4 6 9 8 ...
## $ amb : num 6 5 5 6 6 6 6 5 8 10 ...
## $ shar : num 5 6 7 8 6 4 7 6 8 8 ...
## $ like : num 7 7 7 7 6 6 6 6 7 6 ...
## $ prob : num 6 5 NA 6 6 5 5 7 7 6 ...
## $ match_es: num 4 4 4 4 4 4 4 4 4 4 ...
## $ attr3_s : num NA NA NA NA NA NA NA NA NA NA ...
## $ sinc3_s : num NA NA NA NA NA NA NA NA NA NA ...
## $ intel3_s: num NA NA NA NA NA NA NA NA NA NA ...
## $ fun3_s : int NA NA NA NA NA NA NA NA NA NA ...
## $ amb3_s : int NA NA NA NA NA NA NA NA NA NA ...
## $ dec : chr "yes" "yes" "yes" "yes" ...# Resumo estatístico das variáveis numéricas
summary(train_data)## iid gender order pid
## Min. : 1.0 Min. :0.000 Min. : 1.00 Min. : 1
## 1st Qu.: 88.0 1st Qu.:0.000 1st Qu.: 4.00 1st Qu.: 88
## Median :273.0 Median :1.000 Median : 9.00 Median :273
## Mean :274.7 Mean :0.501 Mean : 9.26 Mean :275
## 3rd Qu.:431.0 3rd Qu.:1.000 3rd Qu.:14.00 3rd Qu.:431
## Max. :552.0 Max. :1.000 Max. :22.00 Max. :552
## NA's :10
## int_corr samerace age_o age
## Min. :-0.7300 Min. :0.0000 Min. :18.00 Min. :18.00
## 1st Qu.:-0.0300 1st Qu.:0.0000 1st Qu.:23.00 1st Qu.:23.00
## Median : 0.2100 Median :0.0000 Median :25.00 Median :25.00
## Mean : 0.1905 Mean :0.4063 Mean :25.79 Mean :25.78
## 3rd Qu.: 0.4300 3rd Qu.:1.0000 3rd Qu.:28.00 3rd Qu.:28.00
## Max. : 0.9000 Max. :1.0000 Max. :39.00 Max. :39.00
## NA's :72 NA's :61 NA's :52
## field race from career
## Length:4918 Min. :1.000 Length:4918 Length:4918
## Class :character 1st Qu.:2.000 Class :character Class :character
## Mode :character Median :2.000 Mode :character Mode :character
## Mean :2.731
## 3rd Qu.:4.000
## Max. :6.000
## NA's :20
## sports tvsports exercise dining
## Min. : 1.000 Min. : 1.000 Min. : 1.000 Min. : 1.000
## 1st Qu.: 5.000 1st Qu.: 2.000 1st Qu.: 5.000 1st Qu.: 7.000
## Median : 7.000 Median : 4.000 Median : 6.000 Median : 8.000
## Mean : 6.396 Mean : 4.527 Mean : 6.118 Mean : 7.687
## 3rd Qu.: 8.000 3rd Qu.: 7.000 3rd Qu.: 8.000 3rd Qu.: 9.000
## Max. :10.000 Max. :10.000 Max. :10.000 Max. :10.000
## NA's :36 NA's :36 NA's :36 NA's :36
## museums art hiking gaming
## Min. : 0.000 Min. : 0.000 Min. : 0.000 Min. : 0.00
## 1st Qu.: 6.000 1st Qu.: 5.000 1st Qu.: 4.000 1st Qu.: 2.00
## Median : 7.000 Median : 7.000 Median : 6.000 Median : 4.00
## Mean : 6.876 Mean : 6.595 Mean : 5.768 Mean : 4.02
## 3rd Qu.: 8.000 3rd Qu.: 8.000 3rd Qu.: 8.000 3rd Qu.: 6.00
## Max. :10.000 Max. :10.000 Max. :10.000 Max. :14.00
## NA's :36 NA's :36 NA's :36 NA's :36
## clubbing reading tv theater
## Min. : 0.000 Min. : 1.000 Min. : 1.00 Min. : 0.00
## 1st Qu.: 4.000 1st Qu.: 7.000 1st Qu.: 3.00 1st Qu.: 5.00
## Median : 6.000 Median : 8.000 Median : 6.00 Median : 7.00
## Mean : 5.726 Mean : 7.645 Mean : 5.29 Mean : 6.72
## 3rd Qu.: 8.000 3rd Qu.: 9.000 3rd Qu.: 7.00 3rd Qu.: 8.00
## Max. :10.000 Max. :13.000 Max. :10.00 Max. :10.00
## NA's :36 NA's :36 NA's :36 NA's :36
## movies concerts music shopping
## Min. : 0.00 Min. : 0.000 Min. : 1.000 Min. : 1.000
## 1st Qu.: 7.00 1st Qu.: 6.000 1st Qu.: 7.000 1st Qu.: 3.000
## Median : 8.00 Median : 7.000 Median : 8.000 Median : 6.000
## Mean : 7.98 Mean : 6.824 Mean : 7.781 Mean : 5.484
## 3rd Qu.: 9.00 3rd Qu.: 8.000 3rd Qu.: 9.000 3rd Qu.: 7.000
## Max. :10.00 Max. :10.000 Max. :10.000 Max. :10.000
## NA's :36 NA's :36 NA's :36 NA's :36
## yoga attr sinc intel
## Min. : 0.000 Min. : 0.000 Min. : 0.000 Min. : 0.000
## 1st Qu.: 2.000 1st Qu.: 5.000 1st Qu.: 6.000 1st Qu.: 6.000
## Median : 4.000 Median : 6.000 Median : 7.000 Median : 7.000
## Mean : 4.212 Mean : 6.064 Mean : 7.054 Mean : 7.266
## 3rd Qu.: 6.000 3rd Qu.: 7.000 3rd Qu.: 8.000 3rd Qu.: 8.000
## Max. :10.000 Max. :10.000 Max. :10.000 Max. :10.000
## NA's :36 NA's :118 NA's :161 NA's :166
## fun amb shar like
## Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 5.000 1st Qu.: 6.000 1st Qu.: 4.00 1st Qu.: 5.000
## Median : 6.000 Median : 7.000 Median : 5.00 Median : 6.000
## Mean : 6.289 Mean : 6.697 Mean : 5.32 Mean : 6.051
## 3rd Qu.: 8.000 3rd Qu.: 8.000 3rd Qu.: 7.00 3rd Qu.: 7.000
## Max. :10.000 Max. :10.000 Max. :10.00 Max. :10.000
## NA's :197 NA's :421 NA's :643 NA's :122
## prob match_es attr3_s sinc3_s
## Min. : 0.000 Min. : 0.000 Min. : 3.000 Min. : 3.000
## 1st Qu.: 4.000 1st Qu.: 2.000 1st Qu.: 7.000 1st Qu.: 7.000
## Median : 5.000 Median : 3.000 Median : 7.000 Median : 8.000
## Mean : 5.017 Mean : 3.169 Mean : 7.077 Mean : 7.994
## 3rd Qu.: 7.000 3rd Qu.: 4.000 3rd Qu.: 8.000 3rd Qu.: 9.000
## Max. :10.000 Max. :10.000 Max. :10.000 Max. :10.000
## NA's :156 NA's :460 NA's :2874 NA's :2874
## intel3_s fun3_s amb3_s dec
## Min. : 4.000 Min. : 3.000 Min. : 3.00 Length:4918
## 1st Qu.: 8.000 1st Qu.: 7.000 1st Qu.: 7.00 Class :character
## Median : 8.000 Median : 8.000 Median : 8.00 Mode :character
## Mean : 8.207 Mean : 7.573 Mean : 7.59
## 3rd Qu.: 9.000 3rd Qu.: 9.000 3rd Qu.: 9.00
## Max. :10.000 Max. :10.000 Max. :10.00
## NA's :2874 NA's :2874 NA's :2874# Verificar a distribuição das variáveis categóricas
table(train_data$gender)##
## 0 1
## 2454 2464table(train_data$race)##
## 1 2 3 4 6
## 244 2843 399 1111 301# Explorar correlações entre as variáveis
cor(train_data[, c("int_corr", "age_o", "age", "attr", "sinc", "intel", "fun", "amb", "shar", "like")])## int_corr age_o age attr sinc intel fun amb shar like
## int_corr 1 NA NA NA NA NA NA NA NA NA
## age_o NA 1 NA NA NA NA NA NA NA NA
## age NA NA 1 NA NA NA NA NA NA NA
## attr NA NA NA 1 NA NA NA NA NA NA
## sinc NA NA NA NA 1 NA NA NA NA NA
## intel NA NA NA NA NA 1 NA NA NA NA
## fun NA NA NA NA NA NA 1 NA NA NA
## amb NA NA NA NA NA NA NA 1 NA NA
## shar NA NA NA NA NA NA NA NA 1 NA
## like NA NA NA NA NA NA NA NA NA 1Com a análise exploratória, podemos entender melhor as variáveis e identificar possíveis padrões e correlações entre elas.
2. Preparação dos Dados
Antes de construir o modelo de regressão logística, precisamos preparar os dados, incluindo o tratamento de valores ausentes, a codificação de variáveis categóricas e a divisão dos dados em conjuntos de treinamento e teste.
# Tratar valores ausentes
train_data <- na.omit(train_data)
# Codificar variáveis categóricas
train_data$gender <- as.factor(train_data$gender)
train_data$race <- as.factor(train_data$race)
# Dividir os dados em conjuntos de treinamento e teste
set.seed(123)
train_index <- sample(1:nrow(train_data), nrow(train_data) * 0.7) # 70% para treinamento
train_set <- train_data[train_index, ]
test_set <- train_data[-train_index, ]3. Modelo de Regressão Logística
Agora, vamos criar um modelo de regressão logística usando as variáveis explicativas que escolhermos. Para este exemplo, selecionaremos as variáveis “attr” (quão atraente p1 achou p2), “sinc” (quão sincero p1 achou p2), “fun” (quão divertido p1 achou p2) e “shar” (quanto p1 achou que compartilha interesses e hobbies com p2) como preditoras da ocorrência de “matches”.
# Codificar a variável "dec" como binária (0 = sem match, 1 = com match)
train_set$dec <- ifelse(train_set$dec == "no", 0, 1)
test_set$dec <- ifelse(test_set$dec == "no", 0, 1)
# Modelo de Regressão Logística
model <- glm(dec ~ attr + sinc + fun + shar, data = train_set, family = binomial)
# Sumário do modelo
summary(model)##
## Call:
## glm(formula = dec ~ attr + sinc + fun + shar, family = binomial,
## data = train_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.97683 0.43033 -13.889 < 2e-16 ***
## attr 0.55222 0.05388 10.249 < 2e-16 ***
## sinc -0.02470 0.05190 -0.476 0.6342
## fun 0.14267 0.05555 2.568 0.0102 *
## shar 0.27061 0.04345 6.228 4.72e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1551.1 on 1134 degrees of freedom
## Residual deviance: 1176.0 on 1130 degrees of freedom
## AIC: 1186
##
## Number of Fisher Scoring iterations: 5O modelo de regressão logística nos fornece informações sobre a relevância e a magnitude dos efeitos das variáveis explicativas na probabilidade de ocorrer um “match”. Podemos interpretar os coeficientes estimados e seus intervalos de confiança.
4. Avaliação do Modelo
Após ajustar o modelo, podemos avaliar sua capacidade de previsão usando o conjunto de teste.
# Previsões no conjunto de teste
predictions <- predict(model, newdata = test_set, type = "response")
# Classificação das previsões
predicted_classes <- ifelse(predictions >= 0.5, 1, 0)
# Tabela de Confusão
table(test_set$dec, predicted_classes)## predicted_classes
## 0 1
## 0 212 62
## 1 68 145# Taxa de acerto
accuracy <- sum(test_set$dec == predicted_classes) / length(test_set$dec)
accuracy## [1] 0.7330595Ao avaliar o modelo no conjunto de teste, podemos verificar a acurácia do modelo e a matriz de confusão para entender melhor seu desempenho na previsão dos “matches”.
5. Conclusões
Com base na análise de regressão logística, podemos identificar os fatores relevantes na chance de um casal ter um “match” durante um encontro de speed dating. No exemplo apresentado, consideramos as variáveis “attr”, “sinc”, “fun” e “shar” como preditoras. Os coeficientes estimados e seus intervalos de confiança fornecem informações sobre a direção (positiva ou negativa) e a magnitude desses efeitos.
Com base no modelo de regressão logística ajustado, podemos fazer as seguintes conclusões:
Com base nessas conclusões, podemos inferir que a atratividade percebida por p1, a diversão percebida por p1 e a percepção de compartilhamento de interesses e hobbies por p1 são fatores relevantes e têm efeitos positivos na probabilidade de ocorrer um “match” durante um encontro de speed dating. No entanto, a percepção de sinceridade por p1 não parece ter um efeito significativo na probabilidade de “match”.