# Manuscript title: The role of among-individual behavioural variation in the mating outcome of the spider Pisaura mirabilis # Study authors: # Publication year: 2025 # Journal: # Code written by: ## Data requirements: Loading packages and data ################################## ### Necessary packages library(arm) library(ggplot2) library(ggpubr) # ggqqplots library(gridExtra) library(lme4) library(MCMCglmm) library(plotrix) # std.error() library(plyr) # count() library(remotes) library(rptR) library(rstanarm) library(tidyverse) setwd("") ### Data for personality analysis between sexes dataP <- read.csv("Personalities_ENG.csv") ### Data for influence of personality on mating outcome dataM <- read.csv2("PersonalityMatings_ENG.csv") ### Adjusting data frame # Selecting columns for analysis # Personality analysis dataP <- dataP[, c("Semester", "IdSpider", "Sex", "IdObserver", "TestOrder", "Immobile", "BrushScore", "DurationImmobility","Age", "HeadWidthMean")] # Mating outcome analysis dataM <- dataM[, c("Semester", "IdMale", "IdFemale", "AgeMale", "AgeFem", "Pair", "HeadWidthMeanMale", "HeadWidthMeanFemale", "Wrapped", "DurationWrapping", "DurationCourtship", "Courted", "Accepted", "LatencyToAcceptanceFirst","Mated","DurationMatingTotal", "ExplorationMeanMale", "ExplorationMeanFemale", "AggressionMeanMale", "AggressionMeanFemale")] # Adjust data types for used variables dataP[,"Semester"] <- as.factor(dataP[,"Semester"]) dataP[,"Sex"] <- as.factor(dataP[,"Sex"]) dataP[,"IdObserver"] <- as.factor(dataP[,"IdObserver"]) dataP[,"IdSpider"] <- as.factor(dataP[,"IdSpider"]) dataP[,"Immobile"] <- as.factor(dataP[,"Immobile"]) dataP[,"DurationImmobility"] <- as.integer(dataP[,"DurationImmobility"]) dataM[,"Semester"] <- as.factor(dataM[,"Semester"]) dataM[,"Wrapped"] <- as.factor(dataM[,"Wrapped"]) dataM[,"Courted"] <- as.factor(dataM[,"Courted"]) dataM[,"Accepted"] <- as.factor(dataM[,"Accepted"]) dataM[,"Mated"] <- as.factor(dataM[,"Mated"]) dataM <- dataM[dataM$Mated == "Yes" | dataM$Mated == "No",] # Reassign Max-value of 2700 (=45 min; time when trial was terminated) for those animals that were not accepted for mating dataM$LatencyToAcceptanceFirst[is.na(dataM$LatencyToAcceptanceFirst)] <- 2700 # Rename and redefine variable for Exploration # Explanation: An immobile animal had "Immobile = yes", but "Exploration = no" dataP$ExploredAtStart <- as.factor(ifelse(dataP$Immobile == "n", "y", "n")) dataP$ExploredAtStartNumber <- ifelse(dataP$ExploredAtStart == "y", 1, 0) dataP$Explored <- as.factor(ifelse(dataP$DurationImmobility != 600, "y", "n")) dataP$ExploredNumber <- ifelse(dataP$Explored=="n", 0, 1) ### Remove missing values # Personality analysis (n = 411): # NAs in head width column (n = 30) sum(is.na(dataP$HeadWidthMean)) length(dataP$HeadWidthMean) dataP <- dataP %>% drop_na(HeadWidthMean, BrushScore, DurationImmobility) # Mating outcome analysis (n = 41): # NAs in male and female head widths (n = 3, n = 4) sum(is.na(dataM$HeadWidthMeanMale)) sum(is.na(dataM$HeadWidthMeanFemale)) dataMna <- dataM %>% drop_na(HeadWidthMeanMale, HeadWidthMeanFemale) ### Grand-Mean-Center and standardize variables for biologically meaningful estimates # Explanation: The later used models set variable values to 0, leading to, e.g., results for animals of a headwidth of 0 dataP$TestOrder.cs <- scale(dataP$TestOrder) dataP$Age.cs <- scale(dataP$Age) dataP$HeadWidthMean.cs <- scale(dataP$HeadWidthMean) dataM$AgeMale.cs <- scale(dataM$AgeMale) dataM$AgeFem.cs <- scale(dataM$AgeFem) ### Investigate distribution of personality measures hist(dataP$BrushScore, freq = TRUE, xlab = "brush test score", main = "Histogram of Brush Score") hist(dataP$ExploredAtStartNum, freq = TRUE, xlab = "Exploration", main = "Histogram of Exploration at trial start (Y/N)") hist(dataP$DurationImmobility, freq = TRUE, breaks = 50, xlab = "Duration of exploration", main = "Histogram of exploration duration") ################################## # Personality analysis # Investigation of sex differences for personality traits ## Table 1: Marcov-Chain-Montecarlo models (MCMC-glmms) ## Setting the priors for the respective distributions # Gaussian response variable (BrushScore) priorGauss <- list(R = list(V = diag(1), nu = 1.002), G = list(G1 = list(V = diag(1), nu = 1.002))) # Categorical/Binomial response variable (Explored y/n) priorCat <- list(R = list(V= 1, fix= 1), G = list(G1 = list(V= diag(1), nu= 1000, alpha.mu= 0, alpha.V= 1))) # Poisson response variable (Latency to Exploration) priorPoisson <- list(R = list(V = 1, nu = 1), G = list(G1 = list(V = 1, nu = 1, alpha.mu = 0, alpha.V = 1000))) ## Model Simulation for Aggressiveness modTable1Aggression <- MCMCglmm(BrushScore ~ 1 + Sex + TestOrder.cs + Semester + Age.cs + HeadWidthMean.cs, random = ~IdSpider, data = dataP, family="gaussian", prior = priorGauss, pr = TRUE, nitt = 1000000, burnin = 100000, thin = 100, verbose = TRUE) ## Analyses for model convergence # Visual assessment # Investigation of model solution (traces and density plots) # Explanation: Trace plots should fluctuate randomly (without obvious trends or drifts) # Density plots should be smooth and only have 1 peak plot(modTable1Aggression$Sol[,1:6]) # all good # Investigation of the Variance-Covariance matrix of the random effects # Explanation: Same as for solution graphs plot(modTable1Aggression$VCV) # Non-visual assessment # Investigating autocorrelation # Explanation: Values should decrease with higher iterations autocorr.diag(modTable1Aggression$Sol[, 1:6]) # all good autocorr.diag(modTable1Aggression$VCV) # all good # Heidelberger and Welch diagnostic # Explanation: test should be passed and Halfwidth < 0.1 heidel.diag(modTable1Aggression$VCV) # all good # Calculate effective sample size for variables (should be >200) effSize <- effectiveSize(modTable1Aggression$Sol) effSize[1:6] # Results for eff-Size (model value = 1049400) # Intercept = 9000.00 # Sex = 9000.00 # TestOrder = 9000.00 # Semester(WS)= 9000.00 # Age = 9000.00 # Headwidth = 8605.961 ## Drawing conclusions summary(modTable1Aggression) # Results # Intercept 3.84 (3.48, 4.23) # Spider sex (male) -0.73 (-1.15, -0.30) * # Test order.cs -0.11 (-0.26, 0.05) # Season (winter) 0.09 (-0.31, 0.51) # Age.cs -0.02 (-0.26, 0.23) # Size.cs 0.09 (-0.14, 0.31) # Id Spider (betw.-ind) 0.54 (0.23, 0.87) # Units (within-ind) 2.12 (1.76, 2.50) # Calculating between and within-individual variance posterior.mode(modTable1Aggression$VCV) HPDinterval(modTable1Aggression$VCV) # Results beta and CIs # IdSpider 0.51 (0.24, 0.88) # Units 2.10 (1.76, 2.49) ################################## # Exploration - Explored at trial start ## Model Simulation modTable1ExplorationAtStart <- MCMCglmm(ExploredAtStart ~ 1 + Sex + TestOrder.cs + Semester + Age.cs + HeadWidthMean.cs, random = ~IdSpider, data = dataP, family="categorical", prior = priorCat, pr = TRUE, nitt = 1000000, burnin = 100000, thin = 100, verbose = TRUE) ## Analyses for model convergence # Visual assessment # Investigation of model solution (traces and density plots) # Explanation: Trace plots should fluctuate randomly (without obvious trends or drifts) # Density plots should be smooth and only have 1 peak plot(modTable1ExplorationAtStart$Sol[,1:6]) # all good # Investigation of the Variance-Covariance matrix of the random effects # Explanation: Same as for solution graphs plot(modTable1ExplorationAtStart$VCV) # Non-visual assessment # Investigating autocorrelation # Explanation: Values should decrease with higher iterations autocorr.diag(modTable1ExplorationAtStart$Sol[, 1:6]) # okay autocorr.diag(modTable1ExplorationAtStart$VCV) # okay # Heidelberger and Welch diagnostic # Explanation: test should be passed and Halfwidth < 0.1 heidel.diag(modTable1ExplorationAtStart$VCV) # good # Calculate effective sample size for variables (should be >200) effSize <- effectiveSize(modTable1ExplorationAtStart$Sol) effSize[1:6] # Results for eff-Size (model value = 38160) # Intercept = 4084 # Sex = 2907 # TestOrder = 6821 # Semester(WS)= 3715 # Age = 6568 # Headwidth = 6476 ## Drawing conclusions summary(modTable1ExplorationAtStart) # Results # Intercept -2.93 (-4.23, -1.62) # Spider sex (male) 4.41 ( 2.87, 6.08) * # Test order.cs -0.39 (-0.82, 0.01) . # Season (winter) -2.64 (-4.04, -1.27) * # Age.cs -0.53 (-1.32, 0.28) # Size.cs 0.61 (-0.13, 1.35) # Id Spider (betw.-ind) 6.45 (2.71, 10.88) # Units (within-ind) 1.00 (1.00, 1.00) # Calculating between and within-individual variance posterior.mode(modTable1Exploration$VCV) HPDinterval(modTable1Exploration$VCV) # Results beta and CIs # IdSpider 6.32 (2.71, 11.11) # Units 1.00 (1.00, 1.00) ################################## # Exploration - Latency to exploration ## remove data in which animals never moved dataPExpl <- dataP[dataP$DurationImmobility != 600,] dataPExpl$TestOrder.cs <- scale(dataPExpl$TestOrder) dataPExpl$Age.cs <- scale(dataPExpl$Age) dataPExpl$HeadWidthMean.cs <- scale(dataPExpl$HeadWidthMean) ## Model Simulation modTable1LatExpl <- MCMCglmm(DurationImmobility ~ 1 + Sex + TestOrder.cs + Semester + Age.cs + HeadWidthMean.cs, random = ~IdSpider, data = dataPExpl, family="poisson", prior = priorPoisson, pr = TRUE, nitt = 1000000, burnin = 100000, thin = 100, verbose = TRUE) ## Analyses for model convergence # Visual assessment # Investigation of model solution (traces and density plots) # Explanation: Trace plots should fluctuate randomly (without obvious trends or drifts) # Density plots should be smooth and only have 1 peak plot(modTable1LatExpl$Sol[,1:6]) # all good # Investigation of the Variance-Covariance matrix of the random effects # Explanation: Same as for solution graphs plot(modTable1LatExpl$VCV) # Non-visual assessment # Investigating autocorrelation # Explanation: Values should decrease with higher iterations autocorr.diag(modTable1LatExpl$Sol[, 1:6]) # okay autocorr.diag(modTable1LatExpl$VCV) # okay # Heidelberger and Welch diagnostic # Explanation: test should be passed and Halfwidth < 0.1 heidel.diag(modTable1LatExpl$VCV) # good # Calculate effective sample size for variables (should be >200) effSize <- effectiveSize(modTable1LatExpl$Sol) effSize[1:6] # Results for eff-Size (model value = 38160) # Intercept = 8680 # Sex = 9000 # TestOrder = 8458 # Semester(WS)= 9000 # Age = 9000 # Headwidth = 9000 ## Drawing conclusions summary(modTable1LatExpl) # Results, n = 327 # Intercept 3.03 ( 2.04, 3.94) # Spider sex (male) -3.76 (-4.87, -2.63) * # Test order.cs 0.15 (-0.15, 0.46) # Season (winter) 2.32 ( 1.27, 3.39) * # Age.cs 0.36 (-0.26, 0.99) # Size.cs -0.51 (-1.09, 0.04) . # Id Spider (betw.-ind) 5.35 (3.17, 7.96) # Units (within-ind) 4.82 (3.52, 6.21) # Calculating between and within-individual variance posterior.mode(modTable1Exploration$VCV) HPDinterval(modTable1Exploration$VCV) # Results beta and CIs # IdSpider 6.32 (2.71, 11.11) # Units 1.00 (1.00, 1.00) ################################## # Fig. 1 Behavioural differences between the sexes in aggressiveness and exploration score ## Calculate mean aggressiveness and exploration score per individual meanScores <- dataP %>% group_by(IdSpider, Sex) %>% summarise( MeanBrushScore = mean(BrushScore, na.rm = TRUE), MeanExplorationScore = mean(ExploredAtStartNumber, na.rm = TRUE) ) meanScores <- as.data.frame(meanScores) count(meanScores, Sex) # f = 54, m = 73 library("superb") ggplot(iris, aes(x=Species, y=Sepal.Length)) + geom_boxplot() + showSignificance( c(1,2), 7.5, -0.05, "**") + showSignificance( c(2,3), 4.5, +0.05, "n.s.") + showSignificance( 3.45, c(6.5,5.9), -0.02, "yup!") plot1a <- ggplot(meanScores, aes(x = Sex, y = MeanBrushScore, fill = Sex))+ geom_boxplot()+ geom_jitter(color="grey60", height = 0.00, width = 0.04, size=1, alpha = 0.8)+ showSignificance( c(1,2), 6.5, -0.00, "*") + scale_y_continuous(limits=c(0.0,7.0), breaks = seq(0,6,2), expand = c(0,0))+ scale_x_discrete(labels= c("female\nn=54","male\nn=73"))+ ylab("mean aggression score")+ xlab("spider sex") + scale_fill_manual(values=c("grey40","grey88") )+ theme_light(base_size=18)+ guides(fill="none") # Figure 1b - Males more explorative than females plot1b <- ggplot(meanScores, aes(x = Sex, y = MeanExplorationScore, fill = Sex))+ geom_bar(stat="summary", col="black")+ stat_summary( fun.data = mean_se, # Function to calculate mean and SE geom = "errorbar", # Add error bars width = 0.1)+ geom_jitter(color="grey55", height = 0.00, width = 0.1, size=1, alpha = 0.8)+ showSignificance( c(1,2), 1.02, -0.0, "*") + scale_y_continuous(limits=c(-0.01, 1.1), breaks = seq(0,1.01,0.2), expand = c(0,0))+ scale_x_discrete(labels= c("female\nn=54","male\nn=73"))+ ylab("mean exploration score")+ xlab("spider sex") + scale_fill_manual(values=c("grey40","grey88") )+ theme_light(base_size=18)+ guides(fill="none") ggarrange(plot1a, NULL, plot1b, font.label = list(size = 14, color = "black", face = "bold", family = NULL, position = "top"), widths = c(1, 0.05, 1), labels = c("A", "", "B"), hjust = c(-0.5, -0.5, 0.8), ncol = 3) ################################## # Repeatability of aggressiveness and exploration ## Calculating repeatability # Repeatability for males and females together ### Aggressiveness (Gaussian) posterior_variancesAgg <- modTable1Aggression$VCV # Extract variance components VindAgg <- posterior_variancesAgg[,"IdSpider"] # Random effect variance VeAgg <- posterior_variancesAgg[,"units"] # Residual variance repeatabilityAgg <- VindAgg/(VindAgg+VeAgg) posterior.mode(repeatabilityAgg) HPDinterval(repeatabilityAgg) # Results # var = 0.22 (0.09, 0.30) ### Exploration at start (Binomial) posterior_variancesExplStart <- modTable1ExplorationAtStart$VCV # Extract variance components VindExplStart <- posterior_variancesExplStart[,"IdSpider"] VeExplStart <- (pi^2)/3 # Fixed for binomial models repeatabilityExplStart <- VindExplStart/(VindExplStart+VeExplStart) posterior.mode(repeatabilityExplStart) HPDinterval(repeatabilityExplStart) # Results # var = 0.66 (0.49, 0.78) ### Latency to exploration (poisson) posterior_variancesLatExpl <- modTable1LatExpl$VCV # Extract variance components VindLatExpl <- posterior_variancesLatExpl[,"IdSpider"] VeLatExpl <- posterior_variancesLatExpl[,"units"] repeatabilityLatExpl <- VindLatExpl/(VindLatExpl+VeLatExpl) posterior.mode(repeatabilityLatExpl) HPDinterval(repeatabilityLatExpl) # Results # var = 0.51 (0.39, 0.66) ################################## ################################## # Table 2. Repeatability for each sex separately # First, model repetition with sex in the random effects to allow for sex-specific variation between and within individuals # Note: in the exploration model, variation is only allowed for between-individual variance as the residual variance is fixed at piČ/3 due to the binomial nature # Second, calculations for the table: # a) Variances (Vin, Ve) and their mean values # b) using posterior.mode and HPDinterval for the overall repeatability calculation ## Priors adjusted to allow variation on the between and within individual level ## Note: Due to the binomial nature of the exploration model (i.e. fixed variance), only between-individual variance is allowed priorGaussMF2 <- list(R = list(V = diag(2), nu = 1.002), G = list(G1 = list(V = diag(2), nu = 1.002))) priorCatMF <- list(R = list(V= 1, fix= 1), G = list(G1 = list(V= diag(2), nu= 1000, alpha.mu= rep(0,2), alpha.V= diag(2)))) priorPoissonMF <- list(R = list(V = diag(2), nu = 1), G = list(G1 = list(V = diag(2), nu = 1, alpha.mu = rep(0,2), alpha.V = diag(2)))) ### Aggressiveness (Gaussian) modAggressionSexes <- MCMCglmm(BrushScore ~ 1 + Sex + TestOrder.cs + Semester + Age.cs + HeadWidthMean.cs, random = ~us(Sex):IdSpider, rcov = ~ idh(Sex):units, data = dataP, family="gaussian", prior = priorGaussMF2, pr = TRUE, nitt = 1000000, burnin = 100000, thin = 100, verbose = TRUE) ### Exploration at start (Binomial) modExplorationAtStartMF <- MCMCglmm(ExploredAtStart ~ 1 + Sex + TestOrder.cs + Semester + Age.cs + HeadWidthMean.cs, random = ~us(Sex):IdSpider, rcov = ~ units, data = dataP, family="categorical", prior = priorCatMF, pr = TRUE, nitt = 1000000, burnin = 100000, thin = 100, verbose = TRUE) # Exploration - Latency to exploration ## Model Simulation modLatExplMF <- MCMCglmm(DurationImmobility ~ 1 + Sex + TestOrder.cs + Semester + Age.cs + HeadWidthMean.cs, random = ~us(Sex):IdSpider, rcov = ~ idh(Sex):units, data = dataPExpl, family="poisson", prior = priorPoissonMF, pr = TRUE, nitt = 1000000, burnin = 100000, thin = 100, verbose = TRUE) ## Mean values for variances for both sexes ### Aggressiveness # Extract variances posterior_variancesAggMF <- modAggressionSexes$VCV # Extract variance components # Female aggressiveness # Get mean values for Vind and Ve VindAggF <- posterior_variancesAggMF[,"Sexf:Sexf.IdSpider"] # Random effect variance VindMeanF <- mean(VindAggF) # 0.61 VindMeanHPDF <- HPDinterval(VindAggF) # 0.16, 1.10 VeAggF <- posterior_variancesAggMF[, "Sexf.units"] # Residual variance VeMeanF <- mean(VeAggF) # 2.08 VeMeanHPDF <- HPDinterval(VeAggF) # 1.57, 2.65 ## Get repeatability calculation repeatabilityAggF <- VindAggF/(VindAggF+VeAggF) posterior.mode(repeatabilityAggF) HPDinterval(repeatabilityAggF) # Results for Table 2 column 1 # Vind = 0.61 (0.16, 1.10) # Ve = 2.08 (1.57, 2.65) # R = 0.20 (0.07, 0.37) #Male aggressiveness # Get mean values for Vind and Ve VindAggM <- posterior_variancesAggMF[,"Sexm:Sexm.IdSpider"] # Random effect variance VindMeanM <- mean(VindAggM) # 0.56 VindMeanHPDM <- HPDinterval(VindAggM) # 0.17, 0.98 VeAggM <- posterior_variancesAggMF[, "Sexm.units"] # Residual variance VeMeanM <- mean(VeAgg) # 2.13 VeMeanHPDM <- HPDinterval(VeAggM) # 1.70, 2.66 ## Get repeatability calculation repeatabilityAggM <- VindAggM/(VindAggM+VeAggM) posterior.mode(repeatabilityAggM) HPDinterval(repeatabilityAggM) # Results for Table 2 column 2 # Vind = 0.56 (0.17, 0.98) # Ve = 2.13 (1.70, 2.66) # R = 0.17 (0.07, 0.33) ### Difference between male and female aggressiveness diff_Ragg <- repeatabilityAggF - repeatabilityAggM posterior.mode(diff_Ragg) # 0.03 HPDinterval(diff_Ragg) # -0.18, 0.22 ### Exploration at start # Extract variances posterior_variancesExplAtStartMF <- modExplorationAtStartMF$VCV # Extract variance components # Female exploration at start # Get mean values for Vind and Ve VindExplASF <- posterior_variancesExplAtStartMF[,"Sexf:Sexf.IdSpider"] # Random effect variance VindExplASMeanF <- mean(VindExplASF) # 5.87 VindExplASMeanHPDF <- HPDinterval(VindExplASF) # 1.44, 11.07 VeExpl <- (pi^2)/3 # fixed and same for both sexes ## Get repeatability calculation repeatabilityExplASF <- VindExplASF/(VindExplASF+VeExpl) posterior.mode(repeatabilityExplASF) HPDinterval(repeatabilityExplASF) # Results for Table 2 column 3 # Vind = 5.87 (1.44, 11.07) # Ve = piČ/3 # R = 0.66 (0.40, 0.80) #Male exploration at start # Get mean values for Vind and Ve VindExplASM <- posterior_variancesExplAtStartMF[,"Sexm:Sexm.IdSpider"] # Random effect variance VindExplASMeanM <- mean(VindExplASM) # 4.59 VindExplASMeanHPDM <- HPDinterval(VindExplASM) # 1.35, 8.39 ## Get repeatability calculation repeatabilityExplASM <- VindExplASM/(VindExplASM+VeExpl) posterior.mode(repeatabilityExplASM) HPDinterval(repeatabilityExplASM) # Results for Table 2 column 4 # Vind = 4.59 (1.35, 8.39) # Ve = piČ/3 # R = 0.57 (0.36, 0.75) ### Difference between male and female exploration at start diff_RexplAS <- repeatabilityExplASF - repeatabilityExplASM posterior.mode(diff_RexplAS) # 0.08 HPDinterval(diff_RexplAS) # -0.24, 0.33 ## Mean values for variances for both sexes ### Latency to exploration # Extract variances posterior_variancesExplLatMF <- modLatExplMF$VCV # Extract variance components # Female Latency to exploration # Get mean values for Vind and Ve VindExplLatF <- posterior_variancesExplLatMF[,"Sexf:Sexf.IdSpider"] # Random effect variance VindExplLatMeanF <- mean(VindExplLatF) # 3.36 VindExplLatMeanHPDF <- HPDinterval(VindExplLatF) # 1.18, 5.98 VeExplLatF <- posterior_variancesExplLatMF[, "Sexf.units"] # Residual variance VeExplLatMFMeanF <- mean(VeExplLatF) # 3.47 VeExplLatMFMeanHPDF <- HPDinterval(VeExplLatF) # 2.11, 4.92 ## Get repeatability calculation repeatabilityExplLatF <- VindExplLatF/(VindExplLatF+VeExplLatF) posterior.mode(repeatabilityExplLatF) HPDinterval(repeatabilityExplLatF) # Results for Table 2 column 1 # Vind = 3.36 (1.18, 5.98) # Ve = 3.47 (2.11, 4.92) # R = 0.53 (0.27, 0.70) #Male Latency to exploration # Get mean values for Vind and Ve VindExplLatM <- posterior_variancesExplLatMF[,"Sexm:Sexm.IdSpider"] # Random effect variance VindExplLatMeanM <- mean(VindExplLatM) # 7.92 VindExplLatMeanHPDM <- HPDinterval(VindExplLatM) # 3.15, 13.33 VeExplLatM <- posterior_variancesExplLatMF[, "Sexm.units"] # Residual variance VeExplLatMFMeanM <- mean(VeExplLatM) # 6.26 VeExplLatMFMeanHPDM <- HPDinterval(VeExplLatM) # 4.00, 8.76 ## Get repeatability calculation repeatabilityExplLatM <- VindExplLatM/(VindExplLatM+VeExplLatM) posterior.mode(repeatabilityExplLatM) HPDinterval(repeatabilityExplLatM) # Results for Table 2 column 1 # Vind = 7.92 (3.15, 13.33) # Ve = 6.26 (4.00, 8.76) # R = 0.57 (0.36, 0.73) ### Difference between male and female Latency to exploration diff_RExplLat <- repeatabilityExplLatF - repeatabilityExplLatM posterior.mode(diff_RExplLat) # -0.08 HPDinterval(diff_RExplLat) # -0.35, 0.23 ################################## # Behavioural trait correlations (Part 1) ## Occurrence of exploration at trial start vs latency to exploration) # NAs: Occurrence = 0; Latency = 5, 2/162 fem, 3/218 male) # Overall comparison (both sexes), n = 375, 127 individuals modCorExplASDur <- MCMCglmm(cbind(ExploredAtStartNumber, DurationImmobility) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataP, family = c("gaussian","poisson"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) ## Results ## Between-individual correlation # Formula: CovarianceTrait1and2/sqrt(VarianceTrait1*VarianceTrait2) covarianceExplASDur <- modCorExplASDur$VCV[,2] varianceExplAS <- modCorExplASDur$VCV[,1] varianceDur <- modCorExplASDur$VCV[,4] correlationExplASDur <- covarianceExplASDur/sqrt(varianceExplAS*varianceDur) posterior.mode(correlationExplASDur) HPDinterval(correlationExplASDur) # Results between-individual correlation # var = -0.91 (-0.94, -0.87) # Significant between-individual correlation between exploration (Y/N) and exploration duration. count(dataP, ExploredAtStartNumber) # Explored yes = 121/375 (32.27%) #### Males and females separately # Subsetting dataframe to males only dataPM <- dataP[dataP$Sex == "m",] # Subsetting dataframe to females only dataPF <- dataP[dataP$Sex == "f",] ## Males: Exploration vs Latency to exploration modCorExplASDurM <- MCMCglmm(cbind(ExploredAtStartNumber, DurationImmobility) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataPM, family = c("gaussian","poisson"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationExplASDurM <- modCorExplASDurM$VCV[,2]/ sqrt(modCorExplASDurM$VCV[,4]*modCorExplASDurM$VCV[,1]) posterior.mode(correlationExplASDurM) HPDinterval(correlationExplASDurM) # Results between-individual correlation # var = -0.90 (-0.94, -0.82) # There is no between-individual correlation between aggression and exploration. ## Females: Exploration vs Latency to exploration modCorExplASDurF <- MCMCglmm(cbind(ExploredAtStartNumber, DurationImmobility) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataPF, family = c("gaussian","poisson"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationExplASDurF <- modCorExplASDurF$VCV[,2]/ sqrt(modCorExplASDurF$VCV[,4]*modCorExplASDurF$VCV[,1]) posterior.mode(correlationExplASDurF) HPDinterval(correlationExplASDurF) # Results between-individual correlation # var = -0.70 (-0.84, -0.49) # There is between-individual correlation between aggression and exploration. ################################## # Behavioural trait correlations (Part 2) ## Occurrence of exploration at trial start vs Aggressiveness (=Brush Score) # NAs: Occurrence = 0; Latency = 5, 2/162 fem, 3/218 male) # Overall comparison (both sexes), n = 375, 127 individuals modCorExplASAgg <- MCMCglmm(cbind(ExploredAtStartNumber, BrushScore) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataP, family = c("categorical","gaussian"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationExplASAgg <- modCorExplASAgg$VCV[,2]/ sqrt(modCorExplASAgg$VCV[,4]*modCorExplASAgg$VCV[,1]) posterior.mode(correlationExplASAgg) HPDinterval(correlationExplASAgg) # Results between-individual correlation # var = -0.11 (-0.43, 0.19) # There is no between-individual correlation between aggression and exploration at trial start. #### Males and females separately ## Females: Occurrence of exploration vs Aggressiveness modCorExplASAggF <- MCMCglmm(cbind(ExploredAtStartNumber, BrushScore) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataPF, family = c("categorical","gaussian"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationExplASAggF <- modCorExplASAggF$VCV[,2]/ sqrt(modCorExplASAggF$VCV[,4]*modCorExplASAggF$VCV[,1]) posterior.mode(correlationExplASAggF) HPDinterval(correlationExplASAggF) # Results between-individual correlation # var = -0.45 (-0.86, 0.27) # There is no between-individual correlation between aggression and exploration. ## Males: Occurrence of exploration vs Aggressiveness modCorExplASAggM <- MCMCglmm(cbind(ExploredAtStartNumber, BrushScore) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataPM, family = c("categorical","gaussian"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationExplASAggM <- modCorExplASAggM$VCV[,2]/ (sqrt(modCorExplASAggM$VCV[,4]*modCorExplASAggM$VCV[,1])) posterior.mode(correlationExplASAggM) HPDinterval(correlationExplASAggM) # Results between-individual correlation # var = 0.35 (-0.05, 0.73) # There is no between-individual correlation between aggression and exploration. ################################## # Behavioural trait correlations (Part 3) ## Latency to Exploration (=Immobility) and Aggressiveness (=Brush Score) dataPExplM <- dataPExpl[dataPExpl$Sex == "m",] dataPExplF <- dataPExpl[dataPExpl$Sex == "f",] modCorDurAgg <- MCMCglmm(cbind(DurationImmobility, BrushScore) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataPExpl, family = c("poisson","gaussian"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationDurAgg <- modCorDurAgg$VCV[,2]/ sqrt(modCorDurAgg$VCV[,4]*modCorDurAgg$VCV[,1]) posterior.mode(correlationDurAgg) HPDinterval(correlationDurAgg) # Results between-individual correlation # var = 0.18 (-0.18, 0.43) # There is no between-individual correlation between aggression and latency to exploration. #### Males and females separately ## Males: Occurrence of exploration vs Aggressiveness modCorDurAggM <- MCMCglmm(cbind(DurationImmobility, BrushScore) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataPExplM, family = c("poisson","gaussian"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationDurAggM <- modCorDurAggM$VCV[,2]/ (sqrt(modCorDurAggM$VCV[,4]*modCorDurAggM$VCV[,1])) posterior.mode(correlationDurAggM) HPDinterval(correlationDurAggM) # Results between-individual correlation ???Cor???_(???ind???_0y,???ind???_0z )= ???Cov???_(???ind???_0y,???ind???_0z )/???(V_(???ind???_0y ) Ś V_(???ind???_0z ) ) # var = -0.27 (-0.58, 0.23) # There is no between-individual correlation between aggression and exploration. ## Females: Occurrence of exploration vs Aggressiveness modCorDurAggF <- MCMCglmm(cbind(DurationImmobility, BrushScore) ~ (trait - 1), random = ~us(trait):IdSpider, rcov = ~idh(trait):units, data = dataPExplF, family = c("poisson","gaussian"), prior = priorGaussMF2, nitt = 1000000, thin = 100, burnin = 100000, verbose=TRUE, pr = TRUE) # Results ## Between-individual correlation correlationDurAggF <- modCorDurAggF$VCV[,2]/ sqrt(modCorDurAggF$VCV[,4]*modCorDurAggF$VCV[,1]) posterior.mode(correlationDurAggF) HPDinterval(correlationDurAggF) # Results between-individual correlation # var = 0.30 (-0.20, 0.79) # There is no between-individual correlation between aggression and exploration. ################################## # Mating interactions and outcomes (part 1) ## Descriptive statistics on mating decisions # Male and female differences in aggressiveness and exploration during mating trials ## Aggressiveness # 1 entry with missing female personality scores, total is 39-1=38 females t.test(dataM$AggressionMeanFemale, dataM$AggressionMeanMale) aggF <- dataM %>% summarise( mean = mean(AggressionMeanFemale, na.rm = TRUE), s.e. = std.error(AggressionMeanFemale, na.rm = TRUE), n() ) aggM <- dataM %>% summarise( mean = mean(AggressionMeanMale), s.e. = std.error(AggressionMeanMale), n() ) # Results # Females were significantly more aggressive than males. # two-sample t-test: t = 2.13, d.f. = 72.41, p = 0.04; # mean aggressiveness ± s.e.: females = 3.94 ± 0.19 n = 38; # males = 3.35 ± 0.17 n = 39 ## Add mean aggressiveness and exploration values to data frame meanTraits <- dataP %>% group_by(Sex,IdSpider)%>% summarise( MeanAggressionScore = mean(BrushScore, na.rm = TRUE), MeanExplorationAS = mean(ExploredAtStartNumber, na.rm = TRUE), MeanLatExpl = mean(DurationImmobility, na.rm = TRUE), Size = first(HeadWidthMean), ) fem <- meanTraits %>% filter(Sex == "f") %>% select(IdFemale = IdSpider, MeanAggressionScoreFem = MeanAggressionScore, MeanExplorationASFem = MeanExplorationAS, MeanLatencyExplorationFem = MeanLatExpl) male <- meanTraits %>% filter(Sex == "m") %>% select(IdMale = IdSpider, MeanAggressionScoreMale = MeanAggressionScore, MeanExplorationASMale = MeanExplorationAS, MeanLatencyExplorationMale = MeanLatExpl) dataM$IdMale <- as.factor(dataM$IdMale) dataM$IdFemale <- as.factor(dataM$IdFemale) # Combine male and female data into one dataframe dataM2 <- dataM dataM2 <- dataM2 %>% left_join(male, by = "IdMale") dataM2 <- dataM2 %>% left_join(fem, by = "IdFemale") t.test(dataM2$MeanExplorationASMale, dataM2$MeanExplorationASFem) expASF <- dataM2 %>% summarise( mean = mean(MeanExplorationASFem, na.rm = TRUE), s.e. = std.error(MeanExplorationASFem), n() ) expASM <- dataM2 %>% summarise( mean = mean(MeanExplorationASMale, na.rm = TRUE), s.e. = std.error(MeanExplorationASMale), n() ) # Results # Females in the mating trials were significantly less explorative than males. # two-sample t-test: t = 5.09, d.f. = 62.72, p < 0.001; # mean exploration ± s.e.: females = 0.13 ± 0.04 n = 39; # males = 0.53 ± 0.07 n = 39 ################################## # Mating interactions and outcomes (part 2) ### Model simulations: Effects of mean personality traits of each sex on mating variables # Removing the mating pair with the female missing personality scores dataMrem1 <- dataM2 %>% drop_na(AggressionMeanFemale) count(dataMrem1, Accepted) # n = 38; Yes = 28, No = 10 count(dataMrem1, Mated) # n = 38; Yes = 24, No = 14 #### Table 3 # Table 3 a) Exploration at trial start # Exploration: Mating success modTable3MatingExplAS <- stan_glm(Mated ~ MeanExplorationASMale * MeanExplorationASFem, data = dataMrem1, family = "binomial", iter = 10000) #### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modTable3MatingExplAS, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(dataMrem1$MeanExplorationASMale, resid(modTable3MatingExplAS), main="Male exploration", xlab="Male exploration") scatter.smooth(dataMrem1$MeanExplorationASFem, resid(modTable3MatingExplAS), main="Female exploration", xlab="Female exploration") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modTable3MatingExplAS),resid(modTable3MatingExplAS)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3MatingExpl) # time/location correlationlation |acf assumes row number = time acf(resid(modTable3MatingExplAS)) # -> all good ## comparison fitted values vs. data # goodness of fit graph dataMrem1[,"MatedNumber"] <- dataMrem1[,"Mated"] dataMrem1[,"MatedNumber"] <- as.numeric(dataMrem1[,"Mated"]) dataMrem1$MatedNumber[dataMrem1$Mated=="No"] <- 0 dataMrem1$MatedNumber[dataMrem1$Mated=="Yes"] <- 1 plot(fitted(modTable3MatingExplAS), jitter(dataMrem1$MatedNumber, amount=0.05), xlab="Fitted values", ylab="Probability of mating", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modTable3MatingExplAS), seq(0,1, by=0.1)) means <- tapply(dataMrem1$MatedNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dataMrem1$MatedNumber, 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 bsimMatingExplAS <- as.data.frame(modTable3MatingExplAS) nsimMatingExplAS <- nrow(bsimMatingExplAS) # Calculating beta values apply(bsimMatingExplAS, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimMatingExplAS, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 1.10 (-0.17 2.49) # Exploration Male -0.92 (-2.94, 1.00) # Exploration Fem -0.54 (-4.53, 3.75) # Expl(m):Expl(f) 0.73 (-5.75, 7.04) ## Male or female exploration did not influence mating success. ################################## # Exploration at start: Latency to acceptance (n = 38; non-accepted males have a latency of 2700sec after which the trial was terminated) modTable3AcceptLatExplAS <- stan_glm(LatencyToAcceptanceFirst ~ MeanExplorationASMale * MeanExplorationASFem, data = dataMrem1, family = Gamma(link = "log"), iter = 10000) ### Checking model assumptions #### Residuals plot -> fine ggqqplot(resid(modTable3AcceptLatExplAS, type='deviance')) #### Residuals vs test variable -> all fine scatter.smooth(dataMrem1$AggressionMeanMale, resid(modTable3AcceptLatExplAS), main="Mean male aggression", xlab="Mean male aggression") scatter.smooth(dataMrem1$AggressionMeanFemale, resid(modTable3AcceptLatExplAS), main="Mean female aggression", xlab="Mean female aggression") #### Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero scatter.smooth(fitted(modTable3AcceptLatExplAS),resid(modTable3AcceptLatExplAS)); abline(h=0, lty=2) #### Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3AcceptLatExplAS) # Time/location correlationlation |acf assumes row number = time acf(resid(modTable3AcceptLatExplAS)) # -> all good #### Drawing conclusions bsimAcceptLatExplAS <- as.data.frame(modTable3AcceptLatExplAS) nsimAcceptLatExplAS <- nrow(bsimAcceptLatExplAS) # Calculating beta values apply(bsimAcceptLatExplAS, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimAcceptLatExplAS, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 7.30 ( 6.74, 7.91) # Exploration Male -0.23 (-1.14, 0.69) # Exploration Fem -0.04 (-1.48, 1.83) # Expl(m):Expl(f) 0.46 (-2.33, 3.32) ## Male or female exploration did not influence latency to mate acceptance. ################################## # Exploration at start: Mating duration ### Reduced dataset - Only mated animals (n = 24) dataMated <- dataMrem1[dataMrem1$Mated == "Yes",] modTable3MateDurExplAS <- stan_glm(DurationMatingTotal ~ MeanExplorationASMale * MeanExplorationASFem, data = dataMated, family = Gamma(link = "log"), iter = 10000, adapt_delta = 0.99) ### Checking model assumptions #### Residuals plot -> fine ggqqplot(resid(modTable3MateDurExplAS, type='deviance')) #### Residuals vs test variable -> all fine scatter.smooth(dataMated$ExplorationMeanMale, resid(modTable3MateDurExplAS), main="Mean male aggression", xlab="Mean male aggression") scatter.smooth(dataMated$ExplorationMeanFemale, resid(modTable3MateDurExplAS), main="Mean female aggression", xlab="Mean female aggression") #### Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero scatter.smooth(fitted(modTable3MateDurExplAS),resid(modTable3MateDurExplAS)); abline(h=0, lty=2) #### Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3MateDurExplAS) # Time/location correlationlation |acf assumes row number = time acf(resid(modTable3MateDurExplAS)) # -> all good #### Drawing conclusions bsimMateDurExplAS <- as.data.frame(modTable3MateDurExplAS) nsimMateDurExplAS <- nrow(bsimMateDurExplAS) # Calculating beta values apply(bsimMateDurExplAS, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimMateDurExplAS, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 7.66 ( 7.05, 8.34) # Exploration Male -0.17 (-1.20, 0.88) # Exploration Fem -1.26 (-0.89, 3.85) # Expl(m):Expl(f) -3.58 (-7.16, 0.06) ## Male or female exploration at trial start did not affect mating duration. ################################## # Table 3 b) Latency to exploration # Mating success modTable3MatingLatExpl <- stan_glm(Mated ~ scale(MeanLatencyExplorationMale) * scale(MeanLatencyExplorationFem), data = dataMrem1, family = "binomial", iter = 10000) #### Checking model assumptions # Residuals plot -> fine ggqqplot(resid(modTable3MatingLatExpl, type='deviance')) # Residuals vs test variable -> all fine scatter.smooth(dataMrem1$MeanExplorationASMale, resid(modTable3MatingLatExpl), main="Male exploration", xlab="Male exploration") scatter.smooth(dataMrem1$MeanExplorationASFem, resid(modTable3MatingLatExpl), main="Female exploration", xlab="Female exploration") # residuals vs. fitted values (Tukey-Anscombe plot) # mean should be around zero - is okay scatter.smooth(fitted(modTable3MatingLatExpl),resid(modTable3MatingLatExpl)); abline(h=0, lty=2) # check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3MatingExpl) # time/location correlationlation |acf assumes row number = time acf(resid(modTable3MatingLatExpl)) # -> all good ## comparison fitted values vs. data # goodness of fit graph dataMrem1[,"MatedNumber"] <- dataMrem1[,"Mated"] dataMrem1[,"MatedNumber"] <- as.numeric(dataMrem1[,"Mated"]) dataMrem1$MatedNumber[dataMrem1$Mated=="No"] <- 0 dataMrem1$MatedNumber[dataMrem1$Mated=="Yes"] <- 1 plot(fitted(modTable3MatingExplAS), jitter(dataMrem1$MatedNumber, amount=0.05), xlab="Fitted values", ylab="Probability of mating", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modTable3MatingExplAS), seq(0,1, by=0.1)) means <- tapply(dataMrem1$MatedNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dataMrem1$MatedNumber, 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 bsimMatingLatExpl <- as.data.frame(modTable3MatingLatExpl) nsimMatingLatExpl <- nrow(bsimMatingLatExpl) # Calculating beta values apply(bsimMatingLatExpl, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimMatingLatExpl, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 0.51 (-0.24, 1.30) # Lat Expl. Male -0.08 (-1.05, 0.93) # Lat Expl. Fem 0.50 (-0.27, 1.33) # Expl(m):Expl(f) 0.42 (-0.47, 1.52) ## Male or female exploration did not influence mating success. ################################## # Exploration: Latency to acceptance (n = 38; non-accepted males have a latency of 2700sec after which the trial was terminated) modTable3AcceptLatExplLat <- stan_glm(LatencyToAcceptanceFirst ~ scale(MeanLatencyExplorationMale) * scale(MeanLatencyExplorationFem), data = dataMrem1, family = Gamma(link = "log"), iter = 10000) ### Checking model assumptions #### Residuals plot -> fine ggqqplot(resid(modTable3AcceptLatExplAS, type='deviance')) #### Residuals vs test variable -> all fine scatter.smooth(dataMrem1$AggressionMeanMale, resid(modTable3AcceptLatExplLat), main="Mean male aggression", xlab="Mean male aggression") scatter.smooth(dataMrem1$AggressionMeanFemale, resid(modTable3AcceptLatExplLat), main="Mean female aggression", xlab="Mean female aggression") #### Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero scatter.smooth(fitted(modTable3AcceptLatExplLat),resid(modTable3AcceptLatExplLat)); abline(h=0, lty=2) #### Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3AcceptLatExplLat) # Time/location correlationlation |acf assumes row number = time acf(resid(modTable3AcceptLatExplLat)) # -> all good #### Drawing conclusions bsimAcceptLatExplLat <- as.data.frame(modTable3AcceptLatExplLat) nsimAcceptLatExplLat <- nrow(bsimAcceptLatExplLat) # Calculating beta values apply(bsimAcceptLatExplLat, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimAcceptLatExplLat, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 7.24 ( 6.91, 7.60) # Exploration Male 0.19 (-0.19, 0.64) # Exploration Fem -0.05 (-0.38, 0.29) # Expl(m):Expl(f) -0.12 (-0.47, 0.25) ## Male or female exploration did not influence latency to mate acceptance. ################################## # Exploration: Mating duration modTable3MateDurExplLat <- stan_glm(DurationMatingTotal ~ scale(MeanLatencyExplorationMale) * scale(MeanLatencyExplorationFem), data = dataMated, family = Gamma(link = "log"), iter = 10000, adapt_delta = 0.99) ### Checking model assumptions #### Residuals plot -> fine ggqqplot(resid(modTable3MateDurExplAS, type='deviance')) #### Residuals vs test variable -> all fine scatter.smooth(dataMated$ExplorationMeanMale, resid(modTable3MateDurExplAS), main="Mean male aggression", xlab="Mean male aggression") scatter.smooth(dataMated$ExplorationMeanFemale, resid(modTable3MateDurExplAS), main="Mean female aggression", xlab="Mean female aggression") #### Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero scatter.smooth(fitted(modTable3MateDurExplAS),resid(modTable3MateDurExplAS)); abline(h=0, lty=2) #### Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3MateDurExplAS) # Time/location correlationlation |acf assumes row number = time acf(resid(modTable3MateDurExplAS)) # -> all good #### Drawing conclusions bsimMateDurExplLat <- as.data.frame(modTable3MateDurExplLat) nsimMateDurExplLat <- nrow(bsimMateDurExplLat) # Calculating beta values apply(bsimMateDurExplLat, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimMateDurExplLat, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 7.65 ( 7.21, 8.17) # Exploration Male -0.11 (-0.77, 0.74) # Exploration Fem 0.10 (-0.38, 0.56) # Expl(m):Expl(f) -0.10 (-0.84, 0.59) ## Male or female exploration at trial start did not affect mating duration. ################################## # Table 3 c) Aggressiveness # Mating success (i.e. pedipalp insertions observed) n = 38 modTable3MatingAgg <- stan_glm(Mated ~ AggressionMeanMale * AggressionMeanFemale, data = dataMrem1, family = "binomial", iter = 10000) ### Checking model assumptions #### Residuals plot -> fine ggqqplot(resid(modTable3MatingAgg, type='deviance')) #### Residuals vs test variable -> all fine scatter.smooth(dataMrem1$AggressionMeanMale, resid(modTable3MatingAgg), main="Mean male aggression", xlab="Mean male aggression") scatter.smooth(dataMrem1$AggressionMeanFemale, resid(modTable3MatingAgg), main="Mean female aggression", xlab="Mean female aggression") #### Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero scatter.smooth(fitted(modTable3MatingAgg),resid(modTable3MatingAgg)); abline(h=0, lty=2) #### Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3MatingAgg) # Time/location correlationlation |acf assumes row number = time acf(resid(modTable3MatingAgg)) # -> all good #### Comparison fitted values vs. data # goodness of fit graph dataMrem1[,"MatedNumber"] <- dataMrem1[,"Mated"] dataMrem1[,"MatedNumber"] <- as.numeric(dataMrem1[,"Mated"]) dataMrem1$MatedNumber[dataMrem1$Mated=="No"] <- 0 dataMrem1$MatedNumber[dataMrem1$Mated=="Yes"] <- 1 plot(fitted(modTable3MatingAgg), jitter(dataMrem1$MatedNumber, amount=0.05), xlab="Fitted values", ylab="Probability of mating", las=1, cex.lab=1.2, cex=0.8) abline(0,1,lty=3) t.breaks <- cut(fitted(modTable3MatingAgg), seq(0,1, by=0.1)) means <- tapply(dataMrem1$MatedNumber, t.breaks, mean) semean <- function(x) sd(x)/sqrt(length(x)) means.se <- tapply(dataMrem1$MatedNumber, 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 bsimMatingAgg <- as.data.frame(modTable3MatingAgg) nsimMatingAgg <- nrow(bsimMatingAgg) # Calculating beta values apply(bsimMatingAgg, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimMatingAgg, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 7.51 ( 0.18, 15.16) # Aggression Male -1.91 (-3.86, -0.03) * # Aggression Fem -1.62 (-3.38, 0.21) # Agg(m):Agg(f) 0.45 (-0.04, 0.93) ## Male aggressiveness reduced mating success. ################################## ### Aggressiveness: Latency to mate acceptance (n = 38; non-accepted males have a latency of 2700sec after which the trial was terminated) modTable3LatAcceptAgg <- stan_glm(LatencyToAcceptanceFirst ~ AggressionMeanMale * AggressionMeanFemale, data = dataMrem1, family = Gamma(link = "log"), iter = 10000) ### Checking model assumptions #### Residuals plot -> fine ggqqplot(resid(modTable3LatAcceptAgg, type='deviance')) #### Residuals vs test variable -> all fine scatter.smooth(dataMrem1$AggressionMeanMale, resid(modTable3LatAcceptAgg), main="Mean male aggression", xlab="Mean male aggression") scatter.smooth(dataMrem1$AggressionMeanFemale, resid(modTable3LatAcceptAgg), main="Mean female aggression", xlab="Mean female aggression") #### Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero scatter.smooth(fitted(modTable3LatAcceptAgg),resid(modTable3LatAcceptAgg)); abline(h=0, lty=2) #### Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3LatAcceptAgg) # Time/location correlationlation |acf assumes row number = time acf(resid(modTable3LatAcceptAgg)) # -> all good #### Drawing conclusions bsimAcceptLatAgg <- as.data.frame(modTable3LatAcceptAgg) nsimAcceptLatAgg <- nrow(bsimAcceptLatAgg) # Calculating beta values apply(bsimAcceptLatAgg, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimAcceptLatAgg, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 5.88 ( 2.04, 9.74) # Aggression Male 0.48 (-0.50, 1.53) # Aggression Fem 0.32 (-0.66, 1.32) # Agg(m):Agg(f) -0.12 (-0.40, 0.14) ## Male or female aggressiveness did not influence latency to mate acceptance. ################################## ### Aggressiveness: Mating duration ### Reduced dataset - Only mated animals modTable3MateDurAgg <- stan_glm(DurationMatingTotal ~ AggressionMeanMale * AggressionMeanFemale, data = dataMated, family = Gamma(link = "log"), iter = 10000) ### Checking model assumptions #### Residuals plot -> fine ggqqplot(resid(modTable3MateDurAgg, type='deviance')) #### Residuals vs test variable -> all fine scatter.smooth(dataMated$AggressionMeanMale, resid(modTable3MateDurAgg), main="Mean male aggression", xlab="Mean male aggression") scatter.smooth(dataMated$AggressionMeanFemale, resid(modTable3MateDurAgg), main="Mean female aggression", xlab="Mean female aggression") #### Residuals vs. fitted values (Tukey-Anscombe plot) # Mean should be around zero scatter.smooth(fitted(modTable3MateDurAgg),resid(modTable3MateDurAgg)); abline(h=0, lty=2) #### Check for overdispersion should be close to 1.00 # residual deviance / residual degrees of freedom #launch_shinystan(modTable3MateDurAgg) # Time/location correlationlation |acf assumes row number = time acf(resid(modTable3MateDurAgg)) # -> all good #### Drawing conclusions bsimMateDurAgg <- as.data.frame(modTable3MateDurAgg) nsimMateDurAgg <- nrow(bsimMateDurAgg) # Calculating beta values apply(bsimMateDurAgg, 2, mean)[c(1:4)] # Calculating credible intervals apply(bsimMateDurAgg, 2, quantile, prob=c(0.025, 0.975))[,c(1:4)] # Results # Intercept 5.32 (-0.14, 11.27) # Aggression Male -0.01 (-1.67, 1.53) # Aggression Fem 0.75 (-0.80, 2.22) # Agg(m):Agg(f) -0.05 (-0.46, 0.37) ## Male or female aggressiveness did not influence latency to mate acceptance. ################################## ### Figure 2 # Generate data for the effect plot # Define a sequence of values for each predictor to create the grid male_vals <- seq(min(dataMated$MeanExplorationASMale), max(dataMated$MeanExplorationASMale), length.out = 100) female_vals <- seq(min(dataMated$MeanExplorationASFem), max(dataMated$MeanExplorationASFem), length.out = 100) # Create a grid for the interaction term newDat <- expand.grid(MeanExplorationASMale = male_vals, MeanExplorationASFem = female_vals) bsimMateDurExplAS Xmat <- model.matrix(~ MeanExplorationASMale * MeanExplorationASFem, data=newDat) b <- as.numeric(apply(bsimMateDurExplAS, 2, mean)[1:ncol(Xmat)]) newDat$fit <- exp(Xmat %*% b) fitmat <- matrix(ncol=nsimMateDurExplAS, nrow=nrow(newDat)) for(i in 1:nsimMateDurExplAS) fitmat[,i] <- exp(Xmat %*% as.numeric(bsimMateDurExplAS[i, 1:ncol(Xmat)])) newDat$lwr <- apply(fitmat, 1, quantile, prob=0.025) newDat$upr <- apply(fitmat, 1, quantile, prob=0.975) ### Interaction plot for males x females filtered_dataF <- newDat %>% filter(MeanExplorationASFem == min(MeanExplorationASFem) | MeanExplorationASFem == max(MeanExplorationASFem)) plotA <- ggplot(filtered_dataF, aes(x = MeanExplorationASMale, y = fit, color = as.factor(MeanExplorationASFem), group = MeanExplorationASFem)) + geom_line(linewidth = 1) + scale_y_continuous(limits=c(0, 6000), expand = c(0,0))+ scale_x_continuous(limits=c(0.0, 1.03), breaks = seq(0.0, 1.00, 0.25), expand = c(0,0))+ labs(x = "mean male exploration score", y = "predicted mating duration [sec]", color = "female exploration\n score") + theme_light(base_size=18)+ theme( legend.title = element_text(size = 13.5), legend.position = "inside", legend.position.inside = c(0.99, 0.99), legend.justification = c("right", "top"), legend.box.just = "right", legend.margin = margin(6, 6, 6, 6))+ scale_color_manual(values = c("grey80", "grey40")) ### Interaction plot for females x males # Include data with max and min values for male exploration score filtered_dataM <- newDat %>% filter(MeanExplorationASMale == min(MeanExplorationASMale) | MeanExplorationASMale == max(MeanExplorationASMale)) plotB <-ggplot(filtered_dataM, aes(x = MeanExplorationASFem, y = fit, color = as.factor(MeanExplorationASMale), group = MeanExplorationASMale)) + geom_line(linewidth = 1) + scale_y_continuous(limits=c(0, 6000), expand = c(0,0))+ scale_x_continuous(limits=c(0.0, 1.03), breaks = seq(0.0, 1.00, 0.25), expand = c(0,0))+ labs(x = "mean female exploration score", y = "predicted mating duration", color = "male exploration\n score") + theme_light(base_size=18)+ theme( legend.title = element_text(size = 13.5), legend.position = "inside", legend.position.inside = c(0.99, 0.99), legend.justification = c("right", "top"), legend.box.just = "right", legend.margin = margin(6, 6, 6, 6))+ scale_color_manual(values = c("grey80", "grey40")) # Combine them side by side ggarrange(plotA, NULL, plotB + rremove("ylab") + rremove("ylab"), font.label = list(size = 14, color = "black", face = "bold", family = NULL, position = "top"), widths = c(1, 0.05, 1), labels = c("A", "", "B"), hjust = c(-0.5, -0.5, 0.8), ncol = 3)