Do female spiders embed silk trails with information on their movement direction and phenotype, and do males follow trails accordingly?
Michelle Beyer, Kardelen Özgün Uludag, Maylis Lailler, Jonas O. Wolff, Monika J. B. Eberhard, Tomer J. Czaczkes, Cristina Tuni
2023
Loading required libraries
library(car)
library(ggplot2)
library(ggpubr)
library(plotrix)
library(plyr)
library(rstanarm)
library(tidyverse)Defining data sets
set.seed(1)
#### Study 1 - Directional silk trail-following ####
setwd("C:/Users/Beyer/Desktop/PhD/Projects/Project 1 - Directionality/Text/Submission")
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")]
### Creation of subset-dataset excluding biased day May 18th 2021
dfSilkOnlyExclude <- dfSilkOnly[dfSilkOnly$Date != "18.05.2021",]
dfSilkOnlyExclude <- dfSilkOnlyExclude %>%
droplevels()
# New file for creation of variable "DirectionAlwaysSame" for every male
dfCsmall <- read.csv2("ESM-Controls.csv")
dfCsmall <- dfCsmall%>%
drop_na()
## Data for silk measurements
data2 <- read.csv2("ESM-diameter.csv")
data2 <- data2[,c("IdFem", "Treatment", "DiameterLine1")]
data2[,"Treatment"] <- as.factor(data2[,"Treatment"])
data2$Treatment <- factor(data2$Treatment,
levels = c("unwashed", "pentane", "water"))
### Study 2 - Effects of female phenotype on male directional trail following ###
## Data from spring/summer 2022
dataMDss <- read.csv2("ESM-MassdependentDirectionality.csv")
## Data from autumn/winter 2022/2023
dataMDws <- read.csv2("ESM-MassdependentDirectionality23.csv")
# Add column with male treatment for comparability
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",]
# 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 + 500Study 1 - Directional silk trail-following
Checking for between-individual day-based directional bias
Here, we investigate whether there is a day-based directional bias present between individuals.
# count(dfControls, Date, DirectionFinalMale)
binom.test(10, 12, p = 0.5, conf.level = 0.95)
# Results
# Binomial test (18May2021): p = 0.04, 83 %, 95 % CI, 52 %-98%, 2 out of 12.
# 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.00There is a significant bias of males to choose the right (R) opposed to left direction for 18th May 2021. Consequently, later model simulations were repeated with data excluding this biased day.
Fitting the model for Table 1 - Effects of Treatment and Testing order on male directional decision making with spider IDs as random effects
In this section, we investigate directional trail-following, i.e. whether male spiders follow female unidirectional deposited trails in the direction they were deposited. We also investigate the influence of treatment on directional trail-following, by washing trails with a solvent to remove putative chemicals.
# Grand-mean-center and standardize (using the standard deviation) variables for biologically meaningful estimates
dfSilkOnly <- dfSilkOnly %>%
droplevels()
dfSilkOnly$Test.cs <- (dfSilkOnly$Test-mean(dfSilkOnly$Test))/sd(dfSilkOnly$Test)
# Model simulation using a GLMM (binomial)
modBase <- stan_glmer(DirectionSameAsFemale ~ 1 + Treatment + Test.cs +
(1|IdMale) + (1|IdFem), dfSilkOnly, family="binomial", iter = 4000)Checking model assumptions
# Residuals plot
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 correlation |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
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")
After verifying that the model assumptions are fulfilled, we can now continue with the model results.
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))] ## (Intercept) TreatmentWashed
## 0.5498638 -1.2186842
## Test.cs Sigma[IdMale:(Intercept),(Intercept)]
## 0.1033057 0.4412855
## Sigma[IdFem:(Intercept),(Intercept)]
## 0.2843765# Calculating credible intervals
apply(bsimBase, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimBase)-1):length(bsimBase))] ## (Intercept) TreatmentWashed Test.cs
## 2.5% -0.304030 -2.3787137 -0.4773470
## 97.5% 1.439431 -0.1094522 0.6881927
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0002412982
## 97.5% 2.4896562271
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0002203696
## 97.5% 1.7057423394## 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)The results show that males are less likely to follow female trails in the direction they were deposited when the trails were washed compared to unwashed. Trial number had no significant effect on the response variable.
Visualiziation of raw data - Figure 2
Having seen the results of model a, we now want to show this visually:
# 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 treatments
Here, we investigate, whether there is directionality present within each treatment, i.e. whether males choose the same direction as the female that laid the trail more often than the opposite.
## Binomial test for investigating directionality
# count(dfSilkOnly, Treatment, DirectionSameAsFemale)
# Unwashed total: 31, Yes: 19, No: 12
# Washed total: 31, Yes: 11, No: 20
## Unwashed treatment ##
binom.test(19, 31, p = 0.5, conf.level = 0.95)##
## Exact binomial test
##
## data: 19 and 31
## number of successes = 19, number of trials = 31, p-value = 0.281
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.4218696 0.7815004
## sample estimates:
## probability of success
## 0.6129032# 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.
## Washed treatment ##
binom.test(11, 31, p = 0.5, conf.level = 0.95)##
## Exact binomial test
##
## data: 11 and 31
## number of successes = 11, number of trials = 31, p-value = 0.1496
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.1922674 0.5463044
## sample estimates:
## probability of success
## 0.3548387# 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.Within each treatment, males did not choose the same direction as the female significantly more often than the opposite.
Within and between individual directional bias
We checked, whether individual males preferentially chose always the same vs. varying directions in the experiment.
## 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)##
## Exact binomial test
##
## data: 12 and 31
## number of successes = 12, number of trials = 31, p-value = 0.281
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.2184996 0.5781304
## sample estimates:
## probability of success
## 0.3870968# Results
# Binomial test: p = 0.28, 39 %, 95 % CI: 22 % - 58 %, 12 out of 31.
## Between individual directional bias over all days
count(dfControls, DirectionFinalMale) # Left = 42, Right = 50## DirectionFinalMale n
## 1 L 42
## 2 R 50binom.test(42,92, p=0.5, conf.level=0.95)##
## Exact binomial test
##
## data: 42 and 92
## number of successes = 42, number of trials = 92, p-value = 0.4657
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.3522326 0.5636876
## sample estimates:
## probability of success
## 0.4565217# Results
# Binomial test: p = 0.47, 46 %, 95 % CI: 35 % - 56 %, 42 out of 92Males in repeated control (no-trail) treatments did not show directional bias over the course of the experiment: individual males did not preferentially choose the same direction opposed to varying directions during their three no-trail trials (within individual bias) and all males did not choose a specific direction (right or left) in the testing device when exposed to female trails (between individual bias).
Supplementary Material for Study 1
1) Silk ultrastructure investigation after washing treatment
We investigated structural changes in silk lines upon washing them with solvents (n-pentane, deionized water). After drying, the silk was prepared for scanning electron microscopy by mounting it on aluminum stubs. Samples were sputter-coated with gold for 5 min without further fixation and examined at 1400 and 4000 magnification in an EVO LS10 scanning electron microscope.
# 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)## Df Sum Sq Mean Sq F value Pr(>F)
## Treatment 2 0.891 0.4456 1.251 0.313
## Residuals 16 5.700 0.3563# 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)## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 2 2.8205 0.08927 .
## 16
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Normality
plot(anova,2)
## Post-hoc comparisons
TukeyHSD(anova)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = DiameterLine1 ~ Treatment, data = data2)
##
## $Treatment
## diff lwr upr p adj
## pentane-unwashed 0.5095833 -0.3221733 1.3413399 0.2820983
## water-unwashed 0.2753333 -0.6572520 1.2079187 0.7310108
## water-pentane -0.2342500 -1.1122501 0.6437501 0.7734883# 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"))
Silk line diameters did not vary significantly between treatments.
2) Effects of directional bias on single experiment day
Due to a directional bias on one of the experiment days, we repeated the model simulation from study 1 excluding data from this specific day.
# Center and standardize numeric variables for meaningful estimates
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 correlation |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
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")
After verifying that the model assumptions are fulfilled, we can now continue with the model results.
Drawing conclusions
# count(dfSilkOnlyExclude, DirectionSameAsFemale)
# Yes = 28, No = 26, total = 54
bsimBaseExcl <- as.data.frame(modBaseExcl)
nsimBaseExcl <- nrow(bsimBaseExcl)
# Calculating beta values
apply(bsimBaseExcl, 2, mean)[c(1:3,(length(bsimBaseExcl)-1):length(bsimBaseExcl))] ## (Intercept) TreatmentWashed
## 0.8302889 -1.4318100
## Test.cs Sigma[IdMale:(Intercept),(Intercept)]
## 0.0244987 0.4601722
## Sigma[IdFem:(Intercept),(Intercept)]
## 0.3169522# Calculating credible intervals
apply(bsimBaseExcl, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimBaseExcl)-1):length(bsimBaseExcl))]## (Intercept) TreatmentWashed Test.cs
## 2.5% -0.08680144 -2.7054110 -0.6061186
## 97.5% 1.83493484 -0.1925083 0.6588881
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0002625706
## 97.5% 2.5905212796
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0001602388
## 97.5% 1.8641077099## Results for Table S2, 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)After excluding the biased day from the dataset, results were retained.
3) Exploratory models testing for the effect of male behaviours during trial
We investigated the additional influence on male directional decision making by adding total time spent in the device and occurrence of turns, defined as a 180° directional change, to our exploratory model.
### 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)##
## Exact binomial test
##
## data: 11 and 31
## number of successes = 11, number of trials = 31, p-value = 0.1496
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.1922674 0.5463044
## sample estimates:
## probability of success
## 0.3548387# Binomial 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)##
## Exact binomial test
##
## data: 4 and 31
## number of successes = 4, number of trials = 31, p-value = 3.395e-05
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.03630166 0.29833583
## sample estimates:
## probability of success
## 0.1290323# Binomial test: p < 0.001, 12 %, 95 % CI: 3 %-30 %, 4 out of 31.
sumT <- dfSilkOnly %>%
group_by(Treatment, DirectionSameAsFemale, Turned)%>%
summarise(
n = n()
)## `summarise()` has grouped output by 'Treatment', 'DirectionSameAsFemale'. You
## can override using the `.groups` argument.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"))
In the unwashed treatment, male probability to turn was not significantly different from chance. In contrast, in the washed treatment males turned less than would be expected by chance.
Fitting exploratory models for Table S3
# Grand-mean-center and standardize variables for biologically meaningful estimates
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 correlation |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
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))] ## (Intercept) TreatmentWashed
## 0.54120424 -1.26111384
## Test.cs TimeInArena.cs
## 0.08397482 -0.07992222
## TurnedYes Sigma[IdMale:(Intercept),(Intercept)]
## 0.12209337 0.50520694
## Sigma[IdFem:(Intercept),(Intercept)]
## 0.33547191# Calculating credible intervals
apply(bsimDirSuppTableS3, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS3)-1):length(bsimDirSuppTableS3))] ## (Intercept) TreatmentWashed Test.cs TimeInArena.cs TurnedYes
## 2.5% -0.483740 -2.55129375 -0.5381114 -0.8074596 -1.522693
## 97.5% 1.657857 -0.08331908 0.7137584 0.6375484 1.819210
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0003095045
## 97.5% 2.7232221084
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0001754014
## 97.5% 1.8514378641## 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)Neither the time spent in the testing device nor the occurrence of additional turns affected male likelihood of following female silk lines in the same direction as deposited. The treatment effect was retained.
Exploratory models testing for the effect of individual phenotypic traits
Effects of female body mass, size and condition
We investigated the influence of female body mass, body condition (measured as a residual index), and size, measured as prosoma width, on the probability of males to follow trails in the direction they were deposited by the female by fitting three models, each with one female trait, including treatment (washed and unwashed trails) and testing order (to account for increasing male experience with the testing device) as fixed effects. Spider identities of each sex were added as random effects to account for repeated measurements (i.e. to avoid pseudo-replication).
Table S4 A) Female body mass
# Grand-mean-center and standardize variables for biologically meaningful estimates
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 correlation |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
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))] ## (Intercept) TreatmentWashed
## 0.78979077 -1.51087064
## Test.cs MassFemMg.cs
## 0.02935019 1.60584381
## TreatmentWashed:MassFemMg.cs Sigma[IdMale:(Intercept),(Intercept)]
## -1.85440173 0.65205816
## Sigma[IdFem:(Intercept),(Intercept)]
## 0.38033996# Calculating credible intervals
apply(bsimDirSuppTableS4A, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS4A)-1):length(bsimDirSuppTableS4A))]## (Intercept) TreatmentWashed Test.cs MassFemMg.cs
## 2.5% -0.1996986 -2.8858226 -0.6174006 0.4088169
## 97.5% 1.9080816 -0.2813413 0.6693838 3.1020807
## TreatmentWashed:MassFemMg.cs Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% -3.4890244 0.000324532
## 97.5% -0.4168863 3.688216892
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0003061659
## 97.5% 2.1771788811## 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)Males were more likely to follow trails in the same direction as the female laid them when the female had higher body mass. The significant effect of the washing treatment was retained, yet the effect of female body mass was significantly smaller in the washed than the unwashed treatment.
Table S4 B) Female body condition
# Grand-mean-center and standardize variables for biologically meaningful estimates
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 correlation |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
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))] ## (Intercept) TreatmentWashed
## 0.99557105 -1.92844777
## Test.cs ResIndFem.cs
## 0.07711694 1.54260846
## TreatmentWashed:ResIndFem.cs Sigma[IdMale:(Intercept),(Intercept)]
## -1.50566605 0.92933470
## Sigma[IdFem:(Intercept),(Intercept)]
## 0.47359194# Calculating credible intervals
apply(bsimDirSuppTableS4B, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS4B)-1):length(bsimDirSuppTableS4B))]## (Intercept) TreatmentWashed Test.cs ResIndFem.cs
## 2.5% -0.1620538 -3.6631559 -0.7050744 0.3260406
## 97.5% 2.3296926 -0.4627417 0.8650709 2.9625529
## TreatmentWashed:ResIndFem.cs Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% -3.12028652 0.0004368409
## 97.5% -0.04042468 5.0956550193
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0002600265
## 97.5% 2.8456649371## 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)The effect of the residual index differed significantly between treatments, and the treatment effect was retained.
Table S4 C) Female body size
# Grand-mean-center and standardize variables for biologically meaningful estimates
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 correlation |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
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))] ## (Intercept) TreatmentWashed
## 0.9165431 -1.9929666
## Test.cs SizeFem.cs
## 0.3819928 0.5756945
## TreatmentWashed:SizeFem.cs Sigma[IdMale:(Intercept),(Intercept)]
## -1.4651184 1.7061841
## Sigma[IdFem:(Intercept),(Intercept)]
## 0.7682957# Calculating credible intervals
apply(bsimDirSuppTableS4C, 2, quantile, prob=c(0.025, 0.975))[,c(1:5,(length(bsimDirSuppTableS4C)-1):length(bsimDirSuppTableS4C))]## (Intercept) TreatmentWashed Test.cs SizeFem.cs
## 2.5% -0.1989498 -3.8926491 -0.3867879 -0.5642744
## 97.5% 2.3633761 -0.4992051 1.2425176 1.9032576
## TreatmentWashed:SizeFem.cs Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% -3.29291457 0.001583249
## 97.5% 0.05138733 8.821073266
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0003298062
## 97.5% 4.6877785191## 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)Male probability to directionally follow female trails was not significantly affected by female body size. The treatment effect was retained.
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 + MassFemMg.cs + Treatment:MassFemMg.cs, data=newdatDir3)
bDir3 <- as.numeric(apply(bsimDirSuppTableS4A, 2, mean)[1:ncol(XmatDir3)])
newdatDir3$fit <- plogis(XmatDir3 %*% bDir3)
fitmatDir3 <- matrix(ncol=nsimDirSuppTableS4A, nrow=nrow(newdatDir3))
for(i in 1:nsimDirSuppTableS4A) fitmatDir3[,i] <- plogis(XmatDir3 %*% as.numeric(bsimDirSuppTableS4A[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"))
# 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
Due to the sigmoidal appearance of the relationship between female body mass and the probability of males to follow a female, data (body mass and corresponding direction chosen) was separated into three thirds, comprised of females with lowest, medium and highest body mass, and a binomial test was applied to each quartile.
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)##
## Exact binomial test
##
## data: 19 and 31
## number of successes = 19, number of trials = 31, p-value = 0.281
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.4218696 0.7815004
## sample estimates:
## probability of success
## 0.6129032# Lightest third (110.64 +- 2.70 mg)
binom.test(5,11, p=0.5, conf.level=0.95) # p = 1##
## Exact binomial test
##
## data: 5 and 11
## number of successes = 5, number of trials = 11, p-value = 1
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.1674881 0.7662064
## sample estimates:
## probability of success
## 0.4545455# 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##
## Exact binomial test
##
## data: 5 and 10
## number of successes = 5, number of trials = 10, p-value = 1
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.187086 0.812914
## sample estimates:
## probability of success
## 0.5# p = 1, 50 %, 95 % CI: 19 % - 81 %, 5 out of 10
# Heaviest third (140.20 +- 3.79 mg)
binom.test(9,10, p=0.5, conf.level=0.95) # p = 0.02##
## Exact binomial test
##
## data: 9 and 10
## number of successes = 9, number of trials = 10, p-value = 0.02148
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.5549839 0.9974714
## sample estimates:
## probability of success
## 0.9# p = 0.02, 90 %, 95 % CI: 55 % - 100 %In the highest-mass quartile, males followed in female direction in 9 out of 10 trials. In contrast, males did not follow females of low or medium body mass.
Effects of male body mass, size and condition
We investigated the influence of male phenotype (body mass, size, condition) on the probability of males to follow trails in the direction they were deposited.
Table S5 A) male body mass
# Grand-mean-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))]## (Intercept) TreatmentWashed
## 0.5746877 -1.2595093
## Test.cs MassMaleMg.cs
## 0.1056709 -0.1136280
## Sigma[IdMale:(Intercept),(Intercept)] Sigma[IdFem:(Intercept),(Intercept)]
## 0.5001313 0.3216373# Calculating credible intervals
apply(bsimDirSuppTableS5A, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS5A)-1):length(bsimDirSuppTableS5A))] ## (Intercept) TreatmentWashed Test.cs MassMaleMg.cs
## 2.5% -0.2829868 -2.4327471 -0.4797951 -0.7686923
## 97.5% 1.5184592 -0.1639745 0.6853007 0.5428377
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.00035749
## 97.5% 2.72018819
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0001639616
## 97.5% 1.8528383964# 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)Male body mass did not significantly influence male likelihood to follow trails in female direction. The treatment effect was retained.
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))]## (Intercept) TreatmentWashed
## 0.80750350 -1.55040293
## Test.cs ResIndMale.cs
## 0.06346585 0.21905790
## Sigma[IdMale:(Intercept),(Intercept)] Sigma[IdFem:(Intercept),(Intercept)]
## 0.48168769 0.55924401# Calculating credible intervals
apply(bsimDirSuppTableS5B, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS5B)-1):length(bsimDirSuppTableS5B))] ## (Intercept) TreatmentWashed Test.cs ResIndMale.cs
## 2.5% -0.1404426 -2.9399666 -0.6129143 -0.5296974
## 97.5% 1.9222680 -0.2765389 0.7464250 1.0171875
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0002786424
## 97.5% 2.5948814448
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0003910535
## 97.5% 3.0738167876# 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)Male body condition did not significantly influence male likelihood to follow trails in female direction. The treatment effect was retained.
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))]## (Intercept) TreatmentWashed
## 0.81547318 -1.57336896
## Test.cs SizeMale.cs
## 0.08102323 -0.46687058
## Sigma[IdMale:(Intercept),(Intercept)] Sigma[IdFem:(Intercept),(Intercept)]
## 0.46262828 0.54094070# Calculating credible intervals
apply(bsimDirSuppTableS5C, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS5C)-1):length(bsimDirSuppTableS5C))] ## (Intercept) TreatmentWashed Test.cs SizeMale.cs
## 2.5% -0.1425371 -2.9347571 -0.5920840 -1.303214
## 97.5% 1.9012444 -0.2893755 0.7497349 0.275686
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0002048016
## 97.5% 2.6154837492
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0002090159
## 97.5% 3.1147728589# 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)Male body size did not significantly influence male likelihood to follow trails in female direction. The treatment effect was retained.
Effects of relative difference in female and male body mass and size - complete data and unwashed data only
We investigated the influence of the relative difference in female and male body mass and size male phenotype (body mass, size) on the probability of males to follow trails in the direction they were deposited by the female.
Complete dataset
Table S6 A) relative difference in body mass
# Fitting the model GLMM (binomial)
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))] ## (Intercept) TreatmentWashed
## -0.85602571 -1.25637813
## Test.cs MassRelativeDifferenceFM
## 0.09212199 0.99442588
## Sigma[IdMale:(Intercept),(Intercept)] Sigma[IdFem:(Intercept),(Intercept)]
## 0.46689854 0.27951676# Calculating credible intervals
apply(bsimDirSuppTableS6A, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS6A)-1):length(bsimDirSuppTableS6A))]## (Intercept) TreatmentWashed Test.cs MassRelativeDifferenceFM
## 2.5% -3.985559 -2.4428733 -0.4955912 -1.031643
## 97.5% 2.217439 -0.1512922 0.6861328 3.113794
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0003230036
## 97.5% 2.5740544215
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0001487303
## 97.5% 1.5916676472# 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)Relative difference in female and male mass did not significantly influence male likelihood to follow trails in female direction. There was a significant difference between treatments.
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))] ## (Intercept) TreatmentWashed
## -4.3496072 -1.7417135
## Test.cs SizeRelativeDifferenceFM
## 0.2624976 5.1884790
## Sigma[IdMale:(Intercept),(Intercept)] Sigma[IdFem:(Intercept),(Intercept)]
## 0.6234980 0.8676401# Calculating credible intervals
apply(bsimDirSuppTableS6B, 2, quantile, prob=c(0.025, 0.975))[,c(1:4,(length(bsimDirSuppTableS6B)-1):length(bsimDirSuppTableS6B))]## (Intercept) TreatmentWashed Test.cs SizeRelativeDifferenceFM
## 2.5% -17.531530 -3.3728863 -0.5128638 -5.992811
## 97.5% 7.066675 -0.2382916 1.0883081 18.269714
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0003312177
## 97.5% 3.7122326812
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.0003925597
## 97.5% 4.9035831176# 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)Relative difference in female and male size did not significantly influence male likelihood to follow trails in female direction. There was a significant difference between treatments.
Unwashed data only
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))] ## (Intercept) Test.cs
## 1.2648635 0.5466497
## MassRelativeDifferenceFM Sigma[IdMale:(Intercept),(Intercept)]
## -0.2813540 7.4969315
## Sigma[IdFem:(Intercept),(Intercept)]
## 1.8457823# Calculating credible intervals
apply(bsimDirSuppTableS6Aunw, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimDirSuppTableS6Aunw)-1):length(bsimDirSuppTableS6Aunw))]## (Intercept) Test.cs MassRelativeDifferenceFM
## 2.5% -5.564888 -0.8518093 -5.157394
## 97.5% 8.698325 2.2833110 4.481465
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.003364275
## 97.5% 40.221803264
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 5.652094e-04
## 97.5% 1.145707e+01# 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)In the unwashed treatment, relative difference in female and male mass did not significantly influence male likelihood to follow trails in female direction.
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))] ## (Intercept) Test.cs
## -9.061839 1.452924
## SizeRelativeDifferenceFM Sigma[IdMale:(Intercept),(Intercept)]
## 9.993684 3.840405
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.655243# Calculating credible intervals
apply(bsimDirSuppTableS6Bunw, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimDirSuppTableS6Bunw)-1):length(bsimDirSuppTableS6Bunw))]## (Intercept) Test.cs SizeRelativeDifferenceFM
## 2.5% -34.95352 -0.1742502 -11.40797
## 97.5% 12.84132 3.5069742 35.43163
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.001827516
## 97.5% 22.938427876
## Sigma[IdFem:(Intercept),(Intercept)]
## 2.5% 0.001234843
## 97.5% 15.565386334# Results, n = 21
# Intercept -9.36 (-36.04, 12.78)
# Test.cs 1.47 (-0.11, 3.54)
# RelDiff Size 10.30 (-11.21, 36.88)
# Id Male 3.86 (0.00, 22.89)
# Id Female 2.69 (0.00, 15.79)In the unwashed treatment, relative difference in female and male size did not significantly influence male likelihood to follow trails in female direction.
Study 2 - Effects of female phenotype on male directional trail following
Results from study 1 indicated that males may preferentially follow heavier females. We thus conducted a manipulative study, in which we systematically varied female phenotype by applying different feeding regimes, in order to experimentally confirm observation of males following heavier females found in study 1.
Statistical analysis
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)##
## Welch Two Sample t-test
##
## data: MassFemaleMg by TreatmentFem
## t = -8.1979, df = 112.76, p-value = 4.321e-13
## alternative hypothesis: true difference in means between group LF and group WF is not equal to 0
## 95 percent confidence interval:
## -37.51164 -22.90941
## sample estimates:
## mean in group LF mean in group WF
## 85.78947 116.00000# 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
sumMassSoWi <- mergedSoWiNA %>%
group_by(TreatmentFem) %>%
summarise(
mean = mean(MassFemaleMg),
s.e. = std.error(MassFemaleMg),
n()
)Well-fed females were heavier than low-fed females.
## Female body condition
t.test(ResidualIndexFem ~ TreatmentFem, data = mergedSoWiNA)##
## Welch Two Sample t-test
##
## data: ResidualIndexFem by TreatmentFem
## t = -7.1836, df = 111.48, p-value = 8.133e-11
## alternative hypothesis: true difference in means between group LF and group WF is not equal to 0
## 95 percent confidence interval:
## -30.14376 -17.10970
## sample estimates:
## mean in group LF mean in group WF
## -11.17035 12.45638# t = -7.18, d.f. = 111.48, p < 0.001
# WF: 12.46 +- 2.47, n = 58; LF: -11.17 +- 2.17, n = 57
sumResIndSoWi <- mergedSoWiNA %>%
group_by(TreatmentFem) %>%
summarise(
mean = mean(ResidualIndexFem, na.rm = TRUE),
s.e. = std.error(ResidualIndexFem),
n()
)Well-fed females are in higher body condition than low-fed females.
# Size differences depending on season
summer <- mergedSoWiNA[mergedSoWiNA$Season == "SoSe",]
t.test(SizeFemale ~ TreatmentFem, data = summer)##
## Welch Two Sample t-test
##
## data: SizeFemale by TreatmentFem
## t = -0.72183, df = 77.487, p-value = 0.4726
## alternative hypothesis: true difference in means between group LF and group WF is not equal to 0
## 95 percent confidence interval:
## -0.15545730 0.07273059
## sample estimates:
## mean in group LF mean in group WF
## 3.482051 3.523415# t = -0.72, d.f. = 77.49, p = 0.47
# WF: 3.52 +- 0.04, n = 41; LF: 3.48 +- 0.04, n = 39
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)##
## Welch Two Sample t-test
##
## data: SizeFemale by TreatmentFem
## t = -4.3628, df = 30.97, p-value = 0.0001323
## alternative hypothesis: true difference in means between group LF and group WF is not equal to 0
## 95 percent confidence interval:
## -0.4040891 -0.1466299
## sample estimates:
## mean in group LF mean in group WF
## 3.461111 3.736471# 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 larger 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)##
## Welch Two Sample t-test
##
## data: SizeFemale by TreatmentFem
## t = -2.4109, df = 108.67, p-value = 0.01759
## alternative hypothesis: true difference in means between group LF and group WF is not equal to 0
## 95 percent confidence interval:
## -0.20120245 -0.01964449
## sample estimates:
## mean in group LF mean in group WF
## 3.475439 3.585862# 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()
)In summer/spring, there is no size difference between WF and LF females. In autumn/winter, WF females are larger than LF females, leading to overall larger WF females.
Descriptive statistics
## Number of animals
count(mergedSoWiNA, IdFemale) # n = 101; SoSe = 72, WiSe = 29## IdFemale n
## 1 1 1
## 2 3 1
## 3 8 2
## 4 10 2
## 5 11 1
## 6 28 1
## 7 33 1
## 8 35 1
## 9 37 1
## 10 40 1
## 11 50 1
## 12 54 1
## 13 59 3
## 14 61 1
## 15 66 1
## 16 67 1
## 17 69 1
## 18 70 1
## 19 71 1
## 20 75 1
## 21 76 1
## 22 80 1
## 23 81 1
## 24 83 1
## 25 84 1
## 26 86 1
## 27 89 1
## 28 90 1
## 29 93 1
## 30 96 1
## 31 97 2
## 32 101 1
## 33 102 1
## 34 104 1
## 35 107 1
## 36 111 1
## 37 112 1
## 38 115 1
## 39 116 1
## 40 119 1
## 41 123 1
## 42 124 2
## 43 125 2
## 44 127 1
## 45 128 1
## 46 130 1
## 47 131 1
## 48 132 1
## 49 133 1
## 50 134 1
## 51 135 1
## 52 137 2
## 53 138 1
## 54 139 1
## 55 143 1
## 56 144 1
## 57 145 1
## 58 146 1
## 59 147 1
## 60 148 1
## 61 149 1
## 62 152 1
## 63 153 1
## 64 156 1
## 65 157 1
## 66 158 1
## 67 159 1
## 68 160 1
## 69 161 1
## 70 164 1
## 71 174 1
## 72 175 1
## 73 506 2
## 74 517 2
## 75 520 1
## 76 528 1
## 77 535 1
## 78 536 1
## 79 537 1
## 80 538 1
## 81 541 1
## 82 544 1
## 83 547 1
## 84 555 1
## 85 556 1
## 86 569 1
## 87 574 2
## 88 575 1
## 89 578 1
## 90 579 1
## 91 580 2
## 92 586 1
## 93 594 1
## 94 602 2
## 95 603 1
## 96 606 1
## 97 607 1
## 98 617 1
## 99 622 2
## 100 626 1
## 101 636 1count(mergedSoWiNA, IdMale) # n = 52; SoSe = 31, WiSe = 21## IdMale n
## 1 15 2
## 2 16 4
## 3 20 2
## 4 36 2
## 5 46 2
## 6 48 2
## 7 51 2
## 8 52 2
## 9 53 4
## 10 55 4
## 11 58 4
## 12 60 4
## 13 65 4
## 14 72 4
## 15 74 6
## 16 77 2
## 17 85 2
## 18 92 2
## 19 100 2
## 20 105 2
## 21 109 1
## 22 114 2
## 23 122 2
## 24 129 1
## 25 154 4
## 26 155 2
## 27 163 2
## 28 170 2
## 29 171 2
## 30 172 2
## 31 173 2
## 32 505 1
## 33 507 2
## 34 521 2
## 35 522 1
## 36 531 2
## 37 543 2
## 38 548 1
## 39 552 2
## 40 553 2
## 41 565 2
## 42 571 2
## 43 573 2
## 44 581 2
## 45 585 2
## 46 589 1
## 47 593 1
## 48 604 2
## 49 618 1
## 50 620 2
## 51 627 1
## 52 635 2## Checking for repeated use of animals
# Females
count(mergedSoWiNA, IdFemale) ## IdFemale n
## 1 1 1
## 2 3 1
## 3 8 2
## 4 10 2
## 5 11 1
## 6 28 1
## 7 33 1
## 8 35 1
## 9 37 1
## 10 40 1
## 11 50 1
## 12 54 1
## 13 59 3
## 14 61 1
## 15 66 1
## 16 67 1
## 17 69 1
## 18 70 1
## 19 71 1
## 20 75 1
## 21 76 1
## 22 80 1
## 23 81 1
## 24 83 1
## 25 84 1
## 26 86 1
## 27 89 1
## 28 90 1
## 29 93 1
## 30 96 1
## 31 97 2
## 32 101 1
## 33 102 1
## 34 104 1
## 35 107 1
## 36 111 1
## 37 112 1
## 38 115 1
## 39 116 1
## 40 119 1
## 41 123 1
## 42 124 2
## 43 125 2
## 44 127 1
## 45 128 1
## 46 130 1
## 47 131 1
## 48 132 1
## 49 133 1
## 50 134 1
## 51 135 1
## 52 137 2
## 53 138 1
## 54 139 1
## 55 143 1
## 56 144 1
## 57 145 1
## 58 146 1
## 59 147 1
## 60 148 1
## 61 149 1
## 62 152 1
## 63 153 1
## 64 156 1
## 65 157 1
## 66 158 1
## 67 159 1
## 68 160 1
## 69 161 1
## 70 164 1
## 71 174 1
## 72 175 1
## 73 506 2
## 74 517 2
## 75 520 1
## 76 528 1
## 77 535 1
## 78 536 1
## 79 537 1
## 80 538 1
## 81 541 1
## 82 544 1
## 83 547 1
## 84 555 1
## 85 556 1
## 86 569 1
## 87 574 2
## 88 575 1
## 89 578 1
## 90 579 1
## 91 580 2
## 92 586 1
## 93 594 1
## 94 602 2
## 95 603 1
## 96 606 1
## 97 607 1
## 98 617 1
## 99 622 2
## 100 626 1
## 101 636 1# 13 out of 101 females were used >1x
# Males
count(mergedSoWiNA, IdMale) ## IdMale n
## 1 15 2
## 2 16 4
## 3 20 2
## 4 36 2
## 5 46 2
## 6 48 2
## 7 51 2
## 8 52 2
## 9 53 4
## 10 55 4
## 11 58 4
## 12 60 4
## 13 65 4
## 14 72 4
## 15 74 6
## 16 77 2
## 17 85 2
## 18 92 2
## 19 100 2
## 20 105 2
## 21 109 1
## 22 114 2
## 23 122 2
## 24 129 1
## 25 154 4
## 26 155 2
## 27 163 2
## 28 170 2
## 29 171 2
## 30 172 2
## 31 173 2
## 32 505 1
## 33 507 2
## 34 521 2
## 35 522 1
## 36 531 2
## 37 543 2
## 38 548 1
## 39 552 2
## 40 553 2
## 41 565 2
## 42 571 2
## 43 573 2
## 44 581 2
## 45 585 2
## 46 589 1
## 47 593 1
## 48 604 2
## 49 618 1
## 50 620 2
## 51 627 1
## 52 635 2# 43 out of 52 males were used >1x
count(mergedSoWiNA, TreatmentFem, IdFemale) ## TreatmentFem IdFemale n
## 1 LF 8 2
## 2 LF 11 1
## 3 LF 37 1
## 4 LF 50 1
## 5 LF 59 3
## 6 LF 75 1
## 7 LF 76 1
## 8 LF 86 1
## 9 LF 90 1
## 10 LF 93 1
## 11 LF 96 1
## 12 LF 101 1
## 13 LF 107 1
## 14 LF 112 1
## 15 LF 115 1
## 16 LF 119 1
## 17 LF 125 2
## 18 LF 127 1
## 19 LF 128 1
## 20 LF 130 1
## 21 LF 132 1
## 22 LF 133 1
## 23 LF 134 1
## 24 LF 135 1
## 25 LF 137 2
## 26 LF 143 1
## 27 LF 145 1
## 28 LF 148 1
## 29 LF 149 1
## 30 LF 152 1
## 31 LF 156 1
## 32 LF 157 1
## 33 LF 159 1
## 34 LF 164 1
## 35 LF 517 2
## 36 LF 528 1
## 37 LF 537 1
## 38 LF 538 1
## 39 LF 541 1
## 40 LF 544 1
## 41 LF 555 1
## 42 LF 569 1
## 43 LF 574 2
## 44 LF 594 1
## 45 LF 602 2
## 46 LF 603 1
## 47 LF 617 1
## 48 LF 622 2
## 49 WF 1 1
## 50 WF 3 1
## 51 WF 10 2
## 52 WF 28 1
## 53 WF 33 1
## 54 WF 35 1
## 55 WF 40 1
## 56 WF 54 1
## 57 WF 61 1
## 58 WF 66 1
## 59 WF 67 1
## 60 WF 69 1
## 61 WF 70 1
## 62 WF 71 1
## 63 WF 80 1
## 64 WF 81 1
## 65 WF 83 1
## 66 WF 84 1
## 67 WF 89 1
## 68 WF 97 2
## 69 WF 102 1
## 70 WF 104 1
## 71 WF 111 1
## 72 WF 116 1
## 73 WF 123 1
## 74 WF 124 2
## 75 WF 131 1
## 76 WF 138 1
## 77 WF 139 1
## 78 WF 144 1
## 79 WF 146 1
## 80 WF 147 1
## 81 WF 153 1
## 82 WF 158 1
## 83 WF 160 1
## 84 WF 161 1
## 85 WF 174 1
## 86 WF 175 1
## 87 WF 506 2
## 88 WF 520 1
## 89 WF 535 1
## 90 WF 536 1
## 91 WF 547 1
## 92 WF 556 1
## 93 WF 575 1
## 94 WF 578 1
## 95 WF 579 1
## 96 WF 580 2
## 97 WF 586 1
## 98 WF 606 1
## 99 WF 607 1
## 100 WF 626 1
## 101 WF 636 1# 48 LF (8 used >1x), 53 WF (5 used >1x), 51 Ctrl
### Male direction chosen based on female feeding regime
count(mergedSoWiNA, TreatmentFem, DirectionSameAsFemale)## TreatmentFem DirectionSameAsFemale n
## 1 LF No 28
## 2 LF Yes 29
## 3 WF No 33
## 4 WF Yes 25# WF yes = 25, no = 33 (n = 58)
binom.test(25, 58, p=0.5, conf.level=0.95)##
## Exact binomial test
##
## data: 25 and 58
## number of successes = 25, number of trials = 58, p-value = 0.3581
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.3016245 0.5677302
## sample estimates:
## probability of success
## 0.4310345# 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)##
## Exact binomial test
##
## data: 29 and 57
## number of successes = 29, number of trials = 57, p-value = 1
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.3728979 0.6437035
## sample estimates:
## probability of success
## 0.5087719# 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")
Influence of female phenotype on male trail-following
We investigated the likelihood of males to move in the same direction as the female that deposited the trail.
Table 2, model a) - female body mass
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))] ## (Intercept) MassFemaleMg.cs
## -0.14172033 -0.07098499
## TrialNumber.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.42289396 1.03040329
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.16505452# Calculating credible intervals
apply(bsimMassSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassSoWi)-1):length(bsimMassSoWi))] ## (Intercept) MassFemaleMg.cs TrialNumber.cs
## 2.5% -0.6301191 -0.5450851 -0.03040816
## 97.5% 0.3178296 0.3997247 1.04030093
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0005406964
## 97.5% 6.4210349505
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001151204
## 97.5% 0.9808940257## 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.
Table 2, model b) - female body size
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))]## (Intercept) TrialNumber.cs
## -0.1526675 0.4146905
## SizeFem.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.2795705 0.9841420
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1592020# Calculating credible intervals
apply(bsimSizeSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeSoWi)-1):length(bsimSizeSoWi))] ## (Intercept) TrialNumber.cs SizeFem.cs
## 2.5% -0.6502315 -0.03772071 -0.1832830
## 97.5% 0.3225875 0.99579448 0.7998298
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0005202474
## 97.5% 6.1063027053
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001244742
## 97.5% 0.8539643122## 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.
Table 2, model c) - female body condition
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))]## (Intercept) TrialNumber.cs
## -0.1451323 0.3966514
## ResidualIndexFem.cs Sigma[IdFemale:(Intercept),(Intercept)]
## -0.1554348 1.0071164
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1581680# Calculating credible intervals
apply(bsimResIndSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimResIndSoWi)-1):length(bsimResIndSoWi))] ## (Intercept) TrialNumber.cs ResidualIndexFem.cs
## 2.5% -0.6261499 -0.07510769 -0.6489086
## 97.5% 0.3293043 1.02131774 0.3177423
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0003925591
## 97.5% 6.5397134583
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001193462
## 97.5% 0.8766630790## 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 difference in phenotype between sexes F/M
As described for study 1, we fitted an additional model, in which we replaced female traits with relative difference in female and male phenotype.
Table 3, model a) - relative difference in mass
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))] ## (Intercept) TrialNumber.cs
## -0.4959850 0.4606789
## MassDifferenceRelativeFM Sigma[IdFemale:(Intercept),(Intercept)]
## 0.2930108 1.1842748
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1647608# Calculating credible intervals
apply(bsimMassDiffRelFMSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassDiffRelFMSoWi)-1):length(bsimMassDiffRelFMSoWi))] ## (Intercept) TrialNumber.cs MassDifferenceRelativeFM
## 2.5% -2.457655 -0.01902137 -1.218549
## 97.5% 1.406865 1.12724815 1.823485
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0006975079
## 97.5% 6.9677407272
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001195853
## 97.5% 0.9113859004## 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.
Table 3, model b) - relative difference in size
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 correlation |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
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)
# Calculating beta values
apply(bsimSizeDiffRelFMSoWi, 2, mean)[c(1:3,(length(bsimSizeDiffRelFMSoWi)-1):length(bsimSizeDiffRelFMSoWi))]## (Intercept) SizeDifferenceRelativeFM
## -6.0144159 5.4701420
## TrialNumber.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.3798698 0.6940963
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1360092# Calculating credible intervals
apply(bsimSizeDiffRelFMSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMSoWi)-1):length(bsimSizeDiffRelFMSoWi))] ## (Intercept) SizeDifferenceRelativeFM TrialNumber.cs
## 2.5% -11.8511879 0.7291312 -0.05610848
## 97.5% -0.9377561 10.9618989 0.90035787
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0003503714
## 97.5% 4.3725199650
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001064544
## 97.5% 0.7683912346## 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)Males were more likely to follow females that were relatively larger than them.
Figure 3 - Relative difference in size F/M
max(mergedSoWiNASizeRel$SizeDifferenceRelativeFM, na.rm = TRUE) # 1.39## [1] 1.39min(mergedSoWiNASizeRel$SizeDifferenceRelativeFM, na.rm = TRUE) # 0.84## [1] 0.84newdatDirSizeDiffRelSoWi <- 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)## DirectionMale n
## 1 L 36
## 2 R 24# Left: 36/60, Right: 24/60
binom.test(36, 60, p=0.5, conf.level=0.95)##
## Exact binomial test
##
## data: 36 and 60
## number of successes = 36, number of trials = 60, p-value = 0.155
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.4654054 0.7243784
## sample estimates:
## probability of success
## 0.6# 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)## Date DirectionMale n
## 1 01.06.2022 L 1
## 2 01.06.2022 R 1
## 3 03.02.2023 L 2
## 4 03.06.2022 L 2
## 5 06.01.2023 L 1
## 6 09.12.2022 L 2
## 7 09.12.2022 R 1
## 8 11.01.2023 L 1
## 9 11.01.2023 R 1
## 10 12.12.2022 L 2
## 11 12.12.2022 R 2
## 12 16.01.2023 L 1
## 13 18.11.2022 R 1
## 14 20.05.2022 L 2
## 15 20.05.2022 R 3
## 16 23.05.2022 L 6
## 17 23.05.2022 R 5
## 18 24.05.2022 L 7
## 19 24.05.2022 R 1
## 20 25.05.2022 L 3
## 21 25.05.2022 R 3
## 22 26.12.2022 R 1
## 23 27.05.2022 L 1
## 24 27.05.2022 R 1
## 25 28.12.2022 L 1
## 26 28.12.2022 R 1
## 27 29.11.2022 L 1
## 28 29.11.2022 R 1
## 29 29.12.2022 L 1
## 30 29.12.2022 R 1
## 31 30.05.2022 L 2
## 32 30.05.2022 R 1# 24.05.2022: Left: 7/8, Right: 1/8
binom.test(7, 8, p=0.5, conf.level=0.95)##
## Exact binomial test
##
## data: 7 and 8
## number of successes = 7, number of trials = 8, p-value = 0.07031
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.4734903 0.9968403
## sample estimates:
## probability of success
## 0.875# binomial test: p = 0.07, 88 %, 95 % CI: 47 % - 100 %, 7 out of 8
# Males chose the left direction more frequently than the other.Overall, males did not choose one direction more frequently over the other. There is directional bias on a single day. Model simulations were repeated excluding this day.
Supplementary Material for Study 2
Effect of Season
We explored the effect of season by adding the variable as random effect to our model
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 divergencesChecking 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 correlation |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
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)
# Calculating beta values
apply(bsimMassSeasonSoWi, 2, mean)[c(1:3,(length(bsimMassSeasonSoWi)-2):length(bsimMassSeasonSoWi))] ## (Intercept) MassFemaleMg.cs
## -0.10660931 -0.06986287
## TrialNumber.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.44114571 1.23159303
## Sigma[IdMale:(Intercept),(Intercept)] Sigma[Season:(Intercept),(Intercept)]
## 0.17613735 0.57929632# Calculating credible intervals
apply(bsimMassSeasonSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassSeasonSoWi)-2):length(bsimMassSeasonSoWi))]## (Intercept) MassFemaleMg.cs TrialNumber.cs
## 2.5% -1.160763 -0.5739425 -0.03028881
## 97.5% 1.075081 0.4240087 1.10544815
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0005523617
## 97.5% 7.2153152258
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001233182
## 97.5% 0.9811809385
## Sigma[Season:(Intercept),(Intercept)]
## 2.5% 0.0001537631
## 97.5% 4.4841632604## 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)Season did not explain variation in the model output.
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))] ## (Intercept) TrialNumber.cs
## -0.1371592 0.4336989
## MassMaleMg.cs Sigma[IdFemale:(Intercept),(Intercept)]
## -0.2118530 0.9682337
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1540865# Calculating credible intervals
apply(bsimMassMaleSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassMaleSoWi)-1):length(bsimMassMaleSoWi))] ## (Intercept) TrialNumber.cs MassMaleMg.cs
## 2.5% -0.5975745 -0.01237114 -0.6798483
## 97.5% 0.3350626 1.06575076 0.2398300
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0005141153
## 97.5% 6.0452550184
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001094319
## 97.5% 0.8644185445## 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))] ## (Intercept) TrialNumber.cs
## -0.3791563 0.4236532
## SizeMale.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.2677689 1.0809990
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1624722# Calculating credible intervals
apply(bsimSizeMaleSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeMaleSoWi)-1):length(bsimSizeMaleSoWi))] ## (Intercept) TrialNumber.cs SizeMale.cs
## 2.5% -1.0760582 -0.02900287 -0.1623850
## 97.5% 0.2182681 1.06542777 0.7744574
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0005044381
## 97.5% 6.8669531202
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001582737
## 97.5% 0.8994274505## 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)
# Fitting the model
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))] ## (Intercept) ResidualIndexMale.cs
## -0.18412130 -0.03185427
## TrialNumber.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.42021531 1.34928638
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.16837786# Calculating credible intervals
apply(bsimResIndMaleSoWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimResIndMaleSoWi)-1):length(bsimResIndMaleSoWi))] ## (Intercept) ResidualIndexMale.cs TrialNumber.cs
## 2.5% -0.6976019 -0.5431918 -0.04106413
## 97.5% 0.2951573 0.4558814 1.08102126
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0006687704
## 97.5% 8.5598858652
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001424454
## 97.5% 0.9600177931## 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 S11 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## (Intercept) SizeDifferenceRelativeFM
## -7.1282538 6.5220468
## TrialNumber.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.4248231 1.7317743
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.2089068apply(bsimSizeDiffRelFMSo, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMSo)-1):length(bsimSizeDiffRelFMSo))] # credible intervals## (Intercept) SizeDifferenceRelativeFM TrialNumber.cs
## 2.5% -15.8994077 0.3477532 -0.1437824
## 97.5% -0.5192924 14.5364352 1.1349587
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 7.23259e-04
## 97.5% 1.11562e+01
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001318191
## 97.5% 1.1812323773## 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 S11 B) Autumn
SizeRelWiNA <- mergedSoWiNASizeRel[mergedSoWiNASizeRel$Season == "WiSe",]
modSizeDiffRelFMWi <- stan_glmer(DirectionSameAsFemale ~ 1 + SizeDifferenceRelativeFM + TrialNumber.cs +
(1|IdFemale)+ (1|IdMale), SizeRelWiNA, family="binomial", iter = 4000)##
## SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 1).
## Chain 1:
## Chain 1: Gradient evaluation took 0 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1:
## Chain 1:
## Chain 1: Iteration: 1 / 4000 [ 0%] (Warmup)
## Chain 1: Iteration: 400 / 4000 [ 10%] (Warmup)
## Chain 1: Iteration: 800 / 4000 [ 20%] (Warmup)
## Chain 1: Iteration: 1200 / 4000 [ 30%] (Warmup)
## Chain 1: Iteration: 1600 / 4000 [ 40%] (Warmup)
## Chain 1: Iteration: 2000 / 4000 [ 50%] (Warmup)
## Chain 1: Iteration: 2001 / 4000 [ 50%] (Sampling)
## Chain 1: Iteration: 2400 / 4000 [ 60%] (Sampling)
## Chain 1: Iteration: 2800 / 4000 [ 70%] (Sampling)
## Chain 1: Iteration: 3200 / 4000 [ 80%] (Sampling)
## Chain 1: Iteration: 3600 / 4000 [ 90%] (Sampling)
## Chain 1: Iteration: 4000 / 4000 [100%] (Sampling)
## Chain 1:
## Chain 1: Elapsed Time: 1.759 seconds (Warm-up)
## Chain 1: 1.699 seconds (Sampling)
## Chain 1: 3.458 seconds (Total)
## Chain 1:
##
## SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 2).
## Chain 2:
## Chain 2: Gradient evaluation took 0 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2:
## Chain 2:
## Chain 2: Iteration: 1 / 4000 [ 0%] (Warmup)
## Chain 2: Iteration: 400 / 4000 [ 10%] (Warmup)
## Chain 2: Iteration: 800 / 4000 [ 20%] (Warmup)
## Chain 2: Iteration: 1200 / 4000 [ 30%] (Warmup)
## Chain 2: Iteration: 1600 / 4000 [ 40%] (Warmup)
## Chain 2: Iteration: 2000 / 4000 [ 50%] (Warmup)
## Chain 2: Iteration: 2001 / 4000 [ 50%] (Sampling)
## Chain 2: Iteration: 2400 / 4000 [ 60%] (Sampling)
## Chain 2: Iteration: 2800 / 4000 [ 70%] (Sampling)
## Chain 2: Iteration: 3200 / 4000 [ 80%] (Sampling)
## Chain 2: Iteration: 3600 / 4000 [ 90%] (Sampling)
## Chain 2: Iteration: 4000 / 4000 [100%] (Sampling)
## Chain 2:
## Chain 2: Elapsed Time: 1.596 seconds (Warm-up)
## Chain 2: 1.63 seconds (Sampling)
## Chain 2: 3.226 seconds (Total)
## Chain 2:
##
## SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 3).
## Chain 3:
## Chain 3: Gradient evaluation took 0 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3:
## Chain 3:
## Chain 3: Iteration: 1 / 4000 [ 0%] (Warmup)
## Chain 3: Iteration: 400 / 4000 [ 10%] (Warmup)
## Chain 3: Iteration: 800 / 4000 [ 20%] (Warmup)
## Chain 3: Iteration: 1200 / 4000 [ 30%] (Warmup)
## Chain 3: Iteration: 1600 / 4000 [ 40%] (Warmup)
## Chain 3: Iteration: 2000 / 4000 [ 50%] (Warmup)
## Chain 3: Iteration: 2001 / 4000 [ 50%] (Sampling)
## Chain 3: Iteration: 2400 / 4000 [ 60%] (Sampling)
## Chain 3: Iteration: 2800 / 4000 [ 70%] (Sampling)
## Chain 3: Iteration: 3200 / 4000 [ 80%] (Sampling)
## Chain 3: Iteration: 3600 / 4000 [ 90%] (Sampling)
## Chain 3: Iteration: 4000 / 4000 [100%] (Sampling)
## Chain 3:
## Chain 3: Elapsed Time: 1.797 seconds (Warm-up)
## Chain 3: 1.777 seconds (Sampling)
## Chain 3: 3.574 seconds (Total)
## Chain 3:
##
## SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 4).
## Chain 4:
## Chain 4: Gradient evaluation took 0.001 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 10 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4:
## Chain 4:
## Chain 4: Iteration: 1 / 4000 [ 0%] (Warmup)
## Chain 4: Iteration: 400 / 4000 [ 10%] (Warmup)
## Chain 4: Iteration: 800 / 4000 [ 20%] (Warmup)
## Chain 4: Iteration: 1200 / 4000 [ 30%] (Warmup)
## Chain 4: Iteration: 1600 / 4000 [ 40%] (Warmup)
## Chain 4: Iteration: 2000 / 4000 [ 50%] (Warmup)
## Chain 4: Iteration: 2001 / 4000 [ 50%] (Sampling)
## Chain 4: Iteration: 2400 / 4000 [ 60%] (Sampling)
## Chain 4: Iteration: 2800 / 4000 [ 70%] (Sampling)
## Chain 4: Iteration: 3200 / 4000 [ 80%] (Sampling)
## Chain 4: Iteration: 3600 / 4000 [ 90%] (Sampling)
## Chain 4: Iteration: 4000 / 4000 [100%] (Sampling)
## Chain 4:
## Chain 4: Elapsed Time: 1.576 seconds (Warm-up)
## Chain 4: 1.742 seconds (Sampling)
## Chain 4: 3.318 seconds (Total)
## Chain 4: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## (Intercept) SizeDifferenceRelativeFM
## -5.5620438 4.9894283
## TrialNumber.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.6533452 2.9629915
## Sigma[IdMale:(Intercept),(Intercept)]
## 1.0355348apply(bsimSizeDiffRelFMWi, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMWi)-1):length(bsimSizeDiffRelFMWi))] # credible intervals## (Intercept) SizeDifferenceRelativeFM TrialNumber.cs
## 2.5% -18.480552 -6.463714 -0.3639099
## 97.5% 6.622557 17.158593 2.1957539
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.000970037
## 97.5% 19.613832890
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0004567956
## 97.5% 6.2904667537## 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)In autumn, 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 S12 A - Effect of female mass
# count(mergedSoWiNAExcl, DirectionSameAsFemale) # n = 100
mergedSoWiNAExcl$DirectionSameAsFemale <- as.factor(mergedSoWiNAExcl$DirectionSameAsFemale)
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 correlation |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))] ## (Intercept) MassFemaleMgExcl.cs
## -0.1663503 0.1053625
## TrialNumberExcl.cs Sigma[IdFemale:(Intercept),(Intercept)]
## 0.2757708 0.2935090
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1615812# Calculating credible intervals
apply(bsimMassSoWiExcl, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimMassSoWiExcl)-1):length(bsimMassSoWiExcl))] ## (Intercept) MassFemaleMgExcl.cs TrialNumberExcl.cs
## 2.5% -0.6271581 -0.3421332 -0.1720708
## 97.5% 0.2806745 0.5795741 0.7470675
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0001742874
## 97.5% 1.7349765216
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 0.0001051512
## 97.5% 0.8801545549## 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)When excluding the biased day, 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 correlation |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))] ## (Intercept) TrialNumberExcl.cs
## -6.2276534 0.1824200
## SizeDifferenceRelativeFM Sigma[IdFemale:(Intercept),(Intercept)]
## 5.6574448 0.2621756
## Sigma[IdMale:(Intercept),(Intercept)]
## 0.1504360# Calculating credible intervals
apply(bsimSizeDiffRelFMSoWiExcl, 2, quantile, prob=c(0.025, 0.975))[,c(1:3,(length(bsimSizeDiffRelFMSoWiExcl)-1):length(bsimSizeDiffRelFMSoWiExcl))] ## (Intercept) TrialNumberExcl.cs SizeDifferenceRelativeFM
## 2.5% -11.636053 -0.2553962 1.005911
## 97.5% -1.269117 0.6401047 10.775364
## Sigma[IdFemale:(Intercept),(Intercept)]
## 2.5% 0.0002486965
## 97.5% 1.5567403746
## Sigma[IdMale:(Intercept),(Intercept)]
## 2.5% 9.444743e-05
## 97.5% 8.318096e-01## 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)When excluding the biased day, 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) # 1.06## [1] 1.06mean(mergedSoWiNA$SizeDifferenceRelativeFM, na.rm = TRUE) # 1.07## [1] 1.06708