--- title: "Father absence analysis Boothroyd Cross 2017" author: "LB" date: "19 May 2017" output: word_document: default --- ```{r setup, include=FALSE} library(knitr) opts_chunk$set(tidy.opts=list(width.cutoff=60),tidy=TRUE) ``` Load all packages needed in script ```{r} #clear environment first rm(list=ls()) #load stuff library(readr) library(psych) library(heplots) library(ggplot2) library(tidyr) library(plyr) library(dplyr) library(plotrix) library(Hmisc) ``` read data file ```{r read data file} masc_all <- read_delim("LGB masculinity data.txt", "\t", escape_double = FALSE, trim_ws = TRUE) ``` Key variables in the data set are: $ country : chr "Australia" "Australia" "Australia" "Australia" ... $ age : int 20 20 22 18 19 18 18 18 19 18 ... $ gender : chr "female" "female" "female" "female" ... $ income : int NA NA 1 3 2 3 2 2 2 3 ... $ wmf2 : int NA NA NA 6 4 1 1 7 7 4 ... $ wmm2 : int NA NA NA 4 4 9 7 9 9 7 ... $ mqbp2 : int NA NA NA 4 3 2 4 6 3 4 ... $ fath_ab : num NA NA NA NA NA NA NA NA NA NA ... $ f_ab_ever : int NA NA NA NA NA NA NA NA NA NA ... $ periodyr : int NA NA NA 13 12 13 10 13 12 15 ... $ sex_yr : int NA NA NA 98 16 18 15 13 98 15 ... $ fss_total : num NA NA NA 1.12 2.49 3.35 NA 1.78 3.94 1.53 ... $ fss_a : num NA NA NA 1 2.36 2.09 NA 1.82 4.18 1.27 ... $ fss_b : num NA NA NA 1.06 2.88 4.13 NA 1.25 4.56 1.25 ... $ bsri_a : num NA NA NA 3.5 2.45 3.35 4.5 5.25 4.9 4.55 ... $ bsri_b : num NA NA NA 3.8 3.95 5.95 5.05 5.65 6.35 3.8 ... $ bsri_c : num NA NA NA 4.2 3.95 5.25 4.25 5 4.85 4.1 ... $ BSRI_ratio : num NA NA NA 0.92 0.62 0.56 0.89 0.93 0.77 1.2 ... $ bis : num NA NA NA 2.21 1.82 2.03 2.26 2.74 2.47 1.97 ... $ bis_attention: num NA NA NA 2.75 3 2.25 1.25 2 2.38 1.75 ... $ bis_motor : num NA NA NA 2.7 2.4 2.2 1.7 2.7 2.7 1.8 ... $ bis_planning : num NA NA NA 2.92 2.5 2.17 2.5 1.67 3 2.17 ... $ agg : num NA NA NA NA 2.19 2.64 2.07 3.24 NA 1.86 ... $ agg_ang : num NA NA NA NA 2 2 1.57 2.86 NA 1.57 ... $ agg_host : num NA NA NA NA 1.57 3.75 1.88 3.88 NA 2 ... $ agg_phys : num NA NA NA NA 2.89 2 1.67 1.78 NA 1.78 ... $ agg_verb : num NA NA NA NA 2 3.6 3 3.8 NA 1.4 ... ```{r} #run this to list full list of variables untruncated if needed: #str(masc_all, list.len=length(masc_all)) ``` #Method - Participants Section First we select participants aged 17 to 30 years and report mean age. We also recode as NA any reported menarche either before age 9 or after age 17 (i.e. medically precociours/delayed), or reported first sex before age 9 (i.e. before earliest age at puberty) ```{r recode NA ages} #recode '98' in age first coitus/menarche as NA, for later analyses. masc_all$sex_yr[masc_all$sex_yr==98] <- NA masc_all$periodyr[masc_all$periodyr==98] <- NA #recode values <9 or >17 for age at menarche as NA #recode values <9 for age at first sex as NA masc_all$periodyr[masc_all$periodyr<9] <- NA masc_all$periodyr[masc_all$periodyr>17] <- NA masc_all$sex_yr[masc_all$sex_yr<9] <- NA #drop all cases where respondent is under 16, over 30, or did not report age, leaves N = 691 with mean age 20.5 as reported in MS masc_ageset <- masc_all[is.na(masc_all$age) == FALSE,] masc_ageset <- masc_ageset[(masc_ageset$age>16), ] masc_ageset <- masc_ageset[(masc_ageset$age<30), ] nrow(masc_ageset) #various frequencies mean(masc_ageset$age) table(masc_ageset$white, masc_ageset$country) table(masc_ageset$country) table(masc_ageset$gender) table(masc_ageset$gender, masc_ageset$fath_ab) ``` ```{r descriptives} descriptives <- subset(masc_ageset, select=c(country, gender, white, job, f_ab_ever, age, periodyr, sex_yr, bsri_a, bsri_b, agg_ang, agg_host, agg_phys, agg_verb,fss_total, bis_attention, bis_motor, bis_planning)) descriptives.US <- descriptives[(descriptives$country == "United State"), ] descriptives.Aus <- descriptives[(descriptives$country == "Australia"), ] describe(descriptives.US) #gives loads more than needed, but ns etc all there (from the Hmisc package) #psych::describe(descriptives.US) #gives sds for continuous variables and a big mess for everything else describe(descriptives.Aus) #gives loads more than needed, but ns etc all there (from the Hmisc package) #psych::describe(descriptives.Aus) #gives sds for continuous variables and a big mess for everything else ``` We're going to pause here and check the factor structure of the FSS ```{r PCA for FSS} PCAdataF <- subset(masc_ageset, select=c(fss1, fss2, fss3, fss4, fss5, fss6, fss7, fss8, fss9, fss10, fss11, fss12, fss13, fss14, fss15, fss16, fss17, fss18, fss19, fss20, fss21, fss22, fss23, fss24, fss25, fss26, fss27, fss28, fss29, fss30, fss31, fss32, fss33, fss34, fss35, fss36, fss37, fss38, fss39, fss40, fss41, fss42, fss43, fss44, fss45, fss46, fss47, fss48, fss49, fss50, fss51, fss52, fss53, fss54, fss55, fss56, fss57a, fss57b, fss58, fss59, fss60, fss61, fss62, fss63, fss64, fss65, fss66, fss67, fss68, fss69, fss70a, fss70b, fss71, fss72, fss73, fss74, fss75, fss76, fss77, fss78, fss79, fss80, fss81, fss82, fss83, fss84, fss85, fss86, fss87)) #scale(PCAdataF, center = TRUE, scale = TRUE) library(psych) fitF <- principal(PCAdataF, nfactors=4, rotate="none") print(fitF,cut=0.3,digits=3) # print results scree(PCAdataF) #it looks like fss_total is the best variable to use ``` Then we check whether age is associated with any of our individual outcome variables. ```{r Adjusting for age} #does age predict any of our outcome variables? #a couple of sig parameter estimates within nonsig models, or nonsig parameter estimates within sig models, but nothing in here to suggest adjusting for age is necessary #make an agesquared variable to check for quadratic effects masc_ageset$agesq <- masc_ageset$age*masc_ageset$age #does age predict fear a? # note na.action = na.exclude - this pads out the residuals with NAs in the appropriate places rather than just producing nothing. Lets you bind the residuals to the data frame afterwards. #FSS_total has sig model but all driven by intercept fss_total.age <- lm(fss_total ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(fss_total.age) #not age at menarche periodyr.age <- lm(periodyr ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(periodyr.age) #not BSRI masc bem_a.age <- lm(bsri_a ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(bem_a.age) #not BSRI fem bem_b.age <- lm(bsri_b ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(bem_b.age) #not AQ anger ang.age <- lm(agg_ang ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(ang.age) #not AQ hostile host.age <- lm(agg_host ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(host.age) #AQ phys - weak variable coeffs, nonsig model phys.age <- lm(agg_phys ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(phys.age) #AQ verbs - weak variable coeffs, nonsig model verb.age <- lm(agg_verb ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(verb.age) #not BIS motor BISmot.age <- lm(bis_motor ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(BISmot.age) #not BIS attention BISatt.age <- lm(bis_attention ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(BISatt.age) #not BIS planning BISplan.age <- lm(bis_planning ~ age + agesq, data = masc_ageset, na.action = na.exclude) summary(BISplan.age) ``` We also need to do the PCA on family ratings. ```{r} PCAdata1 <- subset(masc_ageset, select=c(wmf2, wmm2, mqbp2)) #scale(PCAdata1, center = TRUE, scale = TRUE) fit1 <- principal(PCAdata1, rotate="none") print(fit1,cut=0.3,digits=3) # print results # add factor scores to dataset masc_ageset$FRQ <- fit1$scores[,1] ``` Now we do the big PCA on all gendered behaviour items ```{r} PCAdata2 <- subset(masc_ageset, select=c(bsri_a,bsri_b, agg_ang, agg_host, agg_phys, agg_verb,fss_total, bis_attention, bis_motor, bis_planning)) #scale(PCAdata2, center = TRUE, scale = TRUE) library(psych) fit2 <- principal(PCAdata2, nfactors=4, rotate="none") print(fit2,cut=0.3,digits=3) # print results scree(PCAdata2) # add factor scores to dataset masc_ageset$reactivity <- fit2$scores[,1] masc_ageset$masculinity <- fit2$scores[,2] ``` Now we check for sex differences on these factors. We find that reactivity shows a country difference (Aus scores higher) but no sex difference. Masculinity shows a sex diference (men score higher) and a country difference (US scores higher) but no interaction. ```{r gender and country differences in factor scores} r_sexdiff <- lm(reactivity ~ gender*country, data = masc_ageset, na.action = na.exclude) summary(r_sexdiff) etasq(r_sexdiff) m_sexdiff <- lm(masculinity ~ gender*country, data = masc_ageset, na.action = na.exclude) summary(m_sexdiff) etasq(m_sexdiff) #I like Cohen's d becuase I find it intuitive. So I've made it here. Yes, I know this code is *horrible* #drop cases with NA factor scores for_describing_factors <- masc_ageset[is.na(masc_ageset$masculinity) == FALSE,] for_describing_factors <- for_describing_factors[is.na(for_describing_factors$reactivity) == FALSE,] #spit out means for M and then F ddply(for_describing_factors, .(gender), summarise, mascmean=mean(masculinity)) ddply(for_describing_factors, .(gender), summarise, reacmean=mean(reactivity)) #spit out SDs for M and then F ddply(for_describing_factors, .(gender), summarise, mascSD=sd(masculinity)) ddply(for_describing_factors, .(gender), summarise, reacSD=sd(reactivity)) #spit out sd for (M+F) sd(for_describing_factors$reactivity) sd(for_describing_factors$masculinity) #from this, Cohen's d for sdiff in masc is (0.27653171 - (-0.07570487))/0.9693821 = 0.36 #Cohen's d for sdiff in reac is (0.03943915 - (-0.02470656))/0.9942785 = 0.06 #look at the factor scores by country #drop cases with NA factor scores for_describing_factors_country <- masc_ageset[is.na(masc_ageset$masculinity) == FALSE,] for_describing_factors_country <- for_describing_factors_country[is.na(for_describing_factors_country$reactivity) == FALSE,] #spit out means for M and then F ddply(for_describing_factors_country, .(country), summarise, reacmean=mean(reactivity)) ddply(for_describing_factors_country, .(country), summarise, mascmean=mean(masculinity)) #spit out separeate SDs for M and F ddply(for_describing_factors_country, .(country), summarise, reacSD=sd(reactivity)) ddply(for_describing_factors_country, .(country), summarise, mascSD=sd(masculinity)) #spit out sd for (M+F) sd(for_describing_factors_country$reactivity) sd(for_describing_factors_country$masculinity) #from this, Cohen's d for country diff in reac is (0.09236556 - (-0.30040209))/0.9942785 = 0.3950279 #Cohen's d for country diff in masc is (0.2426770 - (-0.1073859))/0.9693821 = 0.3611196 ``` #father absence analysis We select US women and men and Aussie men for father absence analyses (becuase N too small for US males), and drop anyone who is father absent NA or blank ```{r} masc <- masc_ageset[masc_ageset$country == "Australia" | (masc_ageset$gender == "female" & masc_ageset$country == "United State"), ] nrow(masc) table(masc$country, masc$gender) ## Remove anyone with fath_ab of 98 (n=45) or NA (n=56). Leaves total n=654 table(masc$fath_ab, useNA = "always") masc <- masc[(masc$fath_ab == 1 | masc$fath_ab == 0.5 | masc$fath_ab == 0) & is.na(masc$fath_ab) == FALSE,] nrow(masc) ``` Now we run father absence analyses on this subset 3-category father absence for reactivity in female participants: shows clear effect of country, with Americans less reactive than Australians. Effects of fath_abnon-sig; remain non-sig if income added to model ```{r} masc$fath_ab <- as.factor(masc$fath_ab) # make sure fath_ab is a factor not continuous father.absence.reactivityf <- lm(reactivity ~ fath_ab * country , data = masc[masc$gender == "female",]) summary(father.absence.reactivityf) etasq(father.absence.reactivityf) #Here's the model with income too #father.absence.reactivityf.income <- lm(reactivity ~ fath_ab * country + income , data = masc[masc$gender == "female",]) #summary(father.absence.reactivityf.income) #etasq(father.absence.reactivityf.income) ``` 3-category father absence for masculinity in female participants: Weak non-sig effect of fath_ab=1 vs fath_ab=0, US clearly less masculine, effect of fath_ab 1 on masculinity weaker in US than AUS. Adding income doesn't change any of these ```{r} masc$fath_ab <- as.factor(masc$fath_ab) # make sure fath_ab is a factor not continuous father.absence.masculinityf <- lm(masculinity ~ fath_ab * country, data = masc[masc$gender == "female",]) summary(father.absence.masculinityf) etasq(father.absence.masculinityf) #Here's the model with income too #father.absence.masculinityf.income <- lm(masculinity ~ fath_ab * country + income, data = masc[masc$gender == "female",]) #summary(father.absence.masculinityf.income) #etasq(father.absence.masculinityf.income) ``` We detour to investigate that interaction. There's a weak, non-sig effect of Fath_ab=1 vs 0 in Australia, nothing at all in America. Income makes no difference. ```{r} father.absence.masculinity.Aus <- lm(masculinity ~ fath_ab , data = masc[(masc$gender == "female")&(masc$country=="Australia"),]) summary(father.absence.masculinity.Aus) etasq(father.absence.masculinity.Aus) #Here's the model with income too #father.absence.masculinity.Aus.income <- lm(masculinity ~ fath_ab +income, data = masc[(masc$gender == "female")&(masc$country=="Australia"),]) #summary(father.absence.masculinity.Aus.income) #etasq(father.absence.masculinity.Aus.income) father.absence.masculinity.US <- lm(masculinity ~ fath_ab , data = masc[(masc$gender == "female")&(masc$country=="United State"),]) summary(father.absence.masculinity.US) etasq(father.absence.masculinity.US) #Here's the model with income too #father.absence.masculinity.US.income <- lm(masculinity ~ fath_ab +income, data = masc[(masc$gender == "female")&(masc$country=="United State"),]) #summary(father.absence.masculinity.US.income) #etasq(father.absence.masculinity.US.income) ``` 2-category father absence for reactivity in female participants: strong effect of country again; weak but sig effect of father absence ```{r} masc$f_ab_ever <- as.factor(masc$f_ab_ever) # make sure fath_ab is a factor not continuous father.absence.reactivity2f <- lm(reactivity ~ f_ab_ever*country, data = masc[masc$gender == "female",]) summary(father.absence.reactivity2f) etasq(father.absence.reactivity2f) #Here's the model with income too #father.absence.reactivity2f.income <- lm(reactivity ~ f_ab_ever*country+income, data = masc[masc$gender == "female",]) #summary(father.absence.reactivity2f.income) #etasq(father.absence.reactivity2f.income) ``` 2-category father absence for masculinity in female participants: no effects of FA, again Americans are less masculine ```{r} masc$f_ab_ever <- as.factor(masc$f_ab_ever) # make sure fath_ab is a factor not continuous father.absence.masculinity2f <- lm(masculinity ~ f_ab_ever*country, data = masc[masc$gender == "female",]) summary(father.absence.masculinity2f) etasq(father.absence.masculinity2f) #Here's the model with income too #father.absence.masculinity2f.income <- lm(masculinity ~ f_ab_ever*country+income, data = masc[masc$gender == "female",]) #summary(father.absence.masculinity2f.income) #etasq(father.absence.masculinity2f.income) ``` 2-category father absence for reactivity in male AUS participants: no effects ```{r} masc$f_ab_ever <- as.factor(masc$f_ab_ever) # make sure fath_ab is a factor not continuous father.absence.reactivity2m <- lm(reactivity ~ f_ab_ever, data = masc[masc$gender == "male",]) summary(father.absence.reactivity2m) etasq(father.absence.reactivity2m) #Here's the model with income too #father.absence.reactivity2m.income <- lm(reactivity ~ f_ab_ever+income, data = masc[masc$gender == "male",]) #summary(father.absence.reactivity2m.income) #etasq(father.absence.reactivity2m.income) ``` 2-category father absence for masculinity in male AUS participants: no effect of father absence ```{r} masc$f_ab_ever <- as.factor(masc$f_ab_ever) # make sure fath_ab is a factor not continuous father.absence.masculinity2m <- lm(masculinity ~ f_ab_ever, data = masc[masc$gender == "male",]) summary(father.absence.masculinity2m) etasq(father.absence.masculinity2m) #Here's the model with income too #father.absence.masculinity2m.income <- lm(masculinity ~ f_ab_ever+income, data = masc[masc$gender == "male",]) #summary(father.absence.masculinity2m.income) #etasq(father.absence.masculinity2m.income) ``` #Using relationship quality to predict factor scores. Does quality predict reactivity in women? yes - better relationship -> lower reactivity also effect of country (lower reactivity in US than Aus) no interaction ```{r} quality.reactivity.f <- lm(reactivity ~ FRQ*country, data = masc_ageset[masc_ageset$gender == "female",]) etasq(quality.reactivity.f) summary(quality.reactivity.f) #Here's the model with income too #quality.reactivity.f.income <- lm(reactivity ~ FRQ*country+income, data = masc_ageset[masc_ageset$gender == "female",]) #etasq(quality.reactivity.f.income) #summary(quality.reactivity.f.income) ``` Does quality predict masculinity in women? No! sig effect of country, no interaction R squared 0.03 ```{r} quality.masculinity.f <- lm(masculinity ~ FRQ*country, data = masc_ageset[masc_ageset$gender == "female",]) summary(quality.masculinity.f) etasq(quality.masculinity.f) #Here's the model with income too #quality.masculinity.f.income <- lm(masculinity ~ FRQ*country+income, data = masc_ageset[masc_ageset$gender == "female",]) #summary(quality.masculinity.f.income) #etasq(quality.masculinity.f.income) ``` Does quality predict reactivity in men? yes - better relationship -> lower reactivity also effect of country (lower reactivity in US than Aus) no interaction ```{r} quality.reactivity.m <- lm(reactivity ~ FRQ*country, data = masc_ageset[masc_ageset$gender == "male",]) etasq(quality.reactivity.m) summary(quality.reactivity.m) #Here's the model with income too #quality.reactivity.m.income <- lm(reactivity ~ FRQ*country+income, data = masc_ageset[masc_ageset$gender == "male",]) #etasq(quality.reactivity.m.income) #summary(quality.reactivity.m.income) ``` Does quality predict masculinity in men? No! marginal effect of country, no interaction R squared 0.03 ```{r} quality.masculinity.m <- lm(masculinity ~ FRQ*country, data = masc_ageset[masc_ageset$gender == "male",]) summary(quality.masculinity.m) etasq(quality.masculinity.m) #Here's the model with income too #quality.masculinity.m.income <- lm(masculinity ~ FRQ*country+income, data = masc_ageset[masc_ageset$gender == "male",]) #summary(quality.masculinity.m.income) #etasq(quality.masculinity.m.income) ``` #Finally we check how everything relates to reproductive outcomes. is father absence related to age at first coitus in women? lm predicting first coitus age with country, father-absence, and interaction 3-category father absence analysis: sig interaction between country and fath-ab1 ```{r} masc$fath_ab <- as.factor(masc$fath_ab) # make sure fath_ab is a factor not continuous father.absence.sex.f <- lm(sex_yr ~ fath_ab*country, data = masc[masc$gender == "female",]) summary(father.absence.sex.f) etasq(father.absence.sex.f) #income added to model #father.absence.sex.f.income <- lm(sex_yr ~ fath_ab*country + income, data = masc[masc$gender == "female",]) #summary(father.absence.sex.f.income) #etasq(father.absence.sex.f.income) ``` Looking at that interaction for coitus in women, there's a significant impact of father absence pre-12 in the US (those father absent when young have sex ~1.5 years earlier than father present). Nothing in Australia ```{r} father.absence.sex.Aus <- lm(sex_yr ~ fath_ab , data = masc[(masc$gender == "female")&(masc$country=="Australia"),]) summary(father.absence.sex.Aus) etasq(father.absence.sex.Aus) #Here's the model with income too #father.absence.sex.Aus.income <- lm(sex_yr ~ fath_ab +income, data = masc[(masc$gender == "female")&(masc$country=="Australia"),]) #summary(father.absence.sex.Aus.income) #etasq(father.absence.sex.Aus.income) father.absence.sex.US <- lm(sex_yr ~ fath_ab , data = masc[(masc$gender == "female")&(masc$country=="United State"),]) summary(father.absence.sex.US) etasq(father.absence.sex.US) #Here's the model with income too #father.absence.sex.US.income <- lm(sex_yr ~ fath_ab +income, data = masc[(masc$gender == "female")&(masc$country=="United State"),]) #summary(father.absence.sex.US.income) #etasq(father.absence.sex.US.income) ``` is father absence related to age at first coitus in (Aus) men? No ```{r} masc$fath_ab <- as.factor(masc$fath_ab) # make sure fath_ab is a factor not continuous father.absence.sex.m <- lm(sex_yr ~ f_ab_ever, data = masc[masc$gender == "male",]) summary(father.absence.sex.m) etasq(father.absence.sex.m) #income added to model #father.absence.sex.m.income <- lm(sex_yr ~ f_ab_ever + income, data = masc[masc$gender == "male",]) #summary(father.absence.sex.m.income) #etasq(father.absence.sex.m.income) ``` is father absence related to age at menarche in women? no clear evidence of effect of fath-ab, effect of country, or interaction ```{r} masc$fath_ab <- as.factor(masc$fath_ab) # make sure fath_ab is a factor not continuous father.absence.menarche <- lm(periodyr ~ fath_ab*country, data = masc) summary(father.absence.menarche) etasq(father.absence.menarche) #income added to model father.absence.menarche.income <- lm(periodyr ~ fath_ab*country + income, data = masc) summary(father.absence.menarche.income) etasq(father.absence.menarche.income) ``` does quality of family relationships predict reproductive outcomes? NB notice we've shifted back to the original age-selected data set as missing father absence data not a problem here and plenty of US males. first: does it predict age at menarche? no ```{r} quality.menarche <- lm(periodyr ~ FRQ*country, data = masc_ageset) summary(quality.menarche) etasq(quality.menarche) #income added to model #quality.menarche.income <- lm(periodyr ~ FRQ*country + income, data = masc_ageset) #summary(quality.menarche.income) #etasq(quality.menarche.income) ``` does quality of family relationships predict age at first coitus in women? sig interaction with country ```{r} quality.fc.f <- lm(sex_yr ~ FRQ*country, data = masc_ageset[masc_ageset$gender == "female",]) summary(quality.fc.f) etasq(quality.fc.f) #Model with income added #quality.fc.f.income <- lm(sex_yr ~ FRQ*country+income, data = masc_ageset[masc_ageset$gender == "female",]) #summary(quality.fc.f.income) #etasq(quality.fc.f.income) ``` that interaction for coitus and relationship quality in women, there's again a significant association in the US which remains when income is added to the model. Nothing in Australia either way. ```{r} #Aus women quality.sex.Aus <- lm(sex_yr ~ FRQ , data = masc_ageset[(masc_ageset$gender == "female")&(masc_ageset$country=="Australia"),]) summary(quality.sex.Aus) etasq(quality.sex.Aus) #Here's the model with income too #quality.sex.Aus.income <- lm(sex_yr ~ FRQ +income, data = masc_ageset[(masc_ageset$gender == "female")&(masc_ageset$country=="Australia"),]) #summary(quality.sex.Aus.income) #US women quality.sex.US <- lm(sex_yr ~ FRQ , data = masc_ageset[(masc_ageset$gender == "female")&(masc_ageset$country=="United State"),]) summary(quality.sex.US) etasq(quality.sex.US) #Here's the model with income too #quality.sex.US.income <- lm(sex_yr ~ FRQ +income, data = masc_ageset[(masc_ageset$gender == "female")&(masc_ageset$country=="United State"),]) #summary(quality.sex.US.income) ``` does quality of family relationships predict age at first coitus in men? no ```{r} quality.fc.m <- lm(sex_yr ~ FRQ*country, data = masc_ageset[masc_ageset$gender == "male",]) summary(quality.fc.m) etasq(quality.fc.m) #checking model with income #quality.fc.m.income <- lm(sex_yr ~ FRQ*country + income, data = masc_ageset[masc_ageset$gender == "male",]) #summary(quality.fc.m.income) #etasq(quality.fc.m.income) ``` #Checking income as a predictor of our measures of interest is father absence associated with lower income (regression other way round bc factors) ```{r} #not (quite) age at 1st sex income.sex_yr <- lm(sex_yr ~ income, data = masc_ageset) summary(income.sex_yr) #not age at menarche income.periodyr <- lm(periodyr ~ income, data = masc_ageset) summary(income.periodyr) #not reactivity income.reactivity <- lm(reactivity ~ income, data = masc_ageset) summary(income.reactivity) #not masculinity income.masculinity <- lm(masculinity ~ income, data = masc_ageset) summary(income.masculinity) #poorer relationships, associated with lower income income.quality <- lm(FRQ ~ income, data = masc_ageset) summary(income.quality) etasq(income.quality) #father absence father.absence.income <- lm(income ~ fath_ab, data = masc) summary(father.absence.income) etasq(father.absence.income) ``` graph age of first coitus in women ```{r} #subset relevant variables fcfgraph <- subset(masc, select=c(fath_ab, country, gender, sex_yr)) #women only fcfgraph <- fcfgraph[fcfgraph$gender == "female",] #drop na values fcfgraph <- fcfgraph %>% drop_na() nrow(fcfgraph) fcfgraph$fath_ab <- as.factor(fcfgraph$fath_ab) fcfgraph$country <- as.factor(fcfgraph$country) fcfgraph <- as.data.frame(fcfgraph) fcf_means <- ddply(fcfgraph, c("fath_ab"), summarise, mean=mean(sex_yr)) fcf_ses <- ddply(fcfgraph, c("fath_ab"), summarise, se=std.error(sex_yr)) #add the se column to the dataframe with means in it and check that the new dataframe is OK #yes, I know fcf_means$se <- fcf_ses$se str(fcf_means) #make bargraph of age at 1st coitus score +/- 2ses by f_ab_ever gfcf <- ggplot(data = fcf_means, aes(x=fath_ab, y= mean, ymin=mean-(2*se), ymax=mean+(2*se))) + geom_bar(position="dodge", stat = "identity") + geom_errorbar(position = position_dodge(0.9), width = 0.2, colour="black") + xlab("Father absent") + ylab("Age at first coitus") + scale_x_discrete(labels=c("0" = "Never", "0.5" = "After age 12", "1" = "Before age 12")) + theme_classic() gfcf ```