##### Do female spiders embed silk trails with information on their movement direction and phenotype, and do males follow trails accordingly? #### Michelle Beyer, Kardelen Oezguen Uludag, Maylis Lailler, Jonas O. Wolff, Monika J. B. Eberhard, Tomér Joseph Czaczkes, Cristina Tuni library(car) library(ggplot2) library(ggpubr) # ggqqplots library(plotrix) # std.error() library(plyr) # count() library(rstanarm) library(RVAideMemoire) # chi˛ post-hoc library(tidyverse) set.seed(1) setwd("C:/Users/Beyer/Desktop/PhD/Projects/Project 1 - Directionality/R files") #### Study 1 - Directional silk trail-following #### data <- read.csv2("ESM-No-choice.csv") # Adjust variable types for analysis data[,"Treatment"] <- as.factor(data[,"Treatment"]) data[,"Turned"] <- as.factor(data[,"Turned"]) data[,"DirectionSameAsFemale"] <- as.factor(data[,"DirectionSameAsFemale"]) data[,"Courted"] <- as.factor(data[,"Courted"]) # Data with silk trials only dfSilkOnly <- data[data$Treatment=="Unwashed"| data$Treatment=="Washed", c("DirectionSameAsFemale", "TimeInArena", "Treatment", "Test", "MassFemMg", "SizeFemMM", "ResidualIndexFem", "MassMaleMg", "SizeMaleMM", "ResidualIndexMale", "MassRelativeDifferenceFM", "SizeRelativeDifferenceFM", "Courted", "IdFem", "IdMale", "AgeMale", "AgeFem", "Date", "Turned", "NumberOfTurns")] # Data with controls (no-silk trials) only dfControls <- data[data$Treatment!="Unwashed" & data$Treatment!="Washed", c("Date", "Treatment", "DirectionFinalMale")] # New file for creation of variable "DirectionAlwaysSame" for every male dfCsmall <- read.csv2("ESM-Controls.csv") dfCsmall <- dfCsmall%>% drop_na() ### Descriptive statistics ## Number of males and females count(data, IdFem) # n = 19 females count(data, IdMale) # n = 31 males ## Mean age per sex mean(data$AgeFem, na.rm = TRUE) # 14.52 std.error(data$AgeFem, na.rm = TRUE) # 0.09 mean(data$AgeMale) # 14.71 std.error(data$AgeMale) # 0.07 ### Checking for between-individual day-based directional bias ### #count(dfControls, Date, DirectionFinalMale) binom.test(10, 12, p=0.5, conf.level=0.95) # Results # Bin.test (18May2021): p = 0.04, 83 %, 95 % CI, 52 %-98%, 2 out of 12. # Significant bias of males to choose the right (R) opposed to left direction. # 17May2021: L= 1/2 ; p=1.00 # 18May2021: L= 2/12 ; p=0.04 * # 19May2021: L= 1/3 ; p=1.00 # 21May2021: L= 1/6 ; p=0.22 # 22May2021: L= 11/18 ; p=0.48 # 26May2021: L= 1/3 ; p=1.00 # 27May2021: L= 0/3 ; p=0.25 # 30May2021: L= 3/3 ; p=0.25 # 02Jun2021: L= 7/9 ; p=0.18 # 03Jun2021: L= 2/3 ; p=1.00 # 04Jun2021: L= 6/15 ; p=0.61 # 05Jun2021: L= 1/6 ; p=0.22 # 06Jun2021: L= 5/6 ; p=0.22 # 07Jun2021: L= 1/3 ; p=1.00 ### Creation of subset-dataset excluding biased day May 18th 2021 dfSilkOnlyExclude <- dfSilkOnly[dfSilkOnly$Date != "18.05.2021",] #### Fitting the model for Table 1 #### # center and standardize numeric variables for biologically meaningful estimates dfSilkOnly$Test.cs <- (dfSilkOnly$Test-mean(dfSilkOnly$Test))/sd(dfSilkOnly$Test) dfSilkOnly <- dfSilkOnly %>% droplevels() modBase <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + (1|IdMale) + (1|IdFem), dfSilkOnly, family="binomial", iter = 4000) ### checking model assumptions # residuals plot -> fine ggqqplot(resid(modBase, type='deviance')) # residuals vs test variable -> all fine scatter.smooth(dfSilkOnly$Test, resid(modBase), main="Test number", xlab="Test number") plot(resid(modBase) ~ Treatment, dfSilkOnly, main="Treatment") plot(resid(modBase) ~ DirectionSameAsFemale, dfSilkOnly, main="Direction same as female") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modBase),resid(modBase)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modBase) # time/location correlationlation |acf assumes row number = time acf(resid(modBase)) # -> all good ## comparison fitted values vs. data # goodness of fit graph dfSilkOnly[,"DirNumber"] <- dfSilkOnly[,"DirectionSameAsFemale"] dfSilkOnly[,"DirNumber"] <- as.numeric(dfSilkOnly[,"DirectionSameAsFemale"]) dfSilkOnly$DirNumber[dfSilkOnly$DirectionSameAsFemale=="No"] <- 0 dfSilkOnly$DirNumber[dfSilkOnly$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modBase), jitter(dfSilkOnly$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modBase), seq(0,1, by=0.1)) means <- tapply(dfSilkOnly$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dfSilkOnly$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### drawing conclusions ### bsimBase <- as.data.frame(modBase) nsimBase <- nrow(bsimBase) # Calculating beta values apply(bsimBase, 2, mean)[c(1:3,(length(bsimBase)-1):length(bsimBase))] # Calculating credible intervals apply(bsimBase, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimBase)-1):length(bsimBase))] ## Results for Table 1 # Intercept 0.55 (-0.28, 1.44) # Treatment (washed) -1.23 (-2.37, -0.12) * # Test.cs 0.10 (-0.50, 0.71) # Id Male 0.42 (0.00, 2.28) # Id Female 0.29 (0.00, 1.66) ## Graphical depiction: Figure 2 # Create dataframe #count(dfSilkOnly, Treatment, DirectionSameAsFemale) Dir <- dfSilkOnly[, c("Treatment", "DirectionSameAsFemale")] unw <- Dir[Dir$Treatment=="Unwashed",] # N=31 was <- Dir[Dir$Treatment=="Washed",] # N=31 uPerc <- 19/(length(unw$DirectionSameAsFemale)) uPercN <- 12/(length(unw$DirectionSameAsFemale)) wPerc <- 11/length(was$DirectionSameAsFemale) wPercN <- 20/length(was$DirectionSameAsFemale) dfPercAll <- data.frame(Treatment=c("unwashed", "washed"), Percents=c(uPerc, wPerc), Absolute=c("n=19/31", "n=11/31"), CIlow = c(0.42, 0.19), CIupp = c(0.78, 0.55)) # Plot graph for Figure 2 ggplot(dfPercAll,aes(x=Treatment, y=Percents, fill=Treatment))+ geom_bar(stat="identity", col="black")+ geom_hline(yintercept=0.5, linetype="dashed", color = "grey30")+ geom_errorbar( aes(x=Treatment, ymin=CIlow, ymax=CIupp), width=0.1, colour="grey30", alpha=0.9, size=0.5)+ scale_y_continuous(limits=c(0.0,1.0),expand = c(0, 0))+ scale_x_discrete(labels= c("unwashed","washed"),expand = c(0.6, 0))+ ylab("prop. of males following female direction")+ xlab("female trail") + theme_light(base_size=15)+ geom_text(aes(label=Absolute),position=position_stack(vjust = 0.4))+ guides(color = guide_legend(reverse = FALSE))+ scale_fill_manual(values=c("grey40","grey88"))+ theme(legend.position = "none") ### Checking for directionality within the unwashed treatment ### ## Binomial test for investigating directionality #count(dfSilkOnly, Treatment, DirectionSameAsFemale) # Unwashed total: 31, Yes: 19, No: 12 # Washed total: 31, Yes: 11, No: 20 binom.test(19, 31, p=0.5, conf.level=0.95) # Results for unwashed treatment # Bin.test: p = 0.28, 61 %, 95 % CI, 42 % - 78 %, 19 out of 31. # No significant bias of males to always choose the same opposed to opposite direction of the female. binom.test(11, 31, p=0.5, conf.level=0.95) # Results for washed treatment # Binomial test: p = 0.15, 35 %, 95 % CI, 19 % - 55 %, 11 out of 31. # No significant bias of males to always choose the same opposed to opposite direction of the female. ### Checking for overall bias over all data points ### ## Within individual directional bias ## Binomial test for investigating directional bias # Removing duplicate entries for every male (= 1 entry per male left) dfCsmall <- dfCsmall[!duplicated(dfCsmall$IdMale), c("TreatmentOri","IdMale", "Test","DirectionAlwaysSame")] count(dfCsmall, DirectionAlwaysSame) # Y=12, N=19 binom.test(12,31, p=0.5, conf.level=0.95) # Results # Bin.test: p = 0.28, 39%, 95% CI, 22%-58%, 12 out of 31. # No significant bias of males to always choose the same opposed to varying directions. ## Between individual directional bias over all days count(dfControls, DirectionFinalMale) # Left = 42, Right = 50 binom.test(42,92, p=0.5, conf.level=0.95) # Results # Bin.test: p = 0.47, 46%, 95% CI, 35%-56%, 42 out of 92 # No significant bias of males to always choose a specific direction. ### Supplementary Material ### ## Silk line diameter in dependence of washing treatment data2 <- read.csv2("ESM-Diameter.csv") data2 <- data2[,c("IdFem", "Treatment", "DiameterLine1")] data2[,"Treatment"] <- as.factor(data2[,"Treatment"]) #count(data2, Treatment) sumDiam <- data2 %>% group_by(Treatment) %>% summarise( mean = mean(DiameterLine1), se = std.error(DiameterLine1), n = n() ) # pentane: 1.68 +- 0.29, n = 8 # unwashed : 1.17 +- 0.05, n = 6 # water: 1.44 +- 0.22, n = 5 anova <- aov(DiameterLine1 ~ Treatment, data = data2) summary(anova) # Anova # (one-way anova: F(2, 16) = 1.25, p = 0.31) ## Testing anova assumptions # Variance homogeneity - okay plot(anova, 1) leveneTest(DiameterLine1 ~ Treatment, data = data2) # Normality plot(anova,2) ## Post-hoc comparisons TukeyHSD(anova) data2$Treatment <- factor(data2$Treatment, levels = c("unwashed", "pentane", "water")) # Figure S2 ggplot(data2, aes(x=Treatment, y=DiameterLine1, fill=Treatment))+ geom_boxplot()+ geom_jitter(col="black", pch=1, width=0.04)+ xlab("treatment") + scale_x_discrete(labels= c("unwashed\nn=6", "pentane\nn=8","water\nn=5"), expand = c(0.6, 0.0))+ scale_y_continuous(limits = c(0.0,3.0), expand = c(0.0,0.0))+ ylab("silk line diameter [??m]")+ theme_light()+ theme(text = element_text(size = 15),legend.position = "none")+ scale_fill_manual("legend", values = c("grey40","grey88", "grey88")) ### Repetition of model simulations with excluded biased day #### Table S2 - fitting model from Table 1 #### # Center and standardize numeric variables for meaningful estimates dfSilkOnlyExclude <- dfSilkOnlyExclude %>% droplevels() dfSilkOnlyExclude$Test.cs <- (dfSilkOnlyExclude$Test-mean(dfSilkOnlyExclude$Test))/sd(dfSilkOnlyExclude$Test) modBaseExcl <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + (1|IdMale) + (1|IdFem), dfSilkOnlyExclude, family="binomial", iter = 4000) ### checking model assumptions # residuals plot -> fine ggqqplot(resid(modBaseExcl, type='deviance')) # residuals vs test variable -> all fine scatter.smooth(dfSilkOnlyExclude$Test, resid(modBaseExcl), main="Test number", xlab="Test number") plot(resid(modBaseExcl) ~ Treatment, dfSilkOnlyExclude, main="Treatment") plot(resid(modBaseExcl) ~ DirectionSameAsFemale, dfSilkOnlyExclude, main="Direction same as female") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modBaseExcl),resid(modBaseExcl)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modBaseExcl) # time/location correlationlation |acf assumes row number = time acf(resid(modBaseExcl)) # -> all good ## comparison fitted values vs. data # goodness of fit graph dfSilkOnlyExclude[,"DirNumber"] <- dfSilkOnlyExclude[,"DirectionSameAsFemale"] dfSilkOnlyExclude[,"DirNumber"] <- as.numeric(dfSilkOnlyExclude[,"DirectionSameAsFemale"]) dfSilkOnlyExclude$DirNumber[dfSilkOnlyExclude$DirectionSameAsFemale=="No"] <- 0 dfSilkOnlyExclude$DirNumber[dfSilkOnlyExclude$DirectionSameAsFemale=="Yes"] <- 1 par(mfrow=c(1,1)) plot(fitted(modBaseExcl), jitter(dfSilkOnlyExclude$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modBaseExcl), seq(0,1, by=0.1)) means <- tapply(dfSilkOnlyExclude$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dfSilkOnlyExclude$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### drawing conclusions ### count(dfSilkOnlyExclude, DirectionSameAsFemale) # Yes = 28, No = 26, total = 54 bsimBaseExcl <- as.data.frame(modBaseExcl) nsimBaseExcl <- nrow(bsimBaseExcl) apply(bsimBaseExcl, 2, mean)[c(1:3,(length(bsimBaseExcl)-1):length(bsimBaseExcl))] # beta values apply(bsimBaseExcl, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimBaseExcl)-1):length(bsimBaseExcl))] # credible intervals ## Results, n = 54 # Intercept 0.83 (-0.08, 1.91) # Treatment (washed) -1.45 (-2.76, -0.28) * # Test.cs 0.02 (-0.60, 0.66) # Id Male 0.50 (0.00, 2.73) # Id Female 0.33 (0.00, 2.00) ### Repetition of binomial tests with excluded data ### count(dfSilkOnlyExclude, Treatment, DirectionSameAsFemale) # Unwashed Yes = 18, No = 9, total = 27 # Washed Yes = 10, No = 17, total = 27 binom.test(18,27, p=0.5, conf.level=0.95) # p = 0.12, 67 %, 95 % CI: 46 % - 83 %, 18 out of 27 binom.test(10,27, p=0.5, conf.level=0.95) # p = 0.25, 37 %, 95 % CI: 19 % - 58 %, 10 out of 27 ### The effect of male behaviours during trials ### Descriptive statistics on turns ### count(dfSilkOnly, Treatment, Turned) # Unwashed: 11/31 turned, Washed: 4/31 turned # unwashed turned binom.test(11,31, p=0.5, conf.level=0.95) # Bin.test: p = 0.15, 35%, 95% CI, 19%-55%, 11 out of 31. # washed turned binom.test(4,31, p=0.5, conf.level=0.95) # Bin.test: p < 0.001, 12%, 95% CI, 3%-30%, 4 out of 31. sumT <- dfSilkOnly %>% group_by(Treatment, DirectionSameAsFemale, Turned)%>% summarise( n = n() ) sumTPerc <- data.frame(Treatment = c("unwashed", "washed"), Values = c(11, 31), Percentages = c(11/31, 4/31), AbsolutV = c("n=11/31", "n=4/31")) ## Graphical depiction: Figure S3 ggplot(sumTPerc, aes(x=Treatment, y=Percentages, fill=Treatment))+ geom_bar(stat = "identity", col="black")+ scale_x_discrete(labels= c("unwashed","washed"),expand = c(0.6, 0))+ xlab("female trail") + ylab("proportion of males that turned")+ scale_y_continuous(limits=c(0.0,1.0), expand = c(0.0, 0.0))+ theme_light()+ scale_fill_manual("legend", values = c("grey40","grey88"))+ theme(text = element_text(size = 15),legend.position = "none")+ geom_hline(yintercept=0.5, linetype="dashed", color = "grey30")+ geom_text(aes(label=AbsolutV),position=position_dodge(width = 0.9),vjust=-0.5) ## Graphical depiction: Figure S4 ggplot(dfSilkOnly, aes(x=NumberOfTurns, fill=Treatment))+ geom_bar(col="black",position = "dodge")+ facet_wrap(~Treatment)+ xlab("number of turns") + scale_x_continuous(breaks=seq(0,20,2), expand = c(0.01, 0.0))+ scale_y_continuous(limits = c(0,30), expand = c(0,0))+ ylab("number of males")+ theme_light()+ theme(text = element_text(size = 15),legend.position = "none")+ scale_fill_manual("legend", values = c("grey40","grey88")) #### Fitting exploratory models for Table S3 #### # Center and standardize variables for meaningful biological estimates (grand-mean-centering) dfSilkOnly$TimeInArena.cs <-(dfSilkOnly$TimeInArena-mean(dfSilkOnly$TimeInArena))/sd(dfSilkOnly$TimeInArena) modDirSuppTableS3 <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + TimeInArena.cs + Turned + (1|IdMale) + (1|IdFem), dfSilkOnly, family="binomial", iter=4000) ### checking model assumptions # residuals plot -> fine ggqqplot(resid(modDirSuppTableS3, type='deviance')) # residuals vs test variable -> all fine scatter.smooth(dfSilkOnly$Test, resid(modDirSuppTableS3), main="Test number", xlab="Test number") plot(resid(modDirSuppTableS3) ~ Turned, dfSilkOnly, main="Turned") plot(resid(modDirSuppTableS3) ~ Treatment, dfSilkOnly, main="Treatment") plot(resid(modDirSuppTableS3) ~ DirectionSameAsFemale, dfSilkOnly, main="Direction same as female") scatter.smooth(dfSilkOnly$TimeInArena, resid(modDirSuppTableS3), main="Time spent in arena", xlab="Time spent in arena [sec]") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modDirSuppTableS3),resid(modDirSuppTableS3)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modDirSuppTableS3) # time/location correlationlation |acf assumes row number = time acf(resid(modDirSuppTableS3)) # -> all good ## comparison fitted values vs. data # goodness of fit graph dfSilkOnly[,"DirNumber"] <- dfSilkOnly[,"DirectionSameAsFemale"] dfSilkOnly[,"DirNumber"] <- as.numeric(dfSilkOnly[,"DirectionSameAsFemale"]) dfSilkOnly$DirNumber[dfSilkOnly$DirectionSameAsFemale=="No"] <- 0 dfSilkOnly$DirNumber[dfSilkOnly$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modDirSuppTableS3), jitter(dfSilkOnly$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modDirSuppTableS3), seq(0,1, by=0.1)) means <- tapply(dfSilkOnly$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dfSilkOnly$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimDirSuppTableS3 <- as.data.frame(modDirSuppTableS3) nsimDirSuppTableS3 <- nrow(bsimDirSuppTableS3) # Calculating beta values apply(bsimDirSuppTableS3, 2, mean)[c(1:5,(length(bsimDirSuppTableS3)-1):length(bsimDirSuppTableS3))] # Calculating credible intervals apply(bsimDirSuppTableS3, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS3)-1):length(bsimDirSuppTableS3))] ## Results # Intercept 0.54 (-0.50, 1.64) # Treatment (washed) -1.25 (-2.49, -0.09) * # Test.cs 0.09 (-0.52, 0.70) # Time spent in arena.cs -0.08 (-0.83, 0.65) # Turned (yes) 0.13 (-1.55, 1.87) # Id Male 0.52 (0.00, 2.78) # Id Female 0.34 (0.00, 1.92) ### Exploratory models testing for the effect of individual phenotypic traits ## Effects of female body mass, size and condition ## Table S4 A) Female body mass # Center and standardize variables for meaningful biological estimates (grand-mean-centering) dfSilkOnly$MassFemMg.cs <- (dfSilkOnly$MassFemMg-mean(dfSilkOnly$MassFemMg))/sd(dfSilkOnly$MassFemMg) modDirSuppTableS4A <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + MassFemMg.cs + Treatment:MassFemMg.cs + (1|IdMale) + (1|IdFem), dfSilkOnly, family="binomial", iter=4000) ### checking model assumptions # residuals plot -> fine ggqqplot(resid(modDirSuppTableS4A, type='deviance')) # residuals vs test variable -> all fine scatter.smooth(dfSilkOnly$Test, resid(modDirSuppTableS4A), main="Test number", xlab="Test number") plot(resid(modDirSuppTableS4A) ~ Treatment, dfSilkOnly, main="Treatment") plot(resid(modDirSuppTableS4A) ~ DirectionSameAsFemale, dfSilkOnly, main="Direction same as female") scatter.smooth(dfSilkOnly$MassFemMg, resid(modDirSuppTableS4A), main="Female weight", xlab="Female weight [mg]") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modDirSuppTableS4A),resid(modDirSuppTableS4A)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modDirSuppTableS4A) # time/location correlationlation |acf assumes row number = time acf(resid(modDirSuppTableS4A)) # -> one peak at lag 6 ## comparison fitted values vs. data # goodness of fit graph dfSilkOnly[,"DirNumber"] <- dfSilkOnly[,"DirectionSameAsFemale"] dfSilkOnly[,"DirNumber"] <- as.numeric(dfSilkOnly[,"DirectionSameAsFemale"]) dfSilkOnly$DirNumber[dfSilkOnly$DirectionSameAsFemale=="No"] <- 0 dfSilkOnly$DirNumber[dfSilkOnly$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modDirSuppTableS4A), jitter(dfSilkOnly$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modDirSuppTableS4A), seq(0,1, by=0.1)) means <- tapply(dfSilkOnly$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dfSilkOnly$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### drawing conclusions ### bsimDirSuppTableS4A <- as.data.frame(modDirSuppTableS4A) nsimDirSuppTableS4A <- nrow(bsimDirSuppTableS4A) # Calculating beta values apply(bsimDirSuppTableS4A, 2, mean)[c(1:5,(length(bsimDirSuppTableS4A)-1):length(bsimDirSuppTableS4A))] # Calculating credible intervals apply(bsimDirSuppTableS4A, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS4A)-1):length(bsimDirSuppTableS4A))] ## Results, n = 62 # Intercept 0.78 (-0.20, 1.89) # Treatment (washed) -1.49 (-2.80, -0.27) * # Test.cs 0.03 (-0.61, 0.66) # Female mass.cs 1.59 ( 0.43, 3.03) * # Treatment(w):mass.cs -1.83 (-3.48, -0.44) * # Id Male 0.62 (0.00, 3.40) # Id Female 0.38 (0.00, 2.15) ## Table S4 B) Female body condition # Center and standardize variables for meaningful biological estimates (grand-mean-centering) dfSilkOnlyRI <- dfSilkOnly %>% drop_na(ResidualIndexFem) dfSilkOnlyRI$ResIndFem.cs <- (dfSilkOnlyRI$ResidualIndexFem-mean(dfSilkOnlyRI$ResidualIndexFem, na.rm = TRUE))/sd(dfSilkOnlyRI$ResidualIndexFem, na.rm = TRUE) modDirSuppTableS4B <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + ResIndFem.cs + Treatment:ResIndFem.cs + (1|IdMale) + (1|IdFem), dfSilkOnlyRI, family="binomial", iter=4000) ### checking model assumptions # residuals plot -> fine ggqqplot(resid(modDirSuppTableS4B, type='deviance')) # residuals vs test variable -> all fine scatter.smooth(dfSilkOnlyRI$Test, resid(modDirSuppTableS4B), main="Test number", xlab="Test number") plot(resid(modDirSuppTableS4B) ~ Treatment, dfSilkOnlyRI, main="Treatment") plot(resid(modDirSuppTableS4B) ~ DirectionSameAsFemale, dfSilkOnlyRI, main="Direction same as female") scatter.smooth(dfSilkOnlyRI$ResidualIndexFem, resid(modDirSuppTableS4B), main="Female condition index", xlab="Female condition index") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modDirSuppTableS4B),resid(modDirSuppTableS4B)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modDirSuppTableS4B) # time/location correlationlation |acf assumes row number = time acf(resid(modDirSuppTableS4B)) # all good ## comparison fitted values vs. data # goodness of fit graph dfSilkOnlyRI[,"DirNumber"] <- dfSilkOnlyRI[,"DirectionSameAsFemale"] dfSilkOnlyRI[,"DirNumber"] <- as.numeric(dfSilkOnlyRI[,"DirectionSameAsFemale"]) dfSilkOnlyRI$DirNumber[dfSilkOnlyRI$DirectionSameAsFemale=="No"] <- 0 dfSilkOnlyRI$DirNumber[dfSilkOnlyRI$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modDirSuppTableS4B), jitter(dfSilkOnlyRI$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modDirSuppTableS4B), seq(0,1, by=0.1)) means <- tapply(dfSilkOnlyRI$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dfSilkOnlyRI$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### drawing conclusions ### bsimDirSuppTableS4B <- as.data.frame(modDirSuppTableS4B) nsimDirSuppTableS4B <- nrow(bsimDirSuppTableS4B) # Calculating beta values apply(bsimDirSuppTableS4B, 2, mean)[c(1:5,(length(bsimDirSuppTableS4B)-1):length(bsimDirSuppTableS4B))] # Calculating credible intervals apply(bsimDirSuppTableS4B, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS4B)-1):length(bsimDirSuppTableS4B))] ## Results, n = 50 # Intercept 1.00 (-0.18, 2.37) # Treatment (washed) -1.94 (-3.63, -0.41) * # Test.cs 0.08 (-0.74, 0.88) # Female ResInd.cs 1.55 ( 0.33, 3.01) * # Treatment(w):ResInd.cs -1.52 (-3.15, -0.01) * # Id Male 0.98 (0.00, 5.56) # Id Female 0.47 (0.00, 2.90) ## Table S4 C) Female body size # Center and standardize variables for meaningful biological estimates (grand-mean-centering) dfSilkOnlySize <- dfSilkOnly %>% drop_na(SizeFemMM) dfSilkOnlySize$SizeFem.cs <- (dfSilkOnlySize$SizeFemMM-mean(dfSilkOnlySize$SizeFemMM))/sd(dfSilkOnlySize$SizeFemMM) modDirSuppTableS4C <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + SizeFem.cs + Treatment:SizeFem.cs + (1|IdMale) + (1|IdFem), dfSilkOnlySize, family="binomial", iter=4000) ### checking model assumptions # residuals plot -> fine ggqqplot(resid(modDirSuppTableS4C, type='deviance')) # residuals vs test variable -> all fine scatter.smooth(dfSilkOnlySize$Test, resid(modDirSuppTableS4C), main="Test number", xlab="Test number") plot(resid(modDirSuppTableS4C) ~ Treatment, dfSilkOnlySize, main="Treatment") plot(resid(modDirSuppTableS4C) ~ DirectionSameAsFemale, dfSilkOnlySize, main="Direction same as female") scatter.smooth(dfSilkOnlySize$SizeFemMM, resid(modDirSuppTableS4C), main="Female body size", xlab="Female body size [mm]") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modDirSuppTableS4C),resid(modDirSuppTableS4C)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modDirSuppTableS4C) # time/location correlationlation |acf assumes row number = time acf(resid(modDirSuppTableS4C)) # all good ## comparison fitted values vs. data # goodness of fit graph dfSilkOnlySize[,"DirNumber"] <- dfSilkOnlySize[,"DirectionSameAsFemale"] dfSilkOnlySize[,"DirNumber"] <- as.numeric(dfSilkOnlySize[,"DirectionSameAsFemale"]) dfSilkOnlySize$DirNumber[dfSilkOnlySize$DirectionSameAsFemale=="No"] <- 0 dfSilkOnlySize$DirNumber[dfSilkOnlySize$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modDirSuppTableS4C), jitter(dfSilkOnlySize$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modDirSuppTableS4C), seq(0,1, by=0.1)) means <- tapply(dfSilkOnlySize$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dfSilkOnlySize$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### drawing conclusions ### bsimDirSuppTableS4C <- as.data.frame(modDirSuppTableS4C) nsimDirSuppTableS4C <- nrow(bsimDirSuppTableS4C) # Calculating beta values apply(bsimDirSuppTableS4C, 2, mean)[c(1:5,(length(bsimDirSuppTableS4C)-1):length(bsimDirSuppTableS4C))] # Calculating credible intervals apply(bsimDirSuppTableS4C, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS4C)-1):length(bsimDirSuppTableS4C))] ## Results, n = 50 # Intercept 0.93 (-0.24, 2.41) # Treatment (washed) -2.01 (-3.96, -0.49) * # Test.cs 0.39 (-0.41, 1.25) # Female Size.cs 0.58 (-0.55, 1.90) # Treatment(w):Size.cs -1.48 (-3.35, 0.04) # Id Male 1.74 (0.00, 9.04) # Id Female 0.79 (0.00, 4.85) ### Graphical depiction: Figure S5 (effect plot) ## The effect of Treatment*female body mass on the response newdatDir3 <- expand.grid(Treatment=factor(levels(dfSilkOnly$Treatment), levels=levels(dfSilkOnly$Treatment)), MassFemMg=seq(90,165), TimeInArena.cs = 0, Test.cs = 0) newdatDir3$MassFemMg.cs <- (newdatDir3$MassFemMg-mean(dfSilkOnly$MassFemMg))/sd(dfSilkOnly$MassFemMg) XmatDir3 <- model.matrix(~ 1 + Treatment + Test.cs + TimeInArena.cs + MassFemMg.cs + Treatment:MassFemMg.cs, data=newdatDir3) bDir3 <- as.numeric(apply(bsimDir, 2, mean)[1:ncol(XmatDir3)]) newdatDir3$fit <- plogis(XmatDir3 %*% bDir3) fitmatDir3 <- matrix(ncol=nsimDir, nrow=nrow(newdatDir3)) for(i in 1:nsimDir) fitmatDir3[,i] <- plogis(XmatDir3 %*% as.numeric(bsimDir[i, 1:ncol(XmatDir3)])) newdatDir3$lwr <- apply(fitmatDir3, 1, quantile, prob=0.025) newdatDir3$upr <- apply(fitmatDir3, 1, quantile, prob=0.975) ix1 <- newdatDir3$Treatment=="Unwashed" ix2 <- newdatDir3$Treatment=="Washed" #jpeg(file="EPmain_TreatmentxFemWeight.jpg", height=5000, width=8000, res=1000) par(mar=c(5,5,2,9)) plot(newdatDir3$MassFemMg,newdatDir3$fit,type="n", xlab="female body mass [mg]", ylab="prop. of males following female direction", ylim=c(-0.05, 1.05), las=1, cex.lab=1.3, cex.axis=1.2) grid(lty=1, col=("grey90")) #rug(dfSilkOnly$MassFemMg, # lwd = 1.5, # col=rgb(1,0,0,alpha=0.2)) # add results for washed polygon(c(newdatDir3$MassFemMg[ix2], rev(newdatDir3$MassFemMg[ix2])), c(newdatDir3$lwr[ix2], rev(newdatDir3$upr[ix2])), border=NA, col=grey(0.825,alpha=0.5)) lines(newdatDir3$MassFemMg[ix2],newdatDir3$fit[ix2],col="grey60", lty=2) washed <- dfSilkOnly[dfSilkOnly$Treatment=="Washed",c("MassFemMg", "Treatment", "DirectionSameAsFemale")] points(washed$MassFemMg, jitter(as.numeric(washed$DirectionSameAsFemale)-1, amount=0.04), col="grey80", pch=16) # add results for unwashed polygon(c(newdatDir3$MassFemMg[ix1], rev(newdatDir3$MassFemMg[ix1])), c(newdatDir3$lwr[ix1], rev(newdatDir3$upr[ix1])), border=NA, col=grey(0.4, alpha = 0.5)) lines(newdatDir3$MassFemMg[ix1],newdatDir3$fit[ix1]) unwashed <- dfSilkOnly[dfSilkOnly$Treatment=="Unwashed",c("MassFemMg", "Treatment", "DirectionSameAsFemale")] points(unwashed$MassFemMg, jitter(as.numeric(unwashed$DirectionSameAsFemale)-1, amount=0.05), col=grey(0.2, alpha = 0.5)) legend(x=170,y=1,xpd=NA, legend=c("Unwashed", "Washed"), title="female trail", col=c("black", "grey60"), lty=1:2) #dev.off() ## Splitting of silk data into 3 thirds due to sigmoidal shape dfThirds <-dfSilkOnly[dfSilkOnly$Treatment=="Unwashed", c("MassFemMg", "DirectionSameAsFemale")] dfThirds <- dfThirds %>% arrange(MassFemMg)%>% mutate(quartile = ntile(MassFemMg, 3)) #count(dfThirds, quartile,DirectionSameAsFemale) ## Calculation of mean and standard error for all quartiles qsum <- dfThirds %>% group_by(quartile) %>% summarise(mean = mean(MassFemMg), s.e. = std.error(MassFemMg)) binom.test(19,31, p=0.5, conf.level=0.95) # smallest third (110.64 +- 2.70 mg) binom.test(5,11, p=0.5, conf.level=0.95) # p = 1 # p = 1, 45 %, 95 % CI: 17 % - 77 %, 5 out of 11 # medium third (123.90 +- 0.59 mg) binom.test(5,10, p=0.5, conf.level=0.95) # p = 1 # p = 1, 50 %, 95 % CI: 19 % - 81 %, 5 out of 10 # biggest third (140.20 +- 3.79 mg) binom.test(9,10, p=0.5, conf.level=0.95) # p = 0.02 # p = 0.02, 90 %, 95 % CI: 55 % - 100 % ## Effects of male body mass, size and condition ## Table S5 A) male body mass # Center variables for biologically meaningful estimates dfSilkOnly$MassMaleMg.cs <- (dfSilkOnly$MassMaleMg - mean(dfSilkOnly$MassMaleMg))/sd(dfSilkOnly$MassMaleMg) modDirSuppTableS5A <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + MassMaleMg.cs + (1|IdMale) + (1|IdFem), dfSilkOnly, family="binomial", iter=4000) ### Drawing conclusions ### bsimDirSuppTableS5A <- as.data.frame(modDirSuppTableS5A) nsimDirSuppTableS5A <- nrow(bsimDirSuppTableS5A) # Calculating beta values apply(bsimDirSuppTableS5A, 2, mean)[c(1:4,(length(bsimDirSuppTableS5A)-1):length(bsimDirSuppTableS5A))] # Calculating credible intervals apply(bsimDirSuppTableS5A, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS5A)-1):length(bsimDirSuppTableS5A))] # Results, n = 62 # Intercept 0.57 (-0.27, 1.48) # Treatment (washed) -1.26 (-2.46, -0.15) * # Test.cs 0.11 (-0.49, 0.70) # Mass Male.cs -0.12 (-0.80, 0.55) # Id Male 0.51 (0.00, 2.95) # Id Female 0.32 (0.00, 1.94) ## Table S5 B) male body condition # Center variables for biologically meaningful estimates dfSilkOnlyRImale <- dfSilkOnly %>% drop_na(ResidualIndexMale) dfSilkOnlyRImale$ResIndMale.cs <- (dfSilkOnlyRImale$ResidualIndexMale - mean(dfSilkOnlyRImale$ResidualIndexMale))/sd(dfSilkOnlyRImale$ResidualIndexMale) modDirSuppTableS5B <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + ResIndMale.cs + (1|IdMale) + (1|IdFem), dfSilkOnlyRImale, family="binomial", iter=4000) ### Drawing conclusions ### bsimDirSuppTableS5B <- as.data.frame(modDirSuppTableS5B) nsimDirSuppTableS5B <- nrow(bsimDirSuppTableS5B) # Calculating beta values apply(bsimDirSuppTableS5B, 2, mean)[c(1:4,(length(bsimDirSuppTableS5B)-1):length(bsimDirSuppTableS5B))] # Calculating credible intervals apply(bsimDirSuppTableS5B, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS5B)-1):length(bsimDirSuppTableS5B))] # Results, n = 52 # Intercept 0.80 (-0.16, 1.89) # Treatment (washed) -1.55 (-2.89, -0.30) * # Test.cs 0.06 (-0.62, 0.75) # ResInd Male.cs 0.22 (-0.54, 1.01) # Id Male 0.49 (0.00, 2.82) # Id Female 0.55 (0.00, 3.10) ## Table S5 C) male body size # Center variables for biologically meaningful estimates dfSilkOnlySizemale <- dfSilkOnly %>% drop_na(SizeMaleMM) dfSilkOnlySizemale$SizeMale.cs <- (dfSilkOnlySizemale$SizeMaleMM - mean(dfSilkOnlySizemale$SizeMaleMM))/sd(dfSilkOnlySizemale$SizeMaleMM) modDirSuppTableS5C <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + SizeMale.cs + (1|IdMale) + (1|IdFem), dfSilkOnlySizemale, family="binomial", iter=4000) ### Drawing conclusions ### bsimDirSuppTableS5C <- as.data.frame(modDirSuppTableS5C) nsimDirSuppTableS5C <- nrow(bsimDirSuppTableS5C) # Calculating beta values apply(bsimDirSuppTableS5C, 2, mean)[c(1:4,(length(bsimDirSuppTableS5C)-1):length(bsimDirSuppTableS5C))] # Calculating credible intervals apply(bsimDirSuppTableS5C, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS5C)-1):length(bsimDirSuppTableS5C))] # Results, n = 52 # Intercept 0.82 (-0.17, 1.91) # Treatment (washed) -1.58 (-3.00, -0.27) * # Test.cs 0.07 (-0.59, 0.75) # Size Male.cs -0.47 (-1.29, 0.26) # Id Male 0.47 (0.00, 2.67) # Id Female 0.54 (0.00, 3.14) ## Effects of relative difference in female and male body mass and size ## Table S6 A) relative difference in body mass # All data modDirSuppTableS6A <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + MassRelativeDifferenceFM + (1|IdMale) + (1|IdFem), dfSilkOnly, family="binomial", iter=4000) ### drawing conclusions ### bsimDirSuppTableS6A <- as.data.frame(modDirSuppTableS6A) nsimDirSuppTableS6A <- nrow(bsimDirSuppTableS6A) # Calculating beta values apply(bsimDirSuppTableS6A, 2, mean)[c(1:4,(length(bsimDirSuppTableS6A)-1):length(bsimDirSuppTableS6A))] # Calculating credible intervals apply(bsimDirSuppTableS6A, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS6A)-1):length(bsimDirSuppTableS6A))] # Results # n = 62 # Intercept -0.87 (-3.92, 2.13) # Treatment (washed) -1.27 (-2.46, -0.14) * # Test.cs 0.09 (-0.49, 0.68) # RelDiff Mass 1.01 (-0.99, 3.14) # Id Male 0.49 (0.00, 2.65) # Id Female 0.27 (0.00, 1.58) ## Table S6 B) relative difference in body size # All data modDirSuppTableS6B <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs + SizeRelativeDifferenceFM + (1|IdMale) + (1|IdFem), dfSilkOnly, family="binomial", iter=4000) ### drawing conclusions ### bsimDirSuppTableS6B <- as.data.frame(modDirSuppTableS6B) nsimDirSuppTableS6B <- nrow(bsimDirSuppTableS6B) # Calculating beta values apply(bsimDirSuppTableS6B, 2, mean)[c(1:4,(length(bsimDirSuppTableS6B)-1):length(bsimDirSuppTableS6B))] # Calculating credible intervals apply(bsimDirSuppTableS6B, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS6B)-1):length(bsimDirSuppTableS6B))] # Results # n = 42 # Intercept -4.41 (-17.31, 6.86) # Treatment (washed) -1.73 (-3.37, -0.25) * # Test.cs 0.27 (-0.53, 1.11) # RelDiff Size 5.24 (-5.83, 18.16) # Id Male 0.66 (0.00, 3.82) # Id Female 0.90 (0.00, 5.08) ## Table S7 A) relative difference in body mass # Unwashed data only dfSilkOnlyUnw <- dfSilkOnly[dfSilkOnly$Treatment == "Unwashed",] modDirSuppTableS6Aunw <- stan_glmer(DirectionSameAsFemale ~ 1 + Test.cs + MassRelativeDifferenceFM + (1|IdMale) + (1|IdFem), dfSilkOnlyUnw, family="binomial", iter=4000) ### drawing conclusions ### bsimDirSuppTableS6Aunw <- as.data.frame(modDirSuppTableS6Aunw) nsimDirSuppTableS6Aunw <- nrow(bsimDirSuppTableS6Aunw) # Calculating beta values apply(bsimDirSuppTableS6Aunw, 2, mean)[c(1:3,(length(bsimDirSuppTableS6Aunw)-1):length(bsimDirSuppTableS6Aunw))] # Calculating credible intervals apply(bsimDirSuppTableS6Aunw, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimDirSuppTableS6Aunw)-1):length(bsimDirSuppTableS6Aunw))] # Results # n = 31 # Intercept 1.39 (-5.48, 9.53) # Test.cs 0.57 (-0.82, 2.34) # RelDiff Mass -0.35 (-5.53, 4.52) # Id Male 7.71 (0.00, 39.49) # Id Female 1.83 (0.00, 10.48) # Table S7 B) relative difference in body size # Unwashed data only modDirSuppTableS6Bunw <- stan_glmer(DirectionSameAsFemale ~ 1 + Test.cs + SizeRelativeDifferenceFM + (1|IdMale) + (1|IdFem), dfSilkOnlyUnw, family="binomial", iter=4000) ### drawing conclusions ### bsimDirSuppTableS6Bunw <- as.data.frame(modDirSuppTableS6Bunw) nsimDirSuppTableS6Bunw <- nrow(bsimDirSuppTableS6Bunw) # Calculating beta values apply(bsimDirSuppTableS6Bunw, 2, mean)[c(1:3,(length(bsimDirSuppTableS6Bunw)-1):length(bsimDirSuppTableS6Bunw))] # Calculating credible intervals apply(bsimDirSuppTableS6Bunw, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimDirSuppTableS6Bunw)-1):length(bsimDirSuppTableS6Bunw))] # Results, n = 21 # Intercept -9.36 (-36.04, 12.78) # Test.cs 1.47 (-0.11, 3.54) # RelDiff Mass 10.30 (-11.21, 36.88) # Id Male 3.86 (0.00, 22.89) # Id Female 2.69 (0.00, 15.79) ##################################################### ##################################################### ##################################################### #### Study 2 - Effects of female phenotype on male directional trail following #### ### Data from Summer 2022 ### # Set working directory setwd("C:/Users/Beyer/Desktop/PhD/Projects/Project 3 - Mass-dependent directionality") # Set internal seed to get comparable results set.seed(1) ### Prepare data frames ## Complete data frame ## Read in data from spring 2022 dataMDss <- read.csv2("ESM-MassdependentDirectionality.csv") ## Read in data from autumn/winter 2022/2023 dataMDws <- read.csv2("ESM-MassdependentDirectionality23.csv") dataMDws$TreatmentMale <- "WF" ## Prepare data frames for merging together dfSilkss <- dataMDss[dataMDss$TreatmentMale == "WF" & (dataMDss$TreatmentFem == "WF" | dataMDss$TreatmentFem == "LF"), c("Date", "Season", "IdMale", "AgeMale", "TrialNumber", "MassMaleMg", "SizeMale", "ResidualIndexMale", "IdFemale", "AgeFemale","TreatmentFem", "MassFemaleMg", "MassDifferenceAbsoluteFM", "MassDifferenceRelativeFM" , "SizeFemale", "SizeDifferenceAbsoluteFM", "SizeDifferenceRelativeFM", "ResidualIndexFem", "DirectionSameAsFemale")] dfSilkws <- dataMDws[(dataMDws$TreatmentFem == "WF" | dataMDws$TreatmentFem == "LF"), c("Date", "Season", "IdMale", "AgeMale", "TrialNumber", "MassMaleMg", "SizeMale", "ResidualIndexMale", "IdFemale", "AgeFemale","TreatmentFem", "MassFemaleMg", "MassDifferenceAbsoluteFM", "MassDifferenceRelativeFM" , "SizeFemale", "SizeDifferenceAbsoluteFM", "SizeDifferenceRelativeFM", "ResidualIndexFem", "DirectionSameAsFemale", "TimeSpentSilkLayingSec", "Brush")] dfSilkwsSmall <- dfSilkws[, c("Date", "Season", "IdMale", "AgeMale", "TrialNumber", "MassMaleMg", "SizeMale", "ResidualIndexMale", "IdFemale", "AgeFemale","TreatmentFem", "MassFemaleMg", "MassDifferenceAbsoluteFM" , "MassDifferenceRelativeFM", "SizeFemale", "SizeDifferenceAbsoluteFM", "SizeDifferenceRelativeFM", "ResidualIndexFem", "DirectionSameAsFemale")] ## Data frame with controls only dfCtrlss <- dataMDss[dataMDss$TreatmentMale == "WF" & (dataMDss$TreatmentFem == "Ctrl"), c("Date", "Season", "IdMale","TreatmentFem", "DirectionMale")] dfCtrlws <- dataMDws[dataMDws$TreatmentMale == "WF" & (dataMDws$TreatmentFem == "Ctrl"), c("Date", "Season", "IdMale","TreatmentFem", "DirectionMale")] # Remove NAs from control data dfCtrlssNA <- dfCtrlss %>% drop_na(DirectionMale) dfCtrlwsNA <- dfCtrlws %>% drop_na(DirectionMale) ## Merge data frames together - silk only mergedSoWi <- rbind(dfSilkss, dfSilkwsSmall) ## Merge data frames together - controls only mergedCtrlSoWi <- rbind(dfCtrlssNA, dfCtrlwsNA) # Remove NAs from silk data mergedSoWiNA <- mergedSoWi %>% drop_na(DirectionSameAsFemale) # Subsetting dataframe, excluding results from biased day 24.05.2022 mergedSoWiNAExcl <- mergedSoWiNA[mergedSoWiNA$Date != "24.05.2022",] # Check data types of variables #str(mergedSoWi) #str(mergedCtrlSoWi) # adjust variable types for analysis mergedSoWiNA[,"Season"] <- as.factor(mergedSoWiNA[,"Season"]) mergedSoWiNA[,"TreatmentFem"] <- as.factor(mergedSoWiNA[,"TreatmentFem"]) mergedSoWiNA[,"DirectionSameAsFemale"] <- as.factor(mergedSoWiNA[,"DirectionSameAsFemale"]) mergedCtrlSoWi[,"Season"] <- as.factor(mergedCtrlSoWi[,"Season"]) mergedCtrlSoWi[,"TreatmentFem"] <- as.factor(mergedCtrlSoWi[,"TreatmentFem"]) mergedCtrlSoWi[,"DirectionMale"] <- as.factor(mergedCtrlSoWi[,"DirectionMale"]) ## Mean center and standardize variables for easier biological interpretation of the results mergedSoWiNA$TrialNumber.cs <- (mergedSoWiNA$TrialNumber - mean(mergedSoWiNA$TrialNumber))/sd(mergedSoWiNA$TrialNumber) mergedSoWiNA$MassFemaleMg.cs <- (mergedSoWiNA$MassFemaleMg - mean(mergedSoWiNA$MassFemaleMg))/sd(mergedSoWiNA$MassFemaleMg) mergedSoWiNA$MassMaleMg.cs <- (mergedSoWiNA$MassMaleMg - mean(mergedSoWiNA$MassMaleMg))/sd(mergedSoWiNA$MassMaleMg) mergedSoWiNA$SizeFem.cs <- (mergedSoWiNA$SizeFemale - mean(mergedSoWiNA$SizeFemale))/sd(mergedSoWiNA$SizeFemale) mergedSoWiNA$SizeMale.cs <- (mergedSoWiNA$SizeFemale - mean(mergedSoWiNA$SizeMale, na.rm = TRUE))/sd(mergedSoWiNA$SizeMale, na.rm = TRUE) mergedSoWiNA$ResidualIndexFem.cs <- (mergedSoWiNA$ResidualIndexFem - mean(mergedSoWiNA$ResidualIndexFem, na.rm = TRUE))/sd(mergedSoWiNA$ResidualIndexFem, na.rm = TRUE) mergedSoWiNA$ResidualIndexMale.cs <- (mergedSoWiNA$ResidualIndexMale - mean(mergedSoWiNA$ResidualIndexMale, na.rm = TRUE))/sd(mergedSoWiNA$ResidualIndexMale , na.rm = TRUE) # Assign unique IDs for animals from different seasons mergedSoWiNA$IdFemaleOriginal <- mergedSoWiNA$IdFemale mergedSoWiNA[mergedSoWiNA$Season == "WiSe",]$IdFemale <- mergedSoWiNA[mergedSoWiNA$Season == "WiSe",]$IdFemale + 500 mergedSoWiNA$IdMaleOriginal <- mergedSoWiNA$IdMale mergedSoWiNA[mergedSoWiNA$Season == "WiSe",]$IdMale <- mergedSoWiNA[mergedSoWiNA$Season == "WiSe",]$IdMale + 500 #### Statistical analysis #### ## Individual age mean(mergedSoWiNA$AgeFemale) # 14.53 std.error(mergedSoWiNA$AgeFemale) # 0.11 mean(mergedSoWiNA$AgeMale) # 15.40 std.error(mergedSoWiNA$AgeMale) # 0.15 ### Checking effects of feeding regime ### ## Number of females in feeding regimes #count(mergedSoWiNA, TreatmentFem, IdFemale) # WF = 53, LF = 48 ## Female body mass # Number of trials in each treatment #count(mergedSoWiNA, TreatmentFem) # WF = 58, LF = 57 # Two-sample t-test t.test(MassFemaleMg ~ TreatmentFem, data = mergedSoWiNA, na.rm = TRUE) # t = -8.20, d.f. = 112.76, p < 0.001 # WF: 116.00 +- 2.56 mg, n = 58; LF: 85.79 +- 2.65 mg, n = 57 # Well-fed females were heavier than low-fed females. sumMassSoWi <- mergedSoWiNA %>% group_by(TreatmentFem) %>% summarise( mean = mean(MassFemaleMg), s.e. = std.error(MassFemaleMg), n() ) ## Female body condition t.test(ResidualIndexFem ~ TreatmentFem, data = mergedSoWiNA) # t = -7.18, d.f. = 111.48, p < 0.001 # WF: 12.46 +- 2.47, n = 58; LF: -11.17 +- 2.17, n = 57 # Well-fed females are in higher body condition than low-fed females. sumResIndSoWi <- mergedSoWiNA %>% group_by(TreatmentFem) %>% summarise( mean = mean(ResidualIndexFem, na.rm = TRUE), s.e. = std.error(ResidualIndexFem), n() ) # Size differences depending on season summer <- mergedSoWiNA[mergedSoWiNA$Season == "SoSe",] t.test(SizeFemale ~ TreatmentFem, data = summer) # t = -0.72, d.f. = 77.49, p = 0.47 # WF: 3.52 +- 0.04, n = 41; LF: 3.48 +- 0.04, n = 39 # In Summer/spring, there is no size difference between WF and LF females. sumSizeSo <- summer %>% group_by(TreatmentFem) %>% summarise( mean = mean(SizeFemale, na.rm = TRUE), s.e. = std.error(SizeFemale), n() ) winter <- mergedSoWiNA[mergedSoWiNA$Season == "WiSe",] t.test(SizeFemale ~ TreatmentFem, data = winter) # t = -4.36, d.f. = 30.97, p < 0.001 # WF: 3.74 +- 0.05, n = 17; LF: 3.46 +- 0.04, n = 18 # In winter/autumn, well-fed females are in higher body condition than low-fed females. sumSizeWi <- winter %>% group_by(TreatmentFem) %>% summarise( mean = mean(SizeFemale, na.rm = TRUE), s.e. = std.error(SizeFemale), n() ) ## Female body size t.test(SizeFemale ~ TreatmentFem, data = mergedSoWiNA) # t = -2.42, d.f. = 106.90, p = 0.02 # WF: 3.59 +- 0.04 mm, n = 58; LF: 3.48 +- 0.03 mm, n = 57 # WF females are bigger than LF females. sumSizeSoWi <- mergedSoWiNA %>% group_by(TreatmentFem) %>% summarise( mean = mean(SizeFemale), s.e. = std.error(SizeFemale), n() ) ### Descriptive statistics ### ## Number of animals count(mergedSoWiNA, IdFemale) # n = 101; SoSe = 72, WiSe = 29 count(mergedSoWiNA, IdMale) # n = 52; SoSe = 31, WiSe = 21 ### Male direction chosen based on female feeding regime count(mergedSoWiNA, TreatmentFem, DirectionSameAsFemale) # WF yes = 25, no = 33 (n = 58) binom.test(25, 58, p=0.5, conf.level=0.95) # binomial test: well-fed: p = 0.36, 43 %, 95 % - CI: 30 % - 57 %, 25 out of 58 # LF yes = 29, no = 28 (n = 57) binom.test(29, 57, p=0.5, conf.level=0.95) # binomial test: low-fed: p = 1.00, 51 %, 95 % - CI: 37 % - 64 %, 29 out of 57 trials ## Graphical depiction # Histograms of variables hist(mergedSoWiNA$MassFemaleMg, breaks = 20, main = "Histogram of female body mass", xlab = "female body mass [mg]") hist(mergedSoWiNA$SizeFemale, breaks = 20, main = "Histogram of female body size", xlab = "female body size [mm]") hist(mergedSoWiNA$ResidualIndexFem, breaks = 20, main = "Histogram of female body condition", xlab = "female body condition") hist(mergedSoWiNA$TrialNumber, main = "Histogram of trial number", xlab = "number of trials") ### Male direction chosen based on female being heavier/larger (>1) or lighter/smaller (<1) than the male ## Body Mass # Sample size fheavierm <- mergedSoWiNA[mergedSoWiNA$MassDifferenceRelativeFM > 1,] mheavierf <- mergedSoWiNA[mergedSoWiNA$MassDifferenceRelativeFM < 1,] count(fheavierm, DirectionSameAsFemale) count(mheavierf, DirectionSameAsFemale) # Results # In 82 out of 115 trials females were heavier than males, opposed to 33 trials with males being heavier. ## Body Size mbiggerf$SizeDifferenceRelativeFM fbiggerm <- mergedSoWiNA[mergedSoWiNA$SizeDifferenceRelativeFM > 1,] mbiggerf <- mergedSoWiNA[mergedSoWiNA$SizeDifferenceRelativeFM < 1,] count(fbiggerm, DirectionSameAsFemale) count(mbiggerf, DirectionSameAsFemale) # Results # In 77 out of 113 trials females were larger than males, opposed to 30 trials with males being heavier. ## Body Condition fhigherCondm <- mergedSoWiNA[mergedSoWiNA$ResidualIndexFem > mergedSoWiNA$ResidualIndexMale, ] mhigherCondf <- mergedSoWiNA[mergedSoWiNA$ResidualIndexFem < mergedSoWiNA$ResidualIndexMale, ] count(fhigherCondm, DirectionSameAsFemale) count(mhigherCondf, DirectionSameAsFemale) # Results # In 51 out of 113 trials females were larger than males, opposed to 62 trials with males being heavier. # WF yes = 25, no = 33 (n = 58) binom.test(25, 58, p=0.5, conf.level=0.95) # binomial test: well-fed: p = 0.36, 43 %, 95 % - CI: 30 % - 57 %, 25 out of 58 # LF yes = 29, no = 28 (n = 57) binom.test(29, 57, p=0.5, conf.level=0.95) # binomial test: low-fed: p = 1.00, 51 %, 95 % - CI: 37 % - 64 %, 29 out of 57 trials ### Getting started with mixed models ### ## Checking for repeated use of animals # Females count(mergedSoWiNA, IdFemale) # 13 out of 101 females were used >1x # Males count(mergedSoWiNA, IdMale) # 43 out of 52 males were used >1x count(mergedSoWiNA, TreatmentFem, IdFemale) # 48 LF (8 used >1x), 53 WF (5 used >1x), 51 Ctrl ## Influence of female body mass # Table 2, model a) modMassSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + MassFemaleMg.cs + TrialNumber.cs + (1|IdMale) + (1|IdFemale), mergedSoWiNA, family="binomial", iter = 4000, adapt_delta = 0.99) ### checking model assumptions # Residuals plot -> fine ggqqplot(resid(modMassSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNA$TrialNumber, resid(modMassSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNA$MassFemaleMg, resid(modMassSoWi), main="Female mass", xlab="Female mass") plot(resid(modMassSoWi) ~ DirectionSameAsFemale, mergedSoWiNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modMassSoWi),resid(modMassSoWi)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modMassSoWi) # time/location correlation |acf assumes row number = time acf(resid(modMassSoWi)) # -> good, 1 peak at lag 17 ## Comparison fitted values vs. data # Goodness of fit graph mergedSoWiNA[,"DirNumber"] <- mergedSoWiNA[,"DirectionSameAsFemale"] mergedSoWiNA[,"DirNumber"] <- as.numeric(mergedSoWiNA[,"DirectionSameAsFemale"]) mergedSoWiNA$DirNumber[mergedSoWiNA$DirectionSameAsFemale=="No"] <- 0 mergedSoWiNA$DirNumber[mergedSoWiNA$DirectionSameAsFemale=="Yes"] <- 1 plot(fitted(modMassSoWi), jitter(mergedSoWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modMassSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimMassSoWi <- as.data.frame(modMassSoWi) nsimMassSoWi <- nrow(bsimMassSoWi) # Calculating beta values apply(bsimMassSoWi, 2, mean)[c(1:3,(length(bsimMassSoWi)-1):length(bsimMassSoWi))] # Calculating credible intervals apply(bsimMassSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassSoWi)-1):length(bsimMassSoWi))] ## Results # Intercept -0.13 (-0.62, 0.33) # Female mass.cs -0.07 (-0.58, 0.39) # Trial number.cs 0.43 (-0.03, 1.07) # Id Female 1.11 (0.00, 7.12) # Id Male 0.16 (0.00, 0.91) # Male direction chosen was not dependent on female body mass. ## Influence of female body size # Table 2, model b) modSizeSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + TrialNumber.cs + SizeFem.cs + (1|IdMale) + (1|IdFemale), mergedSoWiNA, family="binomial", iter = 4000) ### checking model assumptions # residuals plot -> fine ggqqplot(resid(modSizeSoWi, type='deviance')) # residuals vs test variable -> all fine scatter.smooth(mergedSoWiNA$TrialNumber, resid(modSizeSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNA$SizeFemale, resid(modSizeSoWi), main="Female size", xlab="Female size") plot(resid(modSizeSoWi) ~ DirectionSameAsFemale, mergedSoWiNA, main="Direction same as female") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modSizeSoWi),resid(modSizeSoWi)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modSizeSoWi) # time/location correlationlation |acf assumes row number = time acf(resid(modSizeSoWi)) # -> good ## Comparison fitted values vs. data # Goodness of fit graph #par(mfrow=c(1,1)) plot(fitted(modSizeSoWi), jitter(mergedSoWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modSizeSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimSizeSoWi <- as.data.frame(modSizeSoWi) nsimSizeSoWi <- nrow(bsimSizeSoWi) # Calculating beta values apply(bsimSizeSoWi, 2, mean)[c(1:3,(length(bsimSizeSoWi)-1):length(bsimSizeSoWi))] # Calculating credible intervals apply(bsimSizeSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeSoWi)-1):length(bsimSizeSoWi))] ## Results # Intercept -0.14 (-0.62, 0.32) # Trial number.cs 0.42 (-0.03, 1.03) # Female size.cs 0.29 (-0.18, 0.84) # Id Female 1.07 (0.00, 6.74) # Id Male 0.17 (0.00, 0.96) # Male direction chosen was not dependent on female body size ## Influence of female body condition # Table 2, model c) modResIndSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + TrialNumber.cs + ResidualIndexFem.cs + (1|IdMale) + (1|IdFemale), mergedSoWiNA, family="binomial", iter = 4000) ### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modResIndSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNA$TrialNumber, resid(modResIndSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNA$ResidualIndexFem, resid(modResIndSoWi), main="Female condition", xlab="Female condition") plot(resid(modResIndSoWi) ~ DirectionSameAsFemale, mergedSoWiNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modResIndSoWi),resid(modResIndSoWi)); abline(h=0, lty=2) # Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modResIndSoWi) # Time/location correlationlation |acf assumes row number = time #acf(resid(modResIndSoWi)) # -> good ## Comparison fitted values vs. data # Goodness of fit graph plot(fitted(modResIndSoWi), jitter(mergedSoWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modResIndSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### drawing conclusions ### bsimResIndSoWi <- as.data.frame(modResIndSoWi) nsimResIndSoWi <- nrow(bsimResIndSoWi) # Calculating beta values apply(bsimResIndSoWi, 2, mean)[c(1:3,(length(bsimResIndSoWi)-1):length(bsimResIndSoWi))] # Calculating credible intervals apply(bsimResIndSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimResIndSoWi)-1):length(bsimResIndSoWi))] ## Results # Intercept -0.13 (-0.62, 0.32) # Trial number.cs 0.40 (-0.07, 0.99) # Female ResInd.cs -0.15 (-0.64, 0.31) # Id Female 0.96 (0.00, 5.85) # Id Male 0.16 (0.00, 0.93) # Male direction chosen was not dependent on female body condition. ## Influence of relative mass difference between sexes M/F # Table 3, model a) modMassDiffRelFMSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + TrialNumber.cs + MassDifferenceRelativeFM + (1|IdMale) + (1|IdFemale), mergedSoWiNA, family="binomial", iter = 4000) ### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modMassDiffRelFMSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNA$TrialNumber, resid(modMassDiffRelFMSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNA$MassDifferenceRelativeFM, resid(modMassDiffRelFMSoWi), main="Relative mass difference", xlab="relative mass difference") plot(resid(modMassDiffRelFMSoWi) ~ DirectionSameAsFemale, mergedSoWiNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero - is okay scatter.smooth(fitted(modMassDiffRelFMSoWi),resid(modMassDiffRelFMSoWi)); abline(h=0, lty=2) # Check for overdispersion should be close to 1.00 # Residual deviance / residual degrees of freedom #launch_shinystan(modMassDiffRelFMSoWi) # Time/location correlationlation |acf assumes row number = time acf(resid(modMassDiffRelFMSoWi)) # -> good, peak at lag 17 ## Comparison fitted values vs. data # Goodness of fit graph plot(fitted(modMassDiffRelFMSoWi), jitter(mergedSoWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modMassDiffRelFMSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimMassDiffRelFMSoWi <- as.data.frame(modMassDiffRelFMSoWi) nsimMassDiffRelFMSoWi <- nrow(bsimMassDiffRelFMSoWi) # Calculating beta values apply(bsimMassDiffRelFMSoWi, 2, mean)[c(1:3,(length(bsimMassDiffRelFMSoWi)-1):length(bsimMassDiffRelFMSoWi))] # Calculating credible intervals apply(bsimMassDiffRelFMSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassDiffRelFMSoWi)-1):length(bsimMassDiffRelFMSoWi))] ## Results # Intercept -0.47 (-2.26, 1.36) # Trial number.cs 0.44 (-0.01, 1.01) # Rel. mass diff 0.28 (-1.18, 1.72) # Id Male 0.15 (0.00, 0.84) # Id Female 0.91 (0.00, 5.41) # Male direction chosen was not dependent on relative mass differences between the sexes. ## Influence of relative size difference between sexes M/F # Table 3, model b) mergedSoWiNASizeRel <- mergedSoWiNA %>% drop_na(SizeDifferenceRelativeFM, DirectionSameAsFemale) modSizeDiffRelFMSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + SizeDifferenceRelativeFM + TrialNumber.cs + (1|IdFemale)+ (1|IdMale), mergedSoWiNASizeRel, family="binomial", iter = 4000) ### checking model assumptions # Residuals plot -> fine ggqqplot(resid(modSizeDiffRelFMSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNASizeRel$TrialNumber, resid(modSizeDiffRelFMSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNASizeRel$SizeDifferenceRelativeFM, resid(modSizeDiffRelFMSoWi), main="Relative size difference", xlab="relative size difference") plot(resid(modSizeDiffRelFMSoWi) ~ DirectionSameAsFemale, mergedSoWiNASizeRel, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modSizeDiffRelFMSoWi),resid(modSizeDiffRelFMSoWi)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modSizeDiffRelFMSoWi) # time/location correlationlation |acf assumes row number = time acf(resid(modSizeDiffRelFMSoWi)) # -> good ## comparison fitted values vs. data # goodness of fit graph mergedSoWiNASizeRel[,"DirNumber"] <- mergedSoWiNASizeRel[,"DirectionSameAsFemale"] mergedSoWiNASizeRel[,"DirNumber"] <- as.numeric(mergedSoWiNASizeRel[,"DirectionSameAsFemale"]) mergedSoWiNASizeRel$DirNumber[mergedSoWiNASizeRel$DirectionSameAsFemale=="No"] <- 0 mergedSoWiNASizeRel$DirNumber[mergedSoWiNASizeRel$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modSizeDiffRelFMSoWi), jitter(mergedSoWiNASizeRel$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modSizeDiffRelFMSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNASizeRel$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNASizeRel$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimSizeDiffRelFMSoWi <- as.data.frame(modSizeDiffRelFMSoWi) nsimSizeDiffRelFMSoWi <- nrow(bsimSizeDiffRelFMSoWi) apply(bsimSizeDiffRelFMSoWi, 2, mean)[c(1:3,(length(bsimSizeDiffRelFMSoWi)-1):length(bsimSizeDiffRelFMSoWi))] # beta values apply(bsimSizeDiffRelFMSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMSoWi)-1):length(bsimSizeDiffRelFMSoWi))] # credible intervals ## Results n = 113 # Intercept -6.02 (-11.95, -0.88) # Rel. size diff FM 5.48 ( 0.71, 11.04) * # Trial number.cs 0.40 (-0.06, 0.97) # Id Female 0.88 (0.00, 5.66) # Id Male 0.14 (0.00, 0.78) # Male direction chosen was dependent on relative size differences between the sexes. # Males were more likely to follow females that were relatively larger than them. ### Effect plot ### ## Figure 3 - Relative difference in size F/M max(mergedSoWiNASizeRel$SizeDifferenceRelativeFM, na.rm = TRUE) # 1.39 min(mergedSoWiNASizeRel$SizeDifferenceRelativeFM, na.rm = TRUE) # 0.84 newdatDirSizeDiffRelSoWi <- expand.grid(SizeDifferenceRelativeFM=seq(0.8, 1.4, length.out = 3), TrialNumber.cs = 0) XmatDirSizeDiffRelSoWi <- model.matrix(~ 1 + SizeDifferenceRelativeFM + TrialNumber.cs, data=newdatDirSizeDiffRelSoWi) bDirSizeDiffRelSoWi <- as.numeric(apply(bsimSizeDiffRelFMSoWi, 2, mean)[1:ncol(XmatDirSizeDiffRelSoWi)]) newdatDirSizeDiffRelSoWi$fit <- plogis(XmatDirSizeDiffRelSoWi %*% bDirSizeDiffRelSoWi) fitmatDirSizeDiffRelSoWi <- matrix(ncol=nsimSizeDiffRelFMSoWi, nrow=nrow(newdatDirSizeDiffRelSoWi)) for(i in 1:nsimSizeDiffRelFMSoWi) fitmatDirSizeDiffRelSoWi[,i] <- plogis(XmatDirSizeDiffRelSoWi %*% as.numeric(bsimSizeDiffRelFMSoWi[i, 1:ncol(XmatDirSizeDiffRelSoWi)])) newdatDirSizeDiffRelSoWi$lwr <- apply(fitmatDirSizeDiffRelSoWi, 1, quantile, prob=0.025) newdatDirSizeDiffRelSoWi$upr <- apply(fitmatDirSizeDiffRelSoWi, 1, quantile, prob=0.975) plot(newdatDirSizeDiffRelSoWi$SizeDifferenceRelativeFM,newdatDirSizeDiffRelSoWi$fit,type="n", xlab="relative size difference between sexes F/M", ylab="prop. of males following female direction", ylim=c(-0.05, 1.05), xlim=c(0.8, 1.4), las=1, cex.lab=1.3, cex.axis=1.2) grid(lty=1, col=("grey90")) # Add results polygon(c(newdatDirSizeDiffRelSoWi$SizeDifferenceRelativeFM, rev(newdatDirSizeDiffRelSoWi$SizeDifferenceRelativeFM)), c(newdatDirSizeDiffRelSoWi$lwr, rev(newdatDirSizeDiffRelSoWi$upr)), border=NA, col=grey(0.4, alpha = 0.5)) lines(newdatDirSizeDiffRelSoWi$SizeDifferenceRelativeFM,newdatDirSizeDiffRelSoWi$fit,col="black", lty=2) points(mergedSoWiNASizeRel$SizeDifferenceRelativeFM, jitter(as.numeric(mergedSoWiNASizeRel$DirectionSameAsFemale)-1, amount=0.04), col=grey(0.4, alpha = 0.5)) ### Is there directional bias? - Using controls only ## Checking results overall irrespective of day count(mergedCtrlSoWi, DirectionMale) # Left: 36/60, Right: 24/60 binom.test(36, 60, p=0.5, conf.level=0.95) # binomial test: p = 0.16, 60 %, 95 % CI: 46 % - 72 %, 36 out of 60 # Males did not choose one direction more frequently than the other. ## Checking results depending on day count(mergedCtrlSoWi, Date, DirectionMale) # 24.05.2022: Left: 7/8, Right: 1/8 binom.test(7, 8, p=0.5, conf.level=0.95) # binomial test: p = 0.07, 88 %, 95 % CI: 47 % - 100 %, 7 out of 8 # Males chose the left direction more frequently than the other. ################################################# ##### Supplementary Materials ##### ### Effect of Season ### ## Table S8 - Influence of female body mass modMassSeasonSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + MassFemaleMg.cs + TrialNumber.cs + (1|IdMale) + (1|IdFemale) + (1|Season), mergedSoWiNA, family="binomial", iter = 4000, adapt_delta = 0.99) # adapt_delta adjusts target average proposal acceptance probability # during Stan's adaptation period from default 0.95 to 0.99; # leads to smaller step size and fewer divergences ### checking model assumptions # Residuals plot -> fine ggqqplot(resid(modMassSeasonSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNA$TrialNumber, resid(modMassSeasonSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNA$MassFemaleMg, resid(modMassSeasonSoWi), main="Female mass", xlab="Female mass") plot(resid(modMassSeasonSoWi) ~ DirectionSameAsFemale, mergedSoWiNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modMassSeasonSoWi),resid(modMassSeasonSoWi)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modMassSeasonSoWi) # time/location correlationlation |acf assumes row number = time acf(resid(modMassSeasonSoWi)) # -> good, 1 peak at lag 17 ## comparison fitted values vs. data # goodness of fit graph mergedSoWiNA[,"DirNumber"] <- mergedSoWiNA[,"DirectionSameAsFemale"] mergedSoWiNA[,"DirNumber"] <- as.numeric(mergedSoWiNA[,"DirectionSameAsFemale"]) mergedSoWiNA$DirNumber[mergedSoWiNA$DirectionSameAsFemale=="No"] <- 0 mergedSoWiNA$DirNumber[mergedSoWiNA$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modMassSeasonSoWi), jitter(mergedSoWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modMassSeasonSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimMassSeasonSoWi <- as.data.frame(modMassSeasonSoWi) nsimMassSeasonSoWi <- nrow(bsimMassSeasonSoWi) apply(bsimMassSeasonSoWi, 2, mean)[c(1:3,(length(bsimMassSeasonSoWi)-2):length(bsimMassSeasonSoWi))] # beta values apply(bsimMassSeasonSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassSeasonSoWi)-2):length(bsimMassSeasonSoWi))] # credible intervals ## Results # Intercept -0.13 (-1.20, 1.01) # Trial number.cs 0.44 (-0.05, 1.11) # Female mass.cs -0.08 (-0.58, 0.41) # Id Female 1.28 (0.00, 7.99) # Id Male 0.17 (0.00, 1.00) # Season 0.57 (0.00, 4.26) # Male direction chosen was not dependent on female body mass. ### Effects of male body mass, condition and size ## Table S9 A - Male body mass effect modMassMaleSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + TrialNumber.cs + MassMaleMg.cs + (1|IdMale) + (1|IdFemale), mergedSoWiNA, family="binomial", iter = 4000) ### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modMassMaleSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNA$TrialNumber, resid(modMassMaleSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNA$MassMaleMg, resid(modMassMaleSoWi), main="Male mass", xlab="Male mass") plot(resid(modMassMaleSoWi) ~ DirectionSameAsFemale, mergedSoWiNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modMassMaleSoWi),resid(modMassMaleSoWi)); abline(h=0, lty=2) # Check for overdispersion should be close to 1.00 # Residual deviance / residual degrees of freedom #launch_shinystan(modMassMaleSoWi) # Time/location correlationlation |acf assumes row number = time acf(resid(modMassMaleSoWi)) # -> good ## Comparison fitted values vs. data # Goodness of fit graph plot(fitted(modMassMaleSoWi), jitter(mergedSoWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modMassMaleSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimMassMaleSoWi <- as.data.frame(modMassMaleSoWi) nsimMassMaleSoWi <- nrow(bsimMassMaleSoWi) # Calculating beta values apply(bsimMassMaleSoWi, 2, mean)[c(1:3,(length(bsimMassMaleSoWi)-1):length(bsimMassMaleSoWi))] # Calculating credible intervals apply(bsimMassMaleSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassMaleSoWi)-1):length(bsimMassMaleSoWi))] ## Results # Intercept -0.14 (-0.61, 0.31) # Trial number.cs 0.44 (-0.02, 1.04) # Male mass.cs -0.21 (-0.70, 0.24) # Id Female 1.01 (0.00, 6.14) # Id Male 0.15 (0.00, 0.81) # Male direction chosen was not dependent on male body mass. ## Table S9 B - Male body size effect modSizeMaleSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + TrialNumber.cs + SizeMale.cs + (1|IdMale) + (1|IdFemale), mergedSoWiNA, family="binomial", iter = 4000) ### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modSizeMaleSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNA$TrialNumber, resid(modSizeMaleSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNA$SizeMale, resid(modSizeMaleSoWi), main="Male size", xlab="Male size") plot(resid(modSizeMaleSoWi) ~ DirectionSameAsFemale, mergedSoWiNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modSizeMaleSoWi),resid(modSizeMaleSoWi)); abline(h=0, lty=2) # Check for overdispersion should be close to 1.00 # Residual deviance / residual degrees of freedom #launch_shinystan(modSizeMaleSoWi) # Time/location correlationlation |acf assumes row number = time acf(resid(modSizeMaleSoWi)) # -> good ## Comparison fitted values vs. data # Goodness of fit graph plot(fitted(modSizeMaleSoWi), jitter(mergedSoWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modSizeMaleSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimSizeMaleSoWi <- as.data.frame(modSizeMaleSoWi) nsimSizeMaleSoWi <- nrow(bsimSizeMaleSoWi) # Calculating beta values apply(bsimSizeMaleSoWi, 2, mean)[c(1:3,(length(bsimSizeMaleSoWi)-1):length(bsimSizeMaleSoWi))] # Calculating credible intervals apply(bsimSizeMaleSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeMaleSoWi)-1):length(bsimSizeMaleSoWi))] ## Results # Intercept -0.38 (-1.07, 0.21) # Trial number.cs 0.42 (-0.03, 1.03) # Male size.cs 0.27 (-0.16, 0.75) # Id Female 0.98 (0.00, 6.19) # Id Male 0.16 (0.00, 0.89) # Male direction chosen was not dependent on male body size ## Table S9 C - Male body condition effect # drop rows missing male residual indices mergedSoWiNAResIndMaleNA <- mergedSoWiNA %>% drop_na(ResidualIndexMale) modResIndMaleSoWi <- stan_glmer(DirectionSameAsFemale ~ 1 + ResidualIndexMale.cs + TrialNumber.cs + (1|IdMale) + (1|IdFemale), mergedSoWiNAResIndMaleNA, family="binomial", iter = 4000) ### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modResIndMaleSoWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNAResIndMaleNA$TrialNumber, resid(modResIndMaleSoWi), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNAResIndMaleNA$ResidualIndexMale, resid(modResIndMaleSoWi), main="Male condition", xlab="Male condition") plot(resid(modResIndMaleSoWi) ~ DirectionSameAsFemale, mergedSoWiNAResIndMaleNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero - is okay scatter.smooth(fitted(modResIndMaleSoWi),resid(modResIndMaleSoWi)); abline(h=0, lty=2) # Check for overdispersion should be close to 1.00 # Residual deviance / residual degrees of freedom #launch_shinystan(modResIndMaleSoWi) # Time/location correlationlation |acf assumes row number = time acf(resid(modResIndMaleSoWi)) # -> good ## Comparison fitted values vs. data # Goodness of fit graph plot(fitted(modResIndMaleSoWi), jitter(mergedSoWiNAResIndMaleNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modResIndMaleSoWi), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNAResIndMaleNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNAResIndMaleNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimResIndMaleSoWi <- as.data.frame(modResIndMaleSoWi) nsimResIndMaleSoWi <- nrow(bsimResIndMaleSoWi) # Calculating beta values apply(bsimResIndMaleSoWi, 2, mean)[c(1:3,(length(bsimResIndMaleSoWi)-1):length(bsimResIndMaleSoWi))] # Calculating credible intervals apply(bsimResIndMaleSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimResIndMaleSoWi)-1):length(bsimResIndMaleSoWi))] ## Results # Intercept -0.18 (-0.69, 0.29) # Trial number.cs 0.42 (-0.04, 1.09) # Male ResInd.cs -0.03 (-0.54, 0.45) # Id Female 1.30 (0.00, 8.35) # Id Male 0.17 (0.00, 0.95) # Male direction chosen was not dependent on male body condition. ## Influence of relative size difference between sexes F/M according to season # Table S10 A) Spring SizeRelSoNA <- mergedSoWiNASizeRel[mergedSoWiNASizeRel$Season == "SoSe",] modSizeDiffRelFMSo <- stan_glmer(DirectionSameAsFemale ~ 1 + SizeDifferenceRelativeFM + TrialNumber.cs + (1|IdFemale)+ (1|IdMale), SizeRelSoNA, family="binomial", iter = 4000) ### checking model assumptions # Residuals plot -> fine ggqqplot(resid(modSizeDiffRelFMSo, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(SizeRelSoNA$TrialNumber, resid(modSizeDiffRelFMSo), main="Trial number", xlab="Trial number") scatter.smooth(SizeRelSoNA$SizeDifferenceRelativeFM, resid(modSizeDiffRelFMSo), main="Relative size difference", xlab="relative size difference") plot(resid(modSizeDiffRelFMSo) ~ DirectionSameAsFemale, SizeRelSoNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modSizeDiffRelFMSo),resid(modSizeDiffRelFMSo)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modSizeDiffRelFMSo) # time/location correlationlation |acf assumes row number = time acf(resid(modSizeDiffRelFMSo)) # -> good ## comparison fitted values vs. data # goodness of fit graph SizeRelSoNA[,"DirNumber"] <- SizeRelSoNA[,"DirectionSameAsFemale"] SizeRelSoNA[,"DirNumber"] <- as.numeric(SizeRelSoNA[,"DirectionSameAsFemale"]) SizeRelSoNA$DirNumber[SizeRelSoNA$DirectionSameAsFemale=="No"] <- 0 SizeRelSoNA$DirNumber[SizeRelSoNA$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modSizeDiffRelFMSo), jitter(SizeRelSoNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modSizeDiffRelFMSo), seq(0,1, by=0.1)) means <- tapply(SizeRelSoNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(SizeRelSoNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimSizeDiffRelFMSo <- as.data.frame(modSizeDiffRelFMSo) nsimSizeDiffRelFMSo <- nrow(bsimSizeDiffRelFMSo) apply(bsimSizeDiffRelFMSo, 2, mean)[c(1:3,(length(bsimSizeDiffRelFMSo)-1):length(bsimSizeDiffRelFMSo))] # beta values apply(bsimSizeDiffRelFMSo, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMSo)-1):length(bsimSizeDiffRelFMSo))] # credible intervals ## Results Spring n = 78 # Intercept -6.99 (-15.52, -0.53) # Trial number.cs 0.41 (-0.14, 1.12) # Rel. size diff FM 6.40 ( 0.39, 14.33) * # Id Male 0.20 (0.00, 1.19) # Id Female 1.51 (0.00, 9.80) # Male direction chosen was dependent on relative size differences between the sexes. # Males were more likely to follow females that were relatively larger than them. # Figure S10 B) Autumn SizeRelWiNA <- mergedSoWiNASizeRel[mergedSoWiNASizeRel$Season == "WiSe",] modSizeDiffRelFMWi <- stan_glmer(DirectionSameAsFemale ~ 1 + SizeDifferenceRelativeFM + TrialNumber.cs + (1|IdFemale)+ (1|IdMale), SizeRelWiNA, family="binomial", iter = 4000) ### checking model assumptions # Residuals plot -> fine ggqqplot(resid(modSizeDiffRelFMWi, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(SizeRelWiNA$TrialNumber, resid(modSizeDiffRelFMWi), main="Trial number", xlab="Trial number") scatter.smooth(SizeRelWiNA$SizeDifferenceRelativeFM, resid(modSizeDiffRelFMWi), main="Relative size difference", xlab="relative size difference") plot(resid(modSizeDiffRelFMWi) ~ DirectionSameAsFemale, SizeRelWiNA, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modSizeDiffRelFMWi),resid(modSizeDiffRelFMWi)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modSizeDiffRelFMWi) # time/location correlationlation |acf assumes row number = time acf(resid(modSizeDiffRelFMWi)) # -> good ## comparison fitted values vs. data # goodness of fit graph SizeRelWiNA[,"DirNumber"] <- SizeRelWiNA[,"DirectionSameAsFemale"] SizeRelWiNA[,"DirNumber"] <- as.numeric(SizeRelWiNA[,"DirectionSameAsFemale"]) SizeRelWiNA$DirNumber[SizeRelWiNA$DirectionSameAsFemale=="No"] <- 0 SizeRelWiNA$DirNumber[SizeRelWiNA$DirectionSameAsFemale=="Yes"] <- 1 #par(mfrow=c(1,1)) plot(fitted(modSizeDiffRelFMWi), jitter(SizeRelWiNA$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modSizeDiffRelFMWi), seq(0,1, by=0.1)) means <- tapply(SizeRelWiNA$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(SizeRelWiNA$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimSizeDiffRelFMWi <- as.data.frame(modSizeDiffRelFMWi) nsimSizeDiffRelFMWi <- nrow(bsimSizeDiffRelFMWi) apply(bsimSizeDiffRelFMWi, 2, mean)[c(1:3,(length(bsimSizeDiffRelFMWi)-1):length(bsimSizeDiffRelFMWi))] # beta values apply(bsimSizeDiffRelFMWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMWi)-1):length(bsimSizeDiffRelFMWi))] # credible intervals ## Results Autumn n = 35 # Intercept -5.61 (-18.69, 6.35) # Trial number.cs 0.65 (-0.37, 2.31) # Rel. size diff FM 5.05 (-6.01, 17.21) # Id Male 0.97 (0.00, 5.79) # Id Female 2.92 (0.00, 19.06) # Male direction chosen was not dependent on relative size differences between the sexes. # Males were not more likely to follow females that were relatively larger than them. ## Repetition of model simulations excluding results from 24.05.2022 # Table S11 A - Effect of female mass count(mergedSoWiNAExcl, DirectionSameAsFemale) # n = 100 mergedSoWiNAExcl$MassFemaleMgExcl.cs <- (mergedSoWiNAExcl$MassFemaleMg - mean(mergedSoWiNAExcl$MassFemaleMg))/sd(mergedSoWiNAExcl$MassFemaleMg) mergedSoWiNAExcl$TrialNumberExcl.cs <- (mergedSoWiNAExcl$TrialNumber - mean(mergedSoWiNAExcl$TrialNumber))/sd(mergedSoWiNAExcl$TrialNumber) modMassSoWiExcl <- stan_glmer(DirectionSameAsFemale ~ 1 + MassFemaleMgExcl.cs + TrialNumberExcl.cs + (1|IdMale) + (1|IdFemale), mergedSoWiNAExcl, family="binomial", iter = 4000) ### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modMassSoWiExcl, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNAExcl$TrialNumber, resid(modMassSoWiExcl), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNAExcl$MassFemaleMg, resid(modMassSoWiExcl), main="Female mass", xlab="Female mass") plot(resid(modMassSoWiExcl) ~ DirectionSameAsFemale, mergedSoWiNAExcl, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero - is okay scatter.smooth(fitted(modMassSoWiExcl),resid(modMassSoWiExcl)); abline(h=0, lty=2) # Check for overdispersion should be close to 1.00 # Residual deviance / residual degrees of freedom #launch_shinystan(modMassSoWiExcl) # Time/location correlationlation |acf assumes row number = time acf(resid(modMassSoWiExcl)) # -> good ## Comparison fitted values vs. data # Goodness of fit graph mergedSoWiNAExcl[,"DirNumber"] <- mergedSoWiNAExcl[,"DirectionSameAsFemale"] mergedSoWiNAExcl[,"DirNumber"] <- as.numeric(mergedSoWiNAExcl[,"DirectionSameAsFemale"]) mergedSoWiNAExcl$DirNumber[mergedSoWiNAExcl$DirectionSameAsFemale=="No"] <- 0 mergedSoWiNAExcl$DirNumber[mergedSoWiNAExcl$DirectionSameAsFemale=="Yes"] <- 1 plot(fitted(modMassSoWiExcl), jitter(mergedSoWiNAExcl$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modMassSoWiExcl), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNAExcl$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNAExcl$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimMassSoWiExcl <- as.data.frame(modMassSoWiExcl) nsimMassSoWiExcl <- nrow(bsimMassSoWiExcl) # Calculating beta values apply(bsimMassSoWiExcl, 2, mean)[c(1:3,(length(bsimMassSoWiExcl)-1):length(bsimMassSoWiExcl))] # Calculating credible intervals apply(bsimMassSoWiExcl, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassSoWiExcl)-1):length(bsimMassSoWiExcl))] ## Results # Intercept -0.18 (-0.70, 0.31) # Female mass Excl.cs 0.11 (-0.37, 0.64) # Trial number Excl.cs 0.31 (-0.15, 0.90) # Id Male 0.16 (0.00, 0.93) # Id Female 0.88 (0.00, 5.59) # Male direction chosen was not dependent on female body mass. # Table S12 B - Relative size difference (Excluded date) mergedSoWiNASizeRelExcl <- mergedSoWiNAExcl %>% drop_na(SizeDifferenceRelativeFM) #count(mergedSoWiNASizeRelExcl,DirectionSameAsFemale) #n = 98 mergedSoWiNASizeRelExcl$TrialNumberExcl.cs <- (mergedSoWiNASizeRelExcl$TrialNumberExcl - mean(mergedSoWiNASizeRelExcl$TrialNumberExcl))/sd(mergedSoWiNASizeRelExcl$TrialNumberExcl) modSizeDiffRelFMSoWiExcl <- stan_glmer(DirectionSameAsFemale ~ 1 + TrialNumberExcl.cs + SizeDifferenceRelativeFM + (1|IdMale)+ (1|IdFemale), mergedSoWiNASizeRelExcl, family="binomial", iter = 4000) ### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modSizeDiffRelFMSoWiExcl, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(mergedSoWiNASizeRelExcl$TrialNumber, resid(modSizeDiffRelFMSoWiExcl), main="Trial number", xlab="Trial number") scatter.smooth(mergedSoWiNASizeRelExcl$SizeDifferenceRelativeFM, resid(modSizeDiffRelFMSoWiExcl), main="Relative size difference", xlab="relative size difference") plot(resid(modSizeDiffRelFMSoWiExcl) ~ DirectionSameAsFemale, mergedSoWiNASizeRelExcl, main="Direction same as female") # Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero - is okay scatter.smooth(fitted(modSizeDiffRelFMSoWiExcl),resid(modSizeDiffRelFMSoWiExcl)); abline(h=0, lty=2) # Check for overdispersion should be close to 1.00 # Residual deviance / residual degrees of freedom #launch_shinystan(modSizeDiffRelFMSoWiExcl) # Time/location correlationlation |acf assumes row number = time acf(resid(modSizeDiffRelFMSoWiExcl)) # -> good ## Comparison fitted values vs. data # Goodness of fit graph mergedSoWiNASizeRelExcl[,"DirNumber"] <- mergedSoWiNASizeRelExcl[,"DirectionSameAsFemale"] mergedSoWiNASizeRelExcl[,"DirNumber"] <- as.numeric(mergedSoWiNASizeRelExcl[,"DirectionSameAsFemale"]) mergedSoWiNASizeRelExcl$DirNumber[mergedSoWiNASizeRelExcl$DirectionSameAsFemale=="No"] <- 0 mergedSoWiNASizeRelExcl$DirNumber[mergedSoWiNASizeRelExcl$DirectionSameAsFemale=="Yes"] <- 1 plot(fitted(modSizeDiffRelFMSoWiExcl), jitter(mergedSoWiNASizeRelExcl$DirNumber, amount=0.05), xlab="Fitted values", ylab="Probability of same direction", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modSizeDiffRelFMSoWiExcl), seq(0,1, by=0.1)) means <- tapply(mergedSoWiNASizeRelExcl$DirNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(mergedSoWiNASizeRelExcl$DirNumber, t.breaks, semean) points(seq(0.05, 0.95, by=0.1), means, pch=16, col="orange") segments(seq(0.05, 0.95, by=0.1), means-2*means.se, seq(0.05, 0.95, by=0.1), means+2*means.se, lwd=2, col="orange") ### Drawing conclusions ### bsimSizeDiffRelFMSoWiExcl <- as.data.frame(modSizeDiffRelFMSoWiExcl) nsimSizeDiffRelFMSoWiExcl <- nrow(bsimSizeDiffRelFMSoWiExcl) # Calculating beta values apply(bsimSizeDiffRelFMSoWiExcl, 2, mean)[c(1:3,(length(bsimSizeDiffRelFMSoWiExcl)-1):length(bsimSizeDiffRelFMSoWiExcl))] # Calculating credible intervals apply(bsimSizeDiffRelFMSoWiExcl, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMSoWiExcl)-1):length(bsimSizeDiffRelFMSoWiExcl))] ## Results n = 98 # Intercept -6.50 (-12.88, -1.14) # Trial number Excl.cs 0.21 (-0.27, 0.74) # Rel. size diff FM Excl 5.90 ( 0.88, 11.88) * # Id Male 0.16 (0.00, 0.88) # Id Female 0.71 (0.00, 4.52) # Male direction chosen was dependent on relative size differences between the sexes. # Males were more likely to follow females that were relatively larger than them. ## Calculation of mean and median relative size difference median(mergedSoWiNA$SizeDifferenceRelativeFM, na.rm = TRUE) mean(mergedSoWiNA$SizeDifferenceRelativeFM, na.rm = TRUE)