# Code for the statistical testing completed in:
# Variation of vibratory performance during courtship of a cursorial spider
### Morgan M. Oberweiser, Anne G. Hertel, Monika J.B. Eberhard

setwd(".../Oberweiser_OnlineResource2")

# load packages
library(dplyr); library(brms); library(parallel); library(ggplot2); library(tidyverse); library(tidybayes); library(coda)

# Set the number of cores for parallel processing to the number of available CPU cores
options(mc.cores = parallel::detectCores())

# load data
vib <- read.csv("Oberweiser_revised dataset.csv")

# regard "individual" as a factor
vib$ind <- factor(vib$ind)

# organize data by individual
vib_ind <- vib %>% 
  select(ind, age, wt) %>% 
  distinct()
# the dataframe "vib_ind" now contains only individual-specific information
# in this dataframe there are 149 rows, giving basic information for each of the 149 individuals tested

# organize data by trial
vib_tr <- vib %>% 
  select(trialID, ind, call.dur, pulse.rt, age, wt) %>% 
  distinct()
# the dataframe "vib_tr" now contains only trial-specific information
# in this dataframe there are 446 rows, including 3 trials for each of the 149 individuals tested



#############################################################################
## PART 1/3 #################################################################
## SUMMARY STATISTICS #######################################################

#---------------------------------------------------------------------------#
### Individual-based summary stats #
# age
range(vib_ind$age) # spiders were tested between the ages of 13 and 20 days
mean(vib_ind$age) # the mean age at which a spider was tested was 16.18121 days
sd(vib_ind$age) # the standard deviation of the age at which a spider was tested was 1.892566 days
# weight
range(vib_ind$wt) # spiders tested weighed between 0.0526 and 0.1492 grams
mean(vib_ind$wt) # the mean weight of a spider measured 0.08937181 grams
sd(vib_ind$wt) # the standard deviation of the spiders' weights was 0.01566839 grams


#---------------------------------------------------------------------------#
### Trial-based summary stats #
# calling duration
mean(vib_tr$call.dur) # the mean calling duration between all trials was 94.12884 seconds
sd(vib_tr$call.dur) # the standard deviation of calling duration was 54.76744 seconds
# pulse rate
mean(vib_tr$pulse.rt) # the mean pulse rate between all trials was 1.561493 pulses/second
sd(vib_tr$pulse.rt) # the standard deviation of the pulse rate was 0.09146799 pulses/second


#---------------------------------------------------------------------------#
### Pulse-based summary stats #
# pulse interval
mean(vib$interval) # the overall mean pulse interval was 0.6382198 seconds
sd(vib$interval) # the standard deviation between all pulse intervals was 0.08786103 seconds
# coefficient of variation 
##### overall
(sd(vib$interval))/(mean(vib$interval)) # the overall CV of pulse intervals is 0.1376658
##### within-individual
vib %>%
  group_by(ind) %>%
  summarise(cv = sd(interval, na.rm = TRUE) / mean(interval, na.rm = TRUE)) %>%
  summarise(average_cv = mean(cv, na.rm = TRUE)) %>%
  pull(average_cv) # the mean CV of pulse intervals per individual is 0.1312114 











#############################################################################
## PART 2/3 #################################################################
## MULTIVARIATE MIXED EFFECTS MODEL #########################################
## ON CALLING DURATION AND PULSE RATE #######################################

#---------------------------------------------------------------------------#
### Fit and check model #

# Standardize 'call.dur' and store the result in 's.Duration'
s.Duration <- scale(vib_tr$call.dur)
# Standardize 'pulse.rt' and store the result in 's.Int'
s.Pulserate <- scale(vib_tr$pulse.rt)
# Standardize 'call.dur' and store in a new column 's.Duration' in 'vib_tr'
vib_tr$s.Duration <- scale(vib_tr$call.dur)
# Standardize 'pulse.rt' and store in a new column 's.Pulserate' in 'vib_tr'
vib_tr$s.Pulserate <- scale(vib_tr$pulse.rt)



# Fit the multivariate model using the 'brm' function from the 'brms' package
m_multi <- brm(
  mvbind(scale(call.dur), scale(pulse.rt)) ~   # Response variables: standardize 'call.dur' and 'pulse.rt'
    age + wt + (1|p|ind),  # Fixed effects: 'age' and 'wt'; random intercepts for 'ind' with a grouping factor 'p'
  data = vib_tr,  # Data used for the model (vib_tr data frame)
  family = "gaussian",  # Assumes a Gaussian (normal) distribution for the responses
  warmup = 2000,  # Number of warmup (burn-in) iterations before sampling starts
  iter = 4000,    # Total number of iterations (including warmup)
  thin = 2,       # Thinning rate (only every 2nd sample is retained)
  chains = 4,     # Number of Markov chains to run in parallel
  inits = "random",  # Initialize model parameters randomly
  seed = 12345,   # Set seed for reproducibility
  cores = 4       # Number of CPU cores to use for parallel processing
)

# Save the model output as an .rds file
saveRDS(m_multi,"VibrationMultivariate.rds")

# In cases where you don't wish to run the entire model, load in the .rds file of model output
m_multi <- readRDS("VibrationMultivariate.rds")



# Perform posterior predictive checks on the model 'm_multi' for the response variable 'scalecalldur'
pp_check(m_multi, resp = "scalecalldur")+ 
  theme_bw(base_size = 20)
# Perform posterior predictive checks on the model 'm_multi' for the response variable 'scaleintrt'
pp_check(m_multi, resp = "scalepulsert")+ 
  theme_bw(base_size = 20)



# Summarize the model output
summary(m_multi)


#---------------------------------------------------------------------------#
### Calculate repeatability and correlation #


# Repeatability of calling duration 

# Extract the variance component for individual variation in calling duration
var.call.dur <- as_draws_df(m_multi)$"sd_ind__scalecalldur_Intercept"^2
# Extract the residual variance component (unexplained by individual differences) for calling duration
var.res.call.dur <- as_draws_df(m_multi)$"sigma_scalecalldur"^2
# Calculate the repeatability (R) as the proportion of variance explained by individuals
RDur <- var.call.dur / (var.call.dur + var.res.call.dur)
# Calculate and print the mean of the repeatability of calling duration
mean(RDur) #0.4508639
# Calculate and print the 95% highest posterior density (HPD) interval for the repeatability of calling duration
HPDinterval(as.mcmc(RDur), 0.95) #0.3489067 0.5455148
# Interpretation:
# 0.45 [0.35, 0.55] means that 45% of the variability in calling duration can be attributed to individual differences



# Repeatability of pulse rate 

# Extract the variance component for individual variation in pulse rate
var.pulse.rt <- as_draws_df(m_multi)$"sd_ind__scalepulsert_Intercept"^2
# Extract the residual variance component (unexplained by individual differences) for pulse rate
var.res.pulse.rt <- as_draws_df(m_multi)$"sigma_scalepulsert"^2
# Calculate the repeatability (R) for pulse rate as the proportion of variance explained by individuals
RRate <- var.pulse.rt / (var.pulse.rt + var.res.pulse.rt)
# Calculate and print the mean of the repeatability of pulse rate
mean(RRate) #0.5326575
# Calculate and print the 95% HPD interval for the repeatability of pulse rate
HPDinterval(as.mcmc(RRate), 0.95) #0.4420254 0.6243828
# Interpretation:
# 0.53 [0.44, 0.62] means that 53% of the variability in pulse rate can be explained by consistent individual differences


# The repeatability for both calling duration and pulse rate are relatively high, indicating significant individual differences



# Correlation of calling duration and pulse rate at the individual level

# Extract the posterior samples for the correlation between individual intercepts of calling duration and pulse rate
COR <- as_draws_df(m_multi)$"cor_ind__scalecalldur_Intercept__scalepulsert_Intercept"
# Calculate and print the mean of the correlation between calling duration and pulse rate
mean(COR) #0.1425944
# Calculate and print the 95% HPD interval for the correlation between calling duration and pulse rate
HPDinterval(as.mcmc(COR)) #-0.08273297 0.3615889
# Interpretation:
# The correlation is not statistically significant, indicating little to no relationship between 
# calling duration and pulse rate at the individual level.


#---------------------------------------------------------------------------#
## Estimate individual behavioral types - calling duration #

# Extract posterior samples from the fitted model 'm_multi' and reshape the data
BT_Duration <- as_draws_df(m_multi) %>%
  tidyr::pivot_longer(  # Reshape posterior samples to long format
    cols = starts_with("r_ind__scalecalldur"),  # Select individual-specific intercepts
    names_to = "ind",  # Store column names (individual IDs) in 'ind'
    values_to = "value"  # Store posterior sample values in 'value'
  ) %>%
  select(ind, value) %>%  # Keep 'ind' and 'value' columns
  separate(ind,  # Split 'ind' to extract individual ID 
           c(NA, NA, NA, NA, "ind", NA, NA),  # Extract ID into 'ind'
           sep = "([\\__\\[\\,])",  # Split based on underscores/brackets
           fill = "right")  # Fill missing parts with NA 

# Now, calculate individual-level summary statistics: mean and confidence intervals (95%) for calling duration
BT_Duration <- BT_Duration %>% 
  group_by(ind) %>%  
  mutate(MeanDur = mean(value),  # Calculate mean for each individual
         UpDur = mean(value) + 1.96 * sd(value),  # 95% upper CI 
         LoDur = mean(value) - 1.96 * sd(value)) %>%  # 95% lower CI
  ungroup()  # Ungroup after calculations

# Calculate the range of mean calling durations across individuals
range(BT_Duration[!duplicated(BT_Duration$ind),"MeanDur"])
# -1.24 to 1.43 = Range of scaled individual means (without global intercept)

# Back-transform to original calling duration scale
BT_Duration_back <- BT_Duration %>%
  mutate(value_back = value + fixef(m_multi, pars = "scalecalldur_Intercept")[1]) %>%  # Add population intercept
  mutate(value_back = (value_back * attr(s.Duration, 'scaled:scale')) + attr(s.Duration, 'scaled:center')) %>%  # Rescale to original scale
  group_by(ind) %>%  
  mutate(MeanDur_back = mean(value_back))  # Calculate mean on original scale

range(BT_Duration_back$MeanDur_back)
# -41.6 to 104.77 = Range of back-transformed means (original calling duration scale)
# We get a negative estimate of calling duration, which is biologically impossible. 
# This happens because the Gaussian distribution used in the model is not constrained to values > 0. 


#---------------------------------------------------------------------------#
## Estimate individual behavioral types - pulse rate #

# Extract posterior samples from the fitted model 'm_multi' and reshape the data
BT_Pulserate <- as_draws_df(m_multi) %>%
  tidyr::pivot_longer(  # Reshape posterior samples to long format
    cols = starts_with("r_ind__scalepulsert"),  # Select individual-specific intercepts
    names_to = "ind",  # Store column names (individual IDs) in 'ind'
    values_to = "value"  # Store posterior sample values in 'value'
  ) %>%
  select(ind, value) %>%  # Keep 'ind' and 'value' columns
  separate(ind,  # Split 'ind' to extract individual ID
           c(NA, NA, NA, NA, "ind", NA, NA),  # Extract ID into 'ind'
           sep = "([\\__\\[\\,])",  # Split based on underscores/brackets
           fill = "right")  # Fill missing parts with NA

# Now, calculate individual-level summary statistics: mean and confidence intervals (95%) for pulse rate
BT_Pulserate <- BT_Pulserate %>% 
  group_by(ind) %>%
  mutate(MeanPulserate = mean(value),  # Calculate mean for each individual
         UpPulserate = mean(value) + 1.96 * sd(value),  # 95% upper CI
         LoPulserate = mean(value) - 1.96 * sd(value)) %>%  # 95% lower CI
  ungroup()  # Ungroup after calculations

# Calculate the range of mean pulse rate across individuals
range(BT_Pulserate[!duplicated(BT_Pulserate$ind), "MeanPulserate"])  
# -1.34 - 1.81 = Range of scaled individual means (without global intercept)

# Back-transform to original pulse rate scale
BT_Pulserate_back <- BT_Pulserate %>%
  mutate(value_back = value + fixef(m_multi, pars = "scalepulsert_Intercept")[1]) %>%  # Add population intercept
  mutate(value_back = (value_back * attr(s.Pulserate, 'scaled:scale')) + attr(s.Pulserate, 'scaled:center')) %>%  # Rescale to original scale
  group_by(ind) %>%
  mutate(MeanPulserate_back = mean(value_back))  # Calculate mean on original scale

range(BT_Pulserate_back$MeanPulserate_back)  
# 1.69 - 1.98 = Range of back-transformed means (original pulse rate scale)











#############################################################################
## PART 3/3 #################################################################
## DOUBLE HIERARCHICAL MIXED EFFECTS MODEL ##################################
## ON PULSE INTERVAL ########################################################

#---------------------------------------------------------------------------#
### Fit and check model #


# Define the model formula for the interval and sigma (standard deviation) components
m.interval = bf(interval ~  # Model the 'interval' variable (dependent variable)
                  age + wt +  # Include age and weight as fixed effects
                  (1|a|ind) +  # Random intercept for 'ind' (individual) nested within 'a'
                  (1|b|trialID),  # Random intercept for 'trialID' nested within 'b'
                sigma ~ age + wt + (1|a|ind) + (1|b|trialID))  # Model the variability (sigma) with age, weight, and random effects

# Fit the model using Bayesian regression (brm function from the 'brms' package)
# This model takes several hours to run
intervalDHGLM <- brm(m.interval,  # Fit the model defined in 'm.interval'
                     data = vib,  # Use the 'vib' dataset
                     chains = 4,  # Run 4 Markov Chains for sampling
                     cores = 4,  # Use 4 CPU cores to parallelize the sampling
                     seed = 12345)  # Set the random seed for reproducibility


# Save the model output as an .rds file
saveRDS(intervalDHGLM,"VibrationDHGLM_2025.rds")

# In cases where you don't wish to run the entire model, load in the .rds file of model output
intervalDHGLM <- readRDS("VibrationDHGLM_2025.rds")

# Perform a posterior predictive check on the model 'intervalDHGLM' and apply a theme for visualization
pp_check(intervalDHGLM) + 
  theme_bw(base_size = 20)  

# Perform a posterior predictive check with 1000 samples, visualizing the result as a 2D statistic plot
pp_check(intervalDHGLM, 
         nsamples = 1e3,  # Use 1000 samples for the check
         type = "stat_2d") +  
  theme_bw(base_size = 20)  


#summarize the model output
summary(intervalDHGLM)



#---------------------------------------------------------------------------#
### Calculate repeatability and correlation #


# Extract variance components from the posterior samples of the 'intervalDHGLM' model
# These components represent different sources of variability in the data

# Variance due to individual differences (random intercept for individuals)
var.ind <- posterior_samples(intervalDHGLM)$"sd_ind__Intercept"^2

# Variance due to trial ID (random intercept for trial-specific effects)
var.trailID <- posterior_samples(intervalDHGLM)$"sd_trialID__Intercept"^2

# Residual variance (unexplained variability in the model)
var.res <- exp(posterior_samples(intervalDHGLM)$"b_sigma_Intercept")^2


# Long-term (across trials) individual differences in mean interval length
# This calculates the proportion of variance explained by individual differences across trials.
R.long <- var.ind / 
  (var.ind + var.trailID + var.res)  # Total variance is the sum of individual, trial ID, and residual variance
mean(R.long)  # Compute the mean proportion of variance explained by individual differences
HPDinterval(as.mcmc(R.long), 0.95)  # Calculate the 95% Highest Posterior Density (HPD) interval for the proportion

# Interpretation:
# R.long = 0.09 [0.05, 0.14]
# 9% of the variability in vibration intervals can be explained by individual differences across trials.
# This suggests that individual differences contribute moderately to the variability.

# Short-term (within trial) individual differences in mean interval length
# This calculates the proportion of variance explained by individual differences and trial-to-trial consistency.
R.short <- (var.ind + var.trailID) / 
  (var.ind + var.trailID + var.res)  # Total variance includes individual, trial ID, and residual variance
mean(R.short)  # Compute the mean proportion of variance explained by individual differences and trial-to-trial consistency
HPDinterval(as.mcmc(R.short), 0.95)  # Calculate the 95% HPD interval for the proportion

# Interpretation:
# R.short = 0.12 [0.07, 0.19]
# 12% of the variability in vibration intervals can be explained by consistency within trials.
# This indicates that within-trial consistency contributes moderately to the variability.

# Long-term (across trial) stability/predictability in interval length
# Compute the residual variance for individual differences (after accounting for the model’s fixed effects)
residual.variance.ind <- exp(posterior_samples(intervalDHGLM)$"sd_ind__sigma_Intercept"^2)
CVP.ind <- sqrt(residual.variance.ind - 1)  # Coefficient of Variation of Predictability (CVP) for individual differences

mean(CVP.ind)  # 0.114388 = mean CVP for individual differences across trials
HPDinterval(as.mcmc(CVP.ind), 0.95)  # 0.09344481 - 0.1374936 = 95% HPD interval for the CVP

# Short-term (within trial) stability/predictability in interval length
# Compute the residual variance for trial ID (within-trial variability after accounting for the model’s fixed effects)
residual.variance.trial <- exp(posterior_samples(intervalDHGLM)$"sd_trialID__sigma_Intercept"^2)
CVP.trial <- sqrt(residual.variance.trial - 1)  # Coefficient of Variation of Predictability (CVP) for trial-to-trial consistency

mean(CVP.trial)  # 0.1279971 = mean CVP for within-trial consistency
HPDinterval(as.mcmc(CVP.trial), 0.95)  # 0.1153992 - 0.1428544 = 95% HPD interval for the CVP



# Correlation of mean and variance 
# Extract posterior samples for the correlation parameters between individual intercepts and sigma (residual variability)
COR.PERS.PRED <- 
  posterior_samples(intervalDHGLM, 
                    pars = c("cor_ind__Intercept__sigma_Intercept",
                             "cor_trialID__Intercept__sigma_Intercept")) %>%
  gather() %>%  # Reshape the data into a long format
  separate(key,
           c(NA, "Scale", NA, NA, NA),  # Split the key column into useful parts (e.g., individual or trial)
           sep = "([\\_\\__\\__\\_\\,])", fill = "right")  # Use regex to separate the 'key' column

# Plot the correlation values
# Create a plot of the correlation values for mean and predictability, with individual ('ind') and trial ('trialID') effects on the x-axis
COR.PERS.PRED %>%
  ggplot(aes(x = value, y = Scale)) +  # Value is the correlation coefficient, Scale is the type (individual/trial)
  geom_halfeyeh() +  # Create a half-eye plot to visualize the distribution of correlations
  geom_vline(xintercept =  0)  # Add a vertical line at x = 0 to indicate no correlation

# Credible intervals (precision of correlation)
# Compute the mean correlation for the 'ind' scale (individual level)
mean(COR.PERS.PRED[COR.PERS.PRED$Scale == "ind", "value"])  
# Calculate the 95% Highest Posterior Density (HPD) interval for the correlation values at the individual scale
HPDinterval(as.mcmc(COR.PERS.PRED[COR.PERS.PRED$Scale == "ind", "value"]))  

# Interpretation:
# The result shows a correlation of 0.20 with a 95% HPD interval of [-0.01, 0.41]
# We observe a positive correlation between the mean and predictability (individual level).
# The overlap with 0 suggests that this correlation is weak and not statistically significant, 
# but still suggests a slight positive trend.




#---------------------------------------------------------------------------#
## Estimate individual behavioral types - pulse interval #


# Extracting posterior samples for 'r_ind' parameters from the intervalDHGLM model
BT_Interval <- posterior_samples(intervalDHGLM, pars = "^r_ind")[1:149] %>%
  tidyr::gather(ind, value, # Reshaping the data from wide to long format by gathering 'r_ind' variables 
                "r_ind[2,Intercept]" : "r_ind[444,Intercept]") %>%
  mutate(value = value + fixef(intervalDHGLM, pars = "Intercept")[1]) %>%   # Adding the fixed effect for the Intercept to the sampled values
  select(ind, value) %>%   # Selecting only the columns 'ind' and 'value' 
  separate(ind,   # Splitting the 'ind' column to separate the index components and clean the data
           c(NA, NA, "ind", NA), 
           sep = "([\\_\\[\\,])", fill = "right")

# Now processing the data to calculate the mean, upper (95% CI) and lower (95% CI) bounds
BT_Interval  <- BT_Interval %>% 
  group_by(ind) %>%
  mutate(Mean = mean(value),
         Up = mean(value) + 1.96 * sd(value),
         Lo = mean(value) - 1.96 * sd(value)) %>%
  ungroup()

# Checking the range of the means for the unique parameter names (ind)
range(BT_Interval[!duplicated(BT_Interval$ind), "Mean"])
# 0.47 - 0.6 = range of mean values





#---------------------------------------------------------------------------#
## Estimate individual predictability - pulse interval #


# Extracting posterior samples for 'r_ind__sigma' parameters from the intervalDHGLM model
Pred_Interval <- posterior_samples(intervalDHGLM, pars = "^r_ind__sigma")[1:149] %>%
  tidyr::gather(ind, value,  # Reshaping the data from wide to long format by gathering 'r_ind__sigma' variables
                "r_ind__sigma[2,Intercept]" : "r_ind__sigma[444,Intercept]") %>%
  mutate(value = value + fixef(intervalDHGLM, pars = "sigma_Intercept")[1]) %>%    # Adding the fixed effect for 'sigma_Intercept' to the sampled values 
  select(ind, value) %>%  # Selecting only the columns 'ind' and 'value' 
  separate(ind,  # Splitting the 'ind' column into separate components to clean up the parameter names
           c(NA, NA, NA, NA, "ind", NA), 
           sep = "([\\_\\__\\[\\,])", fill = "right") %>% 
  mutate(value.exp = exp(value))   # Creating a new column 'value.exp' which stores the exponentiated values of 'value'

# Now processing the data to calculate the mean, upper (95% CI), and lower (95% CI) bounds
Pred_Interval  <- Pred_Interval %>% 
  group_by(ind) %>%
  mutate(Mean = mean(value.exp),
         Up = mean(value.exp) + 1.96 * sd(value.exp),
         Lo = mean(value.exp) - 1.96 * sd(value.exp)) %>%
  ungroup()

# Checking the range of the means for the unique parameter names (ind)
range(Pred_Interval[!duplicated(Pred_Interval$ind), "Mean"])
# 0.07 - 0.11 = range of mean predictability values