#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
#
# R Code supporting MS
#
# Vocal mimicry in corvids
# 
# Claudia A.F. Wascher*, Gemini Waterhouse & Bret A. Beheim
# corresponding author: claudia.wascher@gmail.com
#
#
#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

setwd("/Users/cw92/Desktop/01r")
options(digits=10)

# load data frame with info on species vocal behaviour, morphology, ecology, social factors etc
mimicry <- read.csv("mimicry.csv", header = TRUE, sep = ",", dec = ".")


################################################################################################
#Corvid Phylogenetic Tree
################################################################################################

# Package to get phylogeny from Open Tree Taxonomy
# OpenTreeOfLife, Benjamin Redelings, Luna Luisa Sanchez Reyes, Karen A. Cranston, Jim Allman, Mark T. Holder, & Emily Jane McTavish (2019) Open tree of life synthetic tree, Zenodo (12.3). https://doi.org/10.5281/zenodo.3937742
library(rotl)
library(ape)
# Create the data frame; match taxonomic names to the Open Tree Taxonomy
taxon_search <- tnrs_match_names(names = mimicry$scientific_name, context_name = "All life")
taxa <- mimicry$scientific_name
# Warning message: Cyanocorax colliei, Pica serica are not matched 
# Get the taxonomy ids for the taxa
resolved_names <- tnrs_match_names(taxa)
# Filter out taxa without a match
matched_names <- resolved_names[!is.na(resolved_names$ott_id), ]
# Extract the ott ids from the matched names
ott_ids <- matched_names$ott_id
# Fetch the phylogeny for the given ott ids
phylo <- tol_induced_subtree(ott_ids = ott_ids)
# Print the phylogeny
print(phylo)
# Save the tree to a file in Newick format
write.tree(phylo, file = "phylogeny_tree.newick")
# Define the path to Newick file
file_path <- 'phylogeny_tree.newick'
# Read the tree from the Newick file
treeCC <- read.tree(file = file_path)
# Apply the function to remove "OTT" from the tip labels
treeCC$tip.label <- gsub("_ott[0-9]+$", "", treeCC$tip.label, ignore.case = TRUE)

#Create a column animal, which is required for MCMCglmm
mimicry$animal <- as.factor(mimicry$scientific_name) # Pedigree option in MCMCglmm requires column called 'animal' 
#In column animal replace space with _ 
mimicry$animal <- gsub(" ", "_", mimicry$animal)


#rename species in dataset to match scientific names from phyologeny 

# Define the renaming list (modify with actual names)
rename_list <- c(
  "Coloeus_dauuricus" = "Corvus_dauuricus",
  "Coloeus_monedula" = "Corvus_monedula",
  "Cyanocorax_formosus" = "Gymnothorax_formosus"
)

# Apply renaming to the 'species' column
mimicry$animal <- ifelse(mimicry$animal %in% names(rename_list),
                          rename_list[mimicry$animal],
                          mimicry$animal)

  
################################################################################################
#Model investigating socio-ecological factors of specialist and generalist caching
################################################################################################
library(MCMCglmm)
# removing levels from data which are not in ginverse/phylogeny 
levels_in_data <- unique(mimicry$animal)
# Generate the ginverse matrix if not already done
ginverse <- inverseA(treeCC)$Ainv
# Extract the row names (animal labels)
levels_in_ginverse <- rownames(ginverse)
missing_levels <- setdiff(levels_in_data, levels_in_ginverse)
if (length(missing_levels) > 0) {
  cat("The following levels are missing in the ginverse matrix:\n", missing_levels, "\n")
} else {
  cat("All levels in the dataset are present in the ginverse matrix.\n")
}
mimicry <- mimicry[mimicry$animal %in% levels_in_ginverse, ]


# remove 'not reported' cases and change factors from character to integer
mimicry<-mimicry[!(mimicry$bodymass=="not reported"),]
mimicry$bodymass <- as.integer(mimicry$bodymass)
mimicry<-mimicry[!(mimicry$repertoire_combined=="not reported"),]
mimicry$repertoire_combined <- as.integer(mimicry$repertoire_combined)
mimicry<-mimicry[!(mimicry$breeding_system=="not reported"),]
mimicry<-mimicry[!(mimicry$habitat_breath=="not reported"),]
mimicry<-mimicry[!(mimicry$trophic_niche=="not reported"),]

# Just to check which species have been excluded because socio-ecological data was not available
write.csv(mimicry, file = "mimicry2.csv")



# Count fixed effects: 1 for intercept + continuous predictors + (levels - 1) for each factor
num_fixed_effects <- 1 +  # Intercept
  9 

### Prior
Sigma <- diag(10) * 0.5  # Default variance 0.5
Sigma[1,1] <- 1  # Stronger prior on intercept

prior <- list(
  R = list(V = 1, nu = 0.002),
  G = list(G1 = list(V = 1, nu = 10)),
  B = list(mu = rep(0, 10), V = Sigma)
)


# MCMCglmm investigating whether different socio-ecological affect occurrence of vocal mimicry using real data; 
glmm_data <- MCMCglmm(mimicry~bodymass+repertoire_combined+habitat_breath+breeding_system+trophic_niche, random= ~genus, data=mimicry,
                 nitt=3000000, thin=2000, burnin=2000000, pr=TRUE, prior=prior, pedigree=treeCC, family = "categorical")
summary(glmm_data)




################################################################################################
#Ancestral state anaylsis
################################################################################################

# library(readxl)

# raw <- read_excel("raw_data/All_Corvids_Project 2024-04-17.xlsx", sheet = 2)

# D <- raw$nr_recordings
# Z <- raw$mimicry

#open data sheet
# spp <-read.csv("caching_plus.csv", header = TRUE, sep = ",", dec = ".")
# stopifnot(nrow(spp) == 128)

spp <- read.csv("data/mimicry_imputation_10.csv")

# spp$mimicry needs to be imputed by the probability system i made

# spp$mimicry <- rbinom(nrow(spp), 1, spp$pr_mimic_mu)

spp$mimicry <- spp$mimicry_imputed

# subset to only those variables absolutely needed
spp <- select(spp, scientific_name, mimicry)

#Create a column `animal`, which is required for MCMCglmm
spp$animal <- as.factor(spp$scientific_name) # Pedigree option in MCMCglmm requires column called 'animal' 
#In column animal replace space with _ 
spp$animal <- gsub(" ", "_", spp$animal)

# Remove the row "Pica_nuttalli" as species is not present in phylogengy
spp <- spp[spp$animal != "Pica_nuttalli", ]
# Remove the row "Pica_serica" as species could not be matched in phylogeny 
spp <- spp[spp$animal != "Pica_serica", ]

stopifnot(nrow(spp) == 126)

# temporary fix:
cfg <- httr::config(ssl_verifypeer = FALSE)
httr::with_config(cfg, tnrs_match_names(c("Eviota")))
# see here: https://github.com/ropensci/rotl/issues/147

cat("Get corvid phylogenetic tree\n")

# Get phylogeny from open tree
httr::with_config(cfg, tnrs_contexts())
# Create the data frame 
taxon_search <- httr::with_config(cfg, tnrs_match_names(names = spp$scientific_name, context_name = "All life"))
knitr::kable(taxon_search)
taxa <- spp$scientific_name
# Get the taxonomy ids for the taxa
resolved_names <- httr::with_config(cfg, tnrs_match_names(taxa))
# Filter out taxa without a match
matched_names <- resolved_names[!is.na(resolved_names$ott_id), ]
# Extract the ott ids from the matched names
ott_ids <- matched_names$ott_id
# Fetch the phylogeny for the given ott ids
phylo <- httr::with_config(cfg, tol_induced_subtree(ott_ids = ott_ids))
# Print the phylogeny
# Save the tree to a file in Newick format
write.tree(phylo, file = "data/phylogeny_tree.newick")

# Define the path to Newick file
# Read the tree from the Newick file
treeCC <- read.tree(file = 'data/phylogeny_tree.newick')
# remove "OTT" from the tip labels
treeCC$tip.label <- gsub("_ott[0-9]+$", "", treeCC$tip.label, ignore.case = TRUE)

tree.reduced <- drop.tip(treeCC, setdiff(treeCC$tip.label, spp$animal))

# png("tree_reduced.png", res = 300, units = "in", height = 7, width = 4)

# plotTree(tree.reduced, fsize=0.4)
# write.tree(treeCC)

phy=multi2di(tree.reduced)

# # Make ultrametric using Grafen's method
tree.reduced = compute.brlen(tree.reduced, method="Grafen", power=1)
# add.scale.bar(x=0, y=17, length= 0.25, lwd= 2)
is.ultrametric(tree.reduced) # TRUE
tree.reduced$node.label<-NULL
summary.phylo(tree.reduced) # Check tree has imported correctly (e.g. number of tips)
# dev.off()

# Convert the data frame back to a named vector
# bab: huh?
mimicry_mode <- setNames(spp$mimicry, spp$animal)
# this is how we pass in the phenotypes

# Reorder mimicry_mode to match the order of species in phy
mimicry_mode <- mimicry_mode[phy$tip.label]

# Check for matching tip labels
stopifnot(all(phy$tip.label %in% names(mimicry_mode)))

# reset branch length
phy$branch.length = NULL

rooted_phy = ape::compute.brlen(phy)

library(phytools)
fit <- make.simmap(rooted_phy, mimicry_mode, model = "ARD", pi = "estimated")




#estimate ancestral states under an ER, SYM and ARD models
# ER = equal rates, memoryless, "the probability of being in a state at the root is primarily influenced by the tree topology, not by the observed distribution at the tips."
# ARD = asymmetric rates model
mimicry_er<-fitMk(rooted_phy,mimicry_mode,
                  model="ER", pi="estimated")
mimicry_sym<-fitMk(rooted_phy,mimicry_mode,
                   model="SYM",pi="estimated")
mimicry_ard<-fitMk(rooted_phy,mimicry_mode,
                   model="ARD",pi="estimated")

# Finally, the function ‘fitHRM’ fits a hidden-rate M_k_ model
#      following Beaulieu et al. (2013). For the hidden-rate model we
#      need to specify a number of rate categories for each level of the
#      trait - and this can be a vector of different values for each
#      trait. We can also choose a model (‘"ER"’, ‘"SYM"’, or ‘"ARD"’),
#      as well as whether or not to treat the character as a 'threshold'
#      trait (‘umbral=TRUE’, defaults to ‘FALSE’). This latter model is
#      basically one that allows absorbing conditions for some hidden
#      states. Since this can be a difficult optimization problem, the
#      optional argument ‘niter’ sets the number of optimization
#      iterations to be run. ‘niter’ defaults to ‘niter=10’. To fit the
#      same default hidden-rates model as is implemented in ‘corHMM’, one
#      should set ‘corHMM_model=TRUE’ and ‘ordered_hrm=FALSE’.

#Compare ancestral state models
mimicry_aov<-anova(mimicry_er,
                   mimicry_sym,mimicry_ard)

# ancr - Compute marginal or joint ancestral state estimates

#Create model average
mimicry_ancr<-ancr(mimicry_aov)

# Get the node labels
node_labels <- rooted_phy$node.label
# Identify the root node
root_node <- Ntip(rooted_phy) + 1  # Root node is usually the first internal node after the tips
# Print the root node
cat("Root node:", root_node, "\n")

cols_caching <- setNames(c("white", "red"), c("0", "1"))

png("figures/tree.png", res = 300, units = "in", height = 10, width = 8)
## plot results of ancestral state anaylsis
# layout(matrix(c(1,1,1,2,3,4),3,2),
#        widths=c(0.5,0.5))
plotTree(rooted_phy,fsize=0.6,ftype="i",
         lwd=1,mar=c(2.1,0.1,2.1,0.1))
legend(x=0.1*max(nodeHeights(rooted_phy)),
       y=0.1*Ntip(rooted_phy),names(cols_caching),pch=21,
       pt.bg=cols_caching,bty="n",cex=0.9,pt.cex=2)
nodelabels(pie = mimicry_ancr$ace, cex = 0.7, piecol = cols_caching)
dev.off()

mimicry_ancr$ace[1,] # ancestral state probabilities...50/50?? they report a different value in their code which I don't have.