############################################################
# Title: Song frequency affects territorial response in the
#        Emerald-spotted Wood-Dove Turtur chalcospilos
#
# Journal: Behavioral Ecology and Sociobiology
#
# Authors:
# Lia Zampa, Tomasz Stanisław Osiejuk, Małgorzata Niśkiewicz, Paweł Szymański


# Affiliation: 
# Department of Behavioural Ecology, Institute of Environmental Biology, Faculty of Biology, Adam Mickiewicz University in Poznań, Uniwersytetu Poznańskiego 6, 61-614 Poznań, Poland. 

#
# Corresponding author:
#Lia Zampa
#Email: liazam@amu.edu.pl

#Tomasz Stanisław Osiejuk 
#Email: osiejuk@amu.edu.pl

## This script reproduces all statistical analyses presented in the manuscript

# Load packages
packages <- c("smatr", "reshape2", "ggplot2", "stats", "tidyverse", "car",
              "fitdistrplus", "Hmisc", "lme4", "glmmTMB", "DHARMa", "jtools",
              "mgcv", "corrplot", "psych", "FactoMineR", "factoextra",
              "tidyr", "dplyr", "readxl")

invisible(lapply(packages, require, character.only = TRUE))


setwd("") # set working directory where "T.chalcospilos_LowHigh.xlsx" file is present


##### Check summary of frequency for each treatment -------

# Load dataset

data <- read_excel("T.chalcospilos_LowHigh.xlsx", sheet = "Experiment")

# Make treatment a factor
data <- data %>%
  mutate(TREATMENT = factor(TREATMENT, levels = c("low", "high")))

#Leave complete cases

pf_data <- data %>%
  dplyr::select(TREATMENT, PF_FOCAL, PF_PLAY) %>%
  filter(complete.cases(.))


# Function to make summary for each treatment

summarise_pf <- function(df) {
  n <- nrow(df)
  
  # Focal male song
  mean_focal <- mean(df$PF_FOCAL)
  sd_focal   <- sd(df$PF_FOCAL)
  se_focal   <- sd_focal / sqrt(n)
  ci_focal   <- qt(0.975, df = n - 1) * se_focal
  ci_focal_low  <- mean_focal - ci_focal
  ci_focal_high <- mean_focal + ci_focal
  
  # Playback song
  mean_play <- mean(df$PF_PLAY)
  sd_play   <- sd(df$PF_PLAY)
  se_play   <- sd_play / sqrt(n)
  ci_play   <- qt(0.975, df = n - 1) * se_play
  ci_play_low  <- mean_play - ci_play
  ci_play_high <- mean_play + ci_play
  
  # Paired t-test
  tt <- t.test(df$PF_FOCAL, df$PF_PLAY, paired = TRUE)
  
  # Mean difference
  mean_diff <- mean(df$PF_FOCAL - df$PF_PLAY)
  sd_diff   <- sd(df$PF_FOCAL - df$PF_PLAY)
  
  data.frame(
    n = n,
    mean_focal = mean_focal,
    sd_focal = sd_focal,
    ci_focal_low = ci_focal_low,
    ci_focal_high = ci_focal_high,
    mean_play = mean_play,
    sd_play = sd_play,
    ci_play_low = ci_play_low,
    ci_play_high = ci_play_high,
    mean_difference_hz = mean_diff,
    sd_difference_hz = sd_diff,
    t_value = unname(tt$statistic),
    df = unname(tt$parameter),
    p_value = tt$p.value
  )
}

# Run separately for high and low treatment

results_low <- pf_data %>%
  filter(TREATMENT == "low") %>%
  summarise_pf()

results_high <- pf_data %>%
  filter(TREATMENT == "high") %>%
  summarise_pf()


# Print results

print(round(results_low, 2))
print(round(results_high, 2))


##------------ About approching vs non approching models --------
# Load data
data <- read_excel("T.chalcospilos_LowHigh.xlsx", sheet = "Approaching binary")

# Prepare variables

# APPROACHING_BINARY:
#   1  = approached
#   0  = did not approach
#  -1  = retreated / increased distance
#
# For the main chi-square test, I collapse the response into:
#   1 = approach
#   0 = no approach (including retreating males)

data <- data %>%
  mutate(
    TREATMENT = factor(TREATMENT, levels = c("low", "high")),
    APPROACH_BIN = ifelse(APPROACHING_BINARY == 1, 1, 0)
  )


#  % OF APPROACHING / NON-APPROACHING

approach_summary <- data %>%
  group_by(TREATMENT) %>%
  summarise(
    n_total = n(),
    n_approach = sum(APPROACH_BIN == 1, na.rm = TRUE),
    n_no_approach = sum(APPROACH_BIN == 0, na.rm = TRUE),
    perc_approach = 100 * n_approach / n_total,
    perc_no_approach = 100 * n_no_approach / n_total
  )

approach_summary

# YATES-CORRECTED CHI-SQUARE TEST
# chisq.test(..., correct = TRUE) applies Yates correction.

tab_approach <- table(data$TREATMENT, data$APPROACH_BIN)
tab_approach

chi_res <- chisq.test(tab_approach, correct = TRUE)
chi_res


### PCA calculation ----

data <- read_excel("T.chalcospilos_LowHigh.xlsx", sheet = "Experiment")

behav_vars <- c(
  "SONGS_PLAY", "SONGS_POST", "FLIGHTS_PLAY", "FLIGHTS_POST",
  "CLOSEST_DISTANCE", "LATENCY_1ST_FLIGHT", "TIME10M"
)

# Keep only rows with complete behavioural data
data_pca <- data %>%
  filter(complete.cases(across(all_of(behav_vars))))

behav <- data_pca[, behav_vars]

# Correlation matrix, KMO and Bartlett test
R_behav <- cor(behav)
round(R_behav, 2)

KMO(R_behav)

cortest.bartlett(R_behav, n = nrow(behav))

# PCA with varimax rotation
pca_varimax_2 <- principal(
  behav,
  nfactors = 2,
  rotate = "varimax",
  scores = TRUE,
  covar = FALSE
)

# Loadings
loadings_table <- data.frame(
  Behaviour = rownames(unclass(pca_varimax_2$loadings)),
  round(unclass(pca_varimax_2$loadings), 3),
  row.names = NULL
)

loadings_table

# Variance explained
round(pca_varimax_2$Vaccounted, 3)

# Add PCA scores to the same dataset used for PCA
scores_2 <- as.data.frame(pca_varimax_2$scores)
colnames(scores_2) <- c("PC1", "PC2")

data_pca_scores <- cbind(data_pca, scores_2)

# Add log-transformed peak frequencies and frequency difference
data_pca_scores <- data_pca_scores %>%
  mutate(
    TREATMENT = factor(TREATMENT, levels = c("low", "high")),
    YEAR = factor(YEAR),
    logPF_FOCAL = log10(PF_FOCAL),
    logPF_PLAY  = log10(PF_PLAY),
    logPF_DIFF  = logPF_FOCAL - logPF_PLAY
  )

# Save dataset with PCA scores
write.csv(data_pca_scores, "PCA_dataset_clean.csv", row.names = FALSE)


### --------- MODELS PC1 and PC2 ---------
# Load data

data <- read.csv("PCA_dataset_clean.csv")

# PC1
hist(data$PC1)
descdist(data$PC1, discrete = FALSE, boot=100) 

# PC2
hist(data$PC2)
descdist(data$PC2, discrete = FALSE, boot=100) 


## Check differences between years

t.test(PC1 ~ YEAR, data = data)

boxplot(PC1 ~ YEAR, data = data,
        ylab = "PC1", xlab = "Year",
        main = "Behavioural response (PC1) by year")


t.test(PC2 ~ YEAR, data = data)

boxplot(PC2 ~ YEAR, data = data,
        ylab = "PC2", xlab = "Year",
        main = "Behavioural response (PC2) by year")

## PC1 models 

# Treatment-only
m_pc1_treat1 <- lm(PC1 ~ TREATMENT, data = data)
summary(m_pc1_treat1)
simulateResiduals(m_pc1_treat1, plot = TRUE)
t.test(PC1 ~ TREATMENT, data = data)

# ΔPF-only
m_pc1_diff1 <- lm(PC1 ~ logPF_DIFF, data = data)
summary(m_pc1_diff1)
simulateResiduals(m_pc1_diff1, plot = TRUE)


## PC2 models 

# Treatment-only
m_pc2_treat1 <- lm(PC2 ~ TREATMENT, data = data)
summary(m_pc2_treat1)
simulateResiduals(m_pc2_treat1, plot = TRUE)
t.test(PC2 ~ TREATMENT, data = data)

# ΔPF-only
m_pc2_diff1 <- lm(PC2 ~ logPF_DIFF, data = data)
summary(m_pc2_diff1)
simulateResiduals(m_pc2_diff1, plot = TRUE)


### --------- SUPPLEMENTARY MODELS: ORIGINAL BEHAVIOURAL VARIABLES ---------

# These models repeat the same structure used for PC1 and PC2.
# Each behavioural variable is analysed twice:
# 1. with playback treatment as predictor
# 2. with the log-transformed peak-frequency difference as predictor

# Load data

data <- read_excel("T.chalcospilos_LowHigh.xlsx", sheet = "Experiment") %>%
  mutate(
    TREATMENT = factor(TREATMENT, levels = c("low", "high")),
    YEAR = factor(YEAR),
    logPF_FOCAL = log10(PF_FOCAL),
    logPF_PLAY = log10(PF_PLAY),
    logPF_DIFF = logPF_FOCAL - logPF_PLAY,
    log_CLOSEST_DISTANCE = log10(CLOSEST_DISTANCE + 1),
    log_LATENCY = log10(LATENCY_1ST_FLIGHT + 1),
    sqrt_TIME10M = sqrt(TIME10M)
  )


# Check distributions of the original variables

vars_original <- c(
  "CLOSEST_DISTANCE",
  "LATENCY_1ST_FLIGHT",
  "FLIGHTS_PLAY",
  "FLIGHTS_POST",
  "TIME10M"
)

par(mfrow = c(2, 3))
for(v in vars_original) {
  hist(data[[v]], main = v, xlab = v)
}
par(mfrow = c(1, 1))


# Check distributions after transformation

vars_transformed <- c(
  "log_CLOSEST_DISTANCE",
  "log_LATENCY",
  "sqrt_TIME10M"
)

par(mfrow = c(1, 3))
for(v in vars_transformed) {
  hist(data[[v]], main = v, xlab = v)
}
par(mfrow = c(1, 1))


# Closest distance to the speaker

m_dist_treat <- lm(log_CLOSEST_DISTANCE ~ TREATMENT, data = data)
summary(m_dist_treat)
simulateResiduals(m_dist_treat, plot = TRUE)

m_dist_diff <- lm(log_CLOSEST_DISTANCE ~ logPF_DIFF, data = data)
summary(m_dist_diff)
simulateResiduals(m_dist_diff, plot = TRUE)


# Latency to first flight

m_lat_treat <- lm(log_LATENCY ~ TREATMENT, data = data)
summary(m_lat_treat)
simulateResiduals(m_lat_treat, plot = TRUE)

m_lat_diff <- lm(log_LATENCY ~ logPF_DIFF, data = data)
summary(m_lat_diff)
simulateResiduals(m_lat_diff, plot = TRUE)


# Flights during playback

m_flight_play_treat <- glmmTMB(
  FLIGHTS_PLAY ~ TREATMENT,
  family = nbinom2,
  data = data
)

summary(m_flight_play_treat)
simulateResiduals(m_flight_play_treat, plot = TRUE)

m_flight_play_diff <- glmmTMB(
  FLIGHTS_PLAY ~ logPF_DIFF,
  family = nbinom2,
  data = data
)

summary(m_flight_play_diff)
simulateResiduals(m_flight_play_diff, plot = TRUE)


# Flights after playback

m_flight_post_treat <- glmmTMB(
  FLIGHTS_POST ~ TREATMENT,
  family = nbinom2,
  data = data
)

summary(m_flight_post_treat)
simulateResiduals(m_flight_post_treat, plot = TRUE)

m_flight_post_diff <- glmmTMB(
  FLIGHTS_POST ~ logPF_DIFF,
  family = nbinom2,
  data = data
)

summary(m_flight_post_diff)
simulateResiduals(m_flight_post_diff, plot = TRUE)


# Time spent within 10 m of the speaker

m_time_treat <- lm(sqrt_TIME10M ~ TREATMENT, data = data)
summary(m_time_treat)
simulateResiduals(m_time_treat, plot = TRUE)

m_time_diff <- lm(sqrt_TIME10M ~ logPF_DIFF, data = data)
summary(m_time_diff)
simulateResiduals(m_time_diff, plot = TRUE)



### ----------PLOTS -----------

library(ggplot2)
library(patchwork)
library(readxl)
library(dplyr)
library(tidyr)
library(grid)

data <- read_excel("T.chalcospilos_LowHigh.xlsx", sheet = "Experiment") %>%
  mutate(
    TREATMENT = factor(TREATMENT, levels = c("high", "low"))
  )


#### Distribution of focal vs playback peak frequency

freq_long <- data %>%
  dplyr::select(TREATMENT, PF_FOCAL, PF_PLAY) %>%
  tidyr::pivot_longer(
    cols = c(PF_FOCAL, PF_PLAY),
    names_to = "Song_source",
    values_to = "Peak_frequency"
  ) %>%
  dplyr::mutate(
    Song_source = dplyr::case_when(
      Song_source == "PF_FOCAL" ~ "Focal male",
      Song_source == "PF_PLAY"  ~ "Playback stimulus"
    )
  ) %>%
  dplyr::filter(!is.na(Peak_frequency))


## Boxplot 
p_freq <- ggplot(freq_long,
                 aes(x = Song_source,
                     y = Peak_frequency,
                     fill = TREATMENT)) +
  
  geom_boxplot(
    width = 0.45,
    outlier.shape = NA,
    alpha = 0.9,
    colour = "black"
  ) +
  
  geom_point(
    position = position_jitter(width = 0.10),
    size = 2.5,
    shape = 21,
    colour = "black",
    alpha = 0.75
  ) +
  
  facet_wrap(
    ~TREATMENT,
    nrow = 1,
    labeller = as_labeller(c(
      high = "High-frequency playback",
      low  = "Low-frequency playback"
    ))
  ) +
  
  scale_fill_brewer(palette = "Set2") +
  
  labs(
    x = "",
    y = "Peak frequency (Hz)"
  ) +
  
  theme_classic() +
  
  theme(
    legend.position = "none",
    axis.title.y = element_text(size = 18, face = "bold"),
    axis.text.y  = element_text(size = 16),
    axis.text.x  = element_text(size = 15),
    strip.text   = element_text(size = 16, face = "bold"),
    strip.background = element_rect(fill = "white", colour = "black"),
    axis.line    = element_line(colour = "black")
  )

p_freq

ggsave(
  "freq_dist_boxplot.jpg",
  p_freq,
  width = 8,
  height = 4,
  units = "in",
  dpi = 600,
  quality = 100,
  bg = "white"
)

### PC VS TREATMENT

# Load data

data <- read.csv("PCA_dataset_clean.csv")

p_PC1_treat <- ggplot(data, aes(TREATMENT, PC1, fill = TREATMENT)) +
  geom_boxplot(width = 0.45,
               outlier.shape = NA,
               alpha = 0.9,
               colour = "black") +
  geom_point(
    position = position_jitter(width = 0.10),
    size = 2.5,
    shape = 21,
    colour = "black",
    alpha = 0.75
  ) +
  scale_fill_brewer(palette = "Set2") +
  labs(x = "", y = "PC1") +
  theme_classic() +
  theme(
    legend.position = "none",
    axis.title.y = element_text(size = 18, face = "bold"),
    axis.text.y  = element_text(size = 16),
    axis.text.x  = element_text(size = 16),
    axis.line    = element_line(colour = "black")
  ) 

p_PC2_treat <- ggplot(data, aes(TREATMENT, PC2, fill = TREATMENT)) +
  geom_boxplot(width = 0.45,
               outlier.shape = NA,
               alpha = 0.9,
               colour = "black") +
  geom_point(
    position = position_jitter(width = 0.10),
    size = 2.5,
    shape = 21,
    colour = "black",
    alpha = 0.75
  ) +
  scale_fill_brewer(palette = "Set2") +
  labs(x = "", y = "PC2") +
  theme_classic() +
  theme(
    legend.position = "none",
    axis.title.y = element_text(size = 18, face = "bold"),
    axis.text.y  = element_text(size = 16),
    axis.text.x  = element_text(size = 16),
    axis.line    = element_line(colour = "black")
  ) 

fig_PC_treat <- p_PC1_treat | p_PC2_treat
fig_PC_treat

ggsave(
  "RC_treatment_plot.jpg",
  fig_PC_treat,
  width = 8,
  height = 4,
  units = "in",
  dpi = 600,
  quality = 100,
  bg = "white"
)


### PC VS DELTA PF

delta_lab <- "Playback higher PF  \u2190  \u0394PF = 0  \u2192  Playback lower PF"

p_PC1_diff_tr <- ggplot(data, aes(x = logPF_DIFF, y = PC1)) +
  geom_point(
    size = 2.5,
    alpha = 0.80,
    colour = "grey20"
  ) +
  geom_smooth(
    method = "lm",
    formula = y ~ x,
    se = TRUE,
    linewidth = 1
  ) +
  labs(
    x = delta_lab,
    y = "PC1 \u2013 Approaching"
  ) +
  theme_classic() +
  theme(
    axis.title.x = element_text(
      size = 15,
      face = "bold",
      margin = margin(t = 12)
    ),
    axis.title.y = element_text(
      size = 15,
      face = "bold",
      margin = margin(r = 12)
    ),
    axis.text = element_text(size = 13),
    axis.line = element_line(colour = "black"),
    plot.margin = margin(5, 8, 5, 5)
  )

p_PC2_diff_tr <- ggplot(data, aes(x = logPF_DIFF, y = PC2)) +
  geom_point(
    size = 2.5,
    alpha = 0.80,
    colour = "grey20"
  ) +
  geom_smooth(
    method = "lm",
    formula = y ~ x,
    se = TRUE,
    linewidth = 1
  ) +
  labs(
    x = delta_lab,
    y = "PC2 \u2013 Vocal response"
  ) +
  theme_classic() +
  theme(
    axis.title.x = element_text(
      size = 15,
      face = "bold",
      margin = margin(t = 12)
    ),
    axis.title.y = element_text(
      size = 15,
      face = "bold",
      margin = margin(r = 12)
    ),
    axis.text = element_text(size = 13),
    axis.line = element_line(colour = "black"),
    plot.margin = margin(5, 5, 5, 8)
  )

fig_diff <- (p_PC1_diff_tr | p_PC2_diff_tr) +
  plot_layout(axis_titles = "collect")

fig_diff

ggsave(
  "RC_PFdiff_plot.jpg",
  fig_diff,
  width = 8,
  height = 4,
  units = "in",
  dpi = 600,
  quality = 100,
  bg = "white"
)

##----------- Analyses song pre and post playback ----
# Load packages
library(glmmTMB)

# Load data
data <- read_excel("T.chalcospilos_LowHigh.xlsx", sheet = "Songs")

# Prepare variables

data <- data %>%
  mutate(
    # Treatment as factor
    TREATMENT = factor(TREATMENT, levels = c("low", "high")),
    
    # Phase as factor (important!)
    PHASE_NAME = factor(PHASE_NAME, levels = c("playback", "after playback")),
    
    # ID as factor for random effect
    ID = factor(ID)
  )


# DESCRIPTIVE STATS (mean ± SD)

song_summary <- data %>%
  group_by(TREATMENT, PHASE_NAME) %>%
  summarise(
    mean_songs = mean(SONGS),
    sd_songs = sd(SONGS),
    n = n()
  )

print(song_summary)


# GLMM (Poisson, log-link)

# Model structure:
# SONGS ~ TREATMENT * PHASE_NAME + (1 | ID)

model <- glmmTMB(
  SONGS ~ TREATMENT * PHASE_NAME + (1 | ID),
  family = poisson(link = "log"),
  data = data
)
summary(model)