Couples
Jake Rothschild
9/6/2019
rm(list = ls())
setwd("~/Downloads")
library(foreign)
sex_data <- read.spss("sex_data.sav", use.value.label=TRUE, to.data.frame=TRUE)Libraries/themes
library(ggplot2)
library(tidyverse)
library(gridExtra)
library(finalfit)
library(kableExtra)
library(xtable)
jrothsch_theme <- theme_bw() +
theme(text = element_text(size = 10, face = "bold", color = "deepskyblue4"),panel.grid = element_blank(),axis.text = element_text(size = 10, color = "gray13"), axis.title = element_text(size = 10, color = "red"), legend.text = element_text(colour="Black", size=10), legend.title = element_text(colour="Black", size=7), plot.subtitle = element_text(size=14, face="italic", color="black"))Removing obserations without our key variables
sex_data <- sex_data[!is.na(sex_data$status),]
sex_data <- sex_data[!is.na(sex_data$age),]
sex_data <- sex_data[!is.na(sex_data$Years_PrimaryPartner),]
sex_data <- sex_data[!is.na(sex_data$MALE),]Making variables
sex_data <- sex_data %>%
mutate(married = status == "Married")
sex_data <- sex_data %>%
mutate(married_gender = ifelse(married,
ifelse(MALE == "Male", "Married Male", "Married Female"),
ifelse(MALE == "Male", "Unmarried Male", "Unmarried Female ")))
married_num = length(sex_data$married[sex_data$married == T])
unmarried_num = length(sex_data$married[sex_data$married == T])
sex_data <- sex_data %>% mutate(freq_num = as.numeric(ifelse(sexfreq == "At least once per day", 6,
ifelse(sexfreq == "3-4 times per week", 5,
ifelse(sexfreq == 'At least once a week', 4,
ifelse(sexfreq == 'At least once per month', 3,
ifelse(sexfreq =='At least once per year', 2,
ifelse( sexfreq =="Less than once a year", 1, 0))))))))
female <- sex_data %>%
filter(sex_data$MALE == "Female")making couples variable/dataset
sex_data <- sex_data %>%
mutate(incouple = !is.na(couple))
couples <- sex_data %>%
filter(incouple == T & partner_sex == "Opposite sex") %>%
group_by(couple) %>%
#removing gay couples not filtered by above condition
filter(couple != 184 & couple !=166 & couple != 66)
###THE PROBLEM IS THAT YOU NEED REST OF VARIABLES TO BE EQUAL
###MARRIAGE IS FINE
##DO THE OTHER VARS ONEAT A TIME
couples_want <- couples %>%
select(want, couple, MALE, married)
couples_widewant <- couples_want %>%
spread(MALE, want) %>%
filter(!is.na(Male) & !is.na(Female))
couples_widewant <- couples_widewant %>%
mutate(dif = Female - Male)
couples_like <- couples %>%
select(totlike, couple, MALE, married)
couples_widelike <- couples_like %>%
spread(MALE, totlike) %>%
filter(!is.na(Male) & !is.na(Female))
couples_widelike <- couples_widelike %>%
mutate(dif = Female - Male)
couples_freq <- couples %>%
select(freq_num, couple, MALE, married)
couples_widefreq <- couples_freq %>%
spread(MALE, freq_num) %>%
filter(!is.na(Male) & !is.na(Female))
couples_widefreq <- couples_widefreq %>%
mutate(dif = Female - Male)
couples_trynew <- couples %>%
select(satis24, couple, MALE, married) %>%
mutate(satis24 = as.numeric(satis24))
couples_widetrynew <- couples_trynew %>%
spread(MALE, satis24) %>%
filter(!is.na(Male) & !is.na(Female))
couples_widetrynew <- couples_widetrynew %>%
mutate(dif = abs(Female - Male))
couples_age <- couples %>%
select(age, couple, MALE, married)
couples_wideage <- couples_age %>%
spread(MALE, age) %>%
filter(!is.na(Male) & !is.na(Female))
couples_widege <- couples_wideage %>%
mutate(dif = Female - Male) Testing whether couples are different from non-coiples in want/like/freq/age/trying new things
ggplot(sex_data, aes(x = age)) + geom_density(aes(color = incouple))+ jrothsch_theme
ggplot(sex_data, aes(x = want)) + geom_density(aes(color = incouple))+ jrothsch_theme
ggplot(sex_data, aes(x = totlike)) + geom_density(aes(color = incouple))+ jrothsch_theme
ggplot(sex_data, aes(x = as.numeric(sexfreq))) + geom_density(aes(color = incouple), bw= 1)+ jrothsch_theme
ggplot(sex_data, aes(x = as.numeric(satis24))) + geom_density(aes(color = incouple), bw= 1)+ jrothsch_theme
Testing agreement on want/like/freq
ggplot(couples_widewant, aes(x = Male, y = Female)) + geom_jitter() + geom_smooth(se = F) + jrothsch_theme +
labs(title = "Want, Male V Female Couples")
cor(couples_widewant$Female, couples_widewant$Male)## [1] 0.5435991ggplot(couples_widelike, aes(x = Male, y = Female)) + geom_jitter() + geom_smooth(se = F) + jrothsch_theme +
labs(title = "Like, Male V Female Couples")
cor(couples_widelike$Female, couples_widelike$Male)## [1] 0.7166774ggplot(couples_widefreq, aes(x = Male, y = Female)) + geom_jitter() + geom_smooth(se = F) + jrothsch_theme +
labs(title = "Freq, Male V Female Couples")
cor(couples_widefreq$Female, couples_widefreq$Male)## [1] 0.8682245ggplot(couples_widetrynew, aes(x = Male, y = Female)) + geom_jitter() + geom_smooth(se = F) + jrothsch_theme +
labs(title = "Try new, Male V Female Couples")
cor(couples_widetrynew$Female, couples_widetrynew$Male)## [1] 0.712362ggplot(couples_widewant, aes(x = dif)) + geom_density(aes(fill = married), alpha = 0.3)+ jrothsch_theme +
labs(title = "Female - Male, Want")
ggplot(couples_widelike, aes(x = dif)) + geom_density(aes(fill = married), alpha = 0.3) + jrothsch_theme +
labs(title = "Female - Male, Like")
ggplot(couples_widefreq, aes(x = dif)) + geom_density(aes(fill = married), alpha = 0.3) + jrothsch_theme +
labs(title = "Female - Male, Freq")
ggplot(couples_widetrynew, aes(x = dif)) + geom_density(aes(fill = married), alpha = 0.3) + jrothsch_theme +
labs(title = "Female - Male, Trying new things")
Making dataset with all keyvars
couples_allwide <- couples_widetrynew
couples_allwide$femaleage = couples_wideage$Female
couples_allwide$maleage = couples_wideage$Male
couples_allwide$femalewant = couples_widewant$Female
couples_allwide$malewant = couples_widewant$Male
couples_allwide$femalelike = couples_widelike$Female
couples_allwide$malelike = couples_widelike$Maleregs
couples_allwide %>%
lm(femalewant ~Female + married + femaleage + dif + Female*dif + Male, data = .) %>%
summary()##
## Call:
## lm(formula = femalewant ~ Female + married + femaleage + dif +
## Female * dif + Male, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -20.0789 -4.2305 -0.2023 4.0312 20.4620
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 15.66273 1.84103 8.508 5.69e-16 ***
## Female 4.03557 0.68960 5.852 1.14e-08 ***
## marriedTRUE -0.34165 0.88054 -0.388 0.69826
## femaleage -0.09931 0.02675 -3.713 0.00024 ***
## dif 1.99635 1.40328 1.423 0.15576
## Male 0.30025 0.57687 0.520 0.60306
## Female:dif -0.39501 0.45284 -0.872 0.38366
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.836 on 341 degrees of freedom
## Multiple R-squared: 0.4603, Adjusted R-squared: 0.4508
## F-statistic: 48.48 on 6 and 341 DF, p-value: < 2.2e-16couples_allwide %>%
lm(malewant ~Male + married + maleage + dif + Male*dif + Female, data = .) %>%
summary()##
## Call:
## lm(formula = malewant ~ Male + married + maleage + dif + Male *
## dif + Female, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -17.6513 -5.0702 0.0197 5.2760 16.9190
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 26.47955 1.90328 13.913 < 2e-16 ***
## Male 0.74955 0.65312 1.148 0.25192
## marriedTRUE 0.85281 0.89391 0.954 0.34075
## maleage -0.12815 0.02685 -4.773 2.69e-06 ***
## dif -3.21584 1.57373 -2.043 0.04178 *
## Female 1.92275 0.54069 3.556 0.00043 ***
## Male:dif 0.93909 0.46909 2.002 0.04608 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.957 on 341 degrees of freedom
## Multiple R-squared: 0.3176, Adjusted R-squared: 0.3056
## F-statistic: 26.46 on 6 and 341 DF, p-value: < 2.2e-16couples_allwide %>%
lm(femalelike ~Female + married + femaleage + dif + Female*dif + Male, data = .) %>%
summary()##
## Call:
## lm(formula = femalelike ~ Female + married + femaleage + dif +
## Female * dif + Male, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.1781 -4.6573 -0.1218 4.2680 24.4454
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 16.83755 1.98346 8.489 6.49e-16 ***
## Female 5.14367 0.74295 6.923 2.20e-11 ***
## marriedTRUE 0.61608 0.94867 0.649 0.5165
## femaleage 0.02800 0.02882 0.972 0.3319
## dif 2.50449 1.51184 1.657 0.0985 .
## Male 0.63323 0.62150 1.019 0.3090
## Female:dif -0.52271 0.48788 -1.071 0.2848
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.365 on 341 degrees of freedom
## Multiple R-squared: 0.4566, Adjusted R-squared: 0.447
## F-statistic: 47.75 on 6 and 341 DF, p-value: < 2.2e-16couples_allwide %>%
lm(malelike ~Male + married + maleage + dif + Male*dif + Female, data = .) %>%
summary()##
## Call:
## lm(formula = malelike ~ Male + married + maleage + dif + Male *
## dif + Female, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -17.6530 -4.3236 0.4817 4.5650 19.2084
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 18.99847 1.80639 10.517 < 2e-16 ***
## Male 3.91049 0.61987 6.309 8.74e-10 ***
## marriedTRUE 0.69796 0.84840 0.823 0.41127
## maleage 0.05350 0.02548 2.100 0.03649 *
## dif 0.89375 1.49362 0.598 0.54999
## Female 1.34940 0.51316 2.630 0.00894 **
## Male:dif -0.13719 0.44521 -0.308 0.75816
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.603 on 341 degrees of freedom
## Multiple R-squared: 0.448, Adjusted R-squared: 0.4383
## F-statistic: 46.13 on 6 and 341 DF, p-value: < 2.2e-16