##### "Script-MS_Nespolo et al_Supp.R" - To run all analysis and plots showed in the paper.
### This script was written by Jaiber J. Solano-Iguaran. If you have any question, you can  email me (jaiber.solano.i@gmail.com) ### 
###--------------------------------------------------------------------------------------------------------------
#Packages that are necessary
#install_github("khabbazian/l1ou")
library(ape)
library(geiger)
library(phytools)# packageVersion "0.5.20"
library(plotrix)
library(l1ou)
library(phangorn)
source("FUNCTIONS_R_Supp.txt") ## This file was written by Enrico Rezende

# Loading and ordering dataset and phylogeny #
tr<-read.tree("tree_yeast_Supp.txt")
tr <- reorder(tr,"postorder")
is.ultrametric(tr)
tr$tip.label[tr$tip.label=="Saccharomyces_pastorianus_Weihenstephan"]<-"Saccharomyces_pastorianus"
data<-read.table("Dataset_ToR_Supp.txt", header=T)
data$sp<-as.character(data$sp)
data$sp[data$sp=="Saccharomyces_pastorianus_Weihenstephan"]<-"Saccharomyces_pastorianus"
rownames(data)<-data$sp
rownames(data)

data <- data[match(tr$tip.label,rownames(data)),]
all.equal(row.names(data), tr$tip.label)

# Fig 1-Phylogeny and phylo.signal.disc LCP #### 
tr$tip.label
wdg.node<-mrca(tr)["Vanderwaltozyma_yarrowii", "Saccharomyces_cerevisiae"]
wdg.tips<-tips(tr, wdg.node)

wdg.branch<-which.edge(tr, wdg.tips)

col.wdg<-rep("black", length(tr$edge[,1]))
col.wdg[wdg.branch] <- "blue"

col.lcp<-rep("red", length(data[,"LCP"]))
col.lcp[data[,"LCP"]==0]<-"green3"
names(col.lcp)<-row.names(data)

yield_e_g<-setNames(data$eth_gl, data$sp)
LCP<-setNames(data$LCP, data$sp)

#pdf("Fig 1-phylosignal disc-EthY.pdf", width = 10, height = 9.6)
par(mar=c(4.1,4,1.1,1.1), lwd=2)
layout(matrix(c(1,2),1,2),c(0.8,0.2))
plot.phylo(tr, edge.width=4, font=4,cex=0.8, label.offset=3.5,mar=c(4.1,1.1,1.1,0), edge.color=col.wdg)
nodelabels(node = 58, frame="n", pch=23 , col = "black", bg = "purple",cex=2.5)

arrows(x0 = 20, y0 = 18, x1 = 41, y1 = 20, length = 0.1, code = 2) #Transferencia URA1
text(x = 15, y = 16.85, labels = "URA1 \n horizontal \n transfer", font = 4, cex=0.8)
arrows(x0 = -20, y0 = 24, x1 = -2, y1 = 26, length = 0.1, code = 2, xpd=T) #Perdida complejo respiratorio I
text(x = -21, y = 22.85, labels = "Lost of \n respiratory \n complex I", font = 4, xpd=T, cex=0.8)

tiplabels(pch=16,  col=col.lcp, adj=c(0.5,0.5), cex=2.7) 
legend(-35,16, c("LCP +","LCP -"), pch=16, col=c("red","green3"), bty="n", cex=1.5, y.intersp=0.8, pt.cex = 3, xpd=T)
mtext("(a)", side=3, cex=1.5,font=2, adj=0, padj=1)
par(mar=c(4.1,0,1.1,0.5))
barplot(yield_e_g[tr$tip.label],horiz=TRUE,width=1,space=0,
        ylim=c(1,length(tr$tip.label))-0.5,names="")
mtext(side=1, text="EthY(g/g)", cex=0.9, font=4, adj=0.5, padj=4)
par(fig=c(0.05,0.338,0.05,0.4),par(lwd=2.5),new=TRUE)
phylo.signal.disc(LCP,tr) 
#dev.off()

# Fig 2-HeatMap ####
DW<-setNames(log10(data$DW+10), rownames(data))
pr_Glycerol<-setNames(log10(data$pr_Glycerol+10), rownames(data))
RQ<-setNames(log10(data$RQ+10), rownames(data))
eth_gl<-setNames(log10(data$eth_gl+10), rownames(data))

vars<-cbind(DW, Gly=pr_Glycerol, RQ ,EthY=eth_gl)
head(vars)
dim(vars)
tr.tmp<-tr
tr.tmp$tip.label[4]<-"Saccharomyces_pastorianus"
rownames(vars)[4]<-"Saccharomyces_pastorianus"
#pdf("Fig 2-PhyloHeatMap.pdf", width = 12, height = 10)
par(mfrow=c(1,1))
phylo.heatmap(tr.tmp,vars, fsize=c(1,1,1), lwd=3,standardize=TRUE, grid=T)
#dev.off()

plotTree(tr)
nodelabels()

tr2<-paintSubTree(tr,node=32,state="WGD -")
tr2<-paintSubTree(tr2,node=35,state="WGD +")
tr2$tip.label[4]<-"Saccharomyces_pastorianus"
cols<-c("black","blue"); names(cols)<-colnames(tr2$mapped.edge)

# Fig 3-Phenograms a) DW b) b) Glicerol c) RQ d) EthY  #####
#pdf("Fig 3-phenograms-DW-Gly-RQ-EthY.pdf", width = 8, height = 8)
par(mfrow=c(2,2), mar=c(5,5,2,2))
### DW
phenogram(tr2, scale(DW)[,1], colors=cols,spread.labels=TRUE,spread.cost=c(1,0), 
          ftype="off",ylab=expression("Normalized Log"["10"]*"(Growth rate + 10)"), 
          xlab="Time (Mya)")
legend("topleft", c("WGD +", "WGD -"), col = c("blue", "black"), xpd=T, bty="n", pch="-", lwd=2, cex=1.5)
box(bty="l")
mtext("a)", side = 3, line = 0, adj = 0.05, font = 4, cex = 1.5)

### Glycerol
phenogram(tr2, scale(pr_Glycerol)[,1], colors=cols,spread.labels=TRUE,spread.cost=c(1,0), 
          ftype="off",ylab=expression("Normalized Log"["10"]*"(Glycerol production + 10)"), 
          xlab="Time (Mya)")
box(bty="l")
mtext("b)", side = 3, line = 0, adj = 0.05, font = 4, cex = 1.5)

### RQ
phenogram(tr2, scale(RQ)[,1], colors=cols,spread.labels=TRUE,spread.cost=c(1,0), 
          ftype="off",ylab=expression("Normalized Log"["10"]*"(Respiratory quotient + 10)"), 
          xlab="Time (Mya)")
box(bty="l")
mtext("c)", side = 3, line = 0, adj = 0.05, font = 4, cex = 1.5)

### EthY
phenogram(tr2, scale(eth_gl)[,1], colors=cols,spread.labels=TRUE,spread.cost=c(1,0), 
          ftype="off",ylab=expression("Normalized Log"["10"]*"(Ethanol yield + 10)"), 
          xlab="Time (Mya)")
box(bty="l")
mtext("d)", side = 3, line = 0, adj = 0.05, font = 4, cex = 1.5)

#dev.off()

# Fig 4- l1OU and OU analisys a) DW b) EthY c) RQ d) Glicerol ####
# Analisys l1OU #
vars
all.equal(row.names(vars), tr.tmp$tip.label)

eModel.BM<-list()
eModel.0<-list()
eModel.3<-list()
yeast<-list()
fix.eModel<-list()

 
for(i in 1:ncol(vars)){
  print(i)
  yeast[[i]] <- adjust_data(tr.tmp, vars[,i])
  eModel.BM[[i]] <- estimate_shift_configuration(yeast[[i]]$tree, yeast[[i]]$Y, criterion="BIC", 
                        max.nShifts = 0, nCores = 3, 
                        alpha.upper = 0.001, alpha.lower=0.0, alpha.starting.value=0.0005)
  eModel.0[[i]] <- estimate_shift_configuration(yeast[[i]]$tree, yeast[[i]]$Y, criterion="BIC", 
                        max.nShifts = 0, nCores = 3)
  eModel.3[[i]] <- estimate_shift_configuration(yeast[[i]]$tree, yeast[[i]]$Y, criterion="BIC", 
                        max.nShifts = 3, nCores = 3)
  fix.eModel[[i]] <- fit_OU(tr.tmp, setNames(vars[,i], rownames(vars)), 55, criterion="BIC")      
}

table.scores<-matrix(nrow = 4, ncol = ncol(vars))
rownames(table.scores)<-c("Model BM", "Model K=0", "Model K=3", "Fix Model")
colnames(table.scores)<-colnames(vars)

for(i in 1:ncol(vars)){
  table.scores[1,i]<-eModel.BM[[i]]$score
  table.scores[2,i]<-eModel.0[[i]]$score
  table.scores[3,i]<-eModel.3[[i]]$score
  table.scores[4,i]<-fix.eModel[[i]]$score
}
round(table.scores,2)

table.aicw<-matrix(nrow=4, ncol=ncol(vars))
colnames(table.aicw)<-colnames(vars)
rownames(table.aicw)<-rownames(table.scores)
for(i in 1:ncol(vars)){
  table.aicw[,i]<-round(aicw(table.scores[,i]),3)$w
}
table.aicw

# Plot a) DW b) Glicerol c) RQ d) EthY  #
labels<-c(expression(bold("Growth rate")), 
          expression(bold("Glycerol production")), 
          expression(bold("Respiratory quotient")),
          expression(bold("Ethanol yield"))
            )


#pdf("Fig 4-l1OU plots3.pdf", width = 10, height = 8, bg = "white")

plot(eModel.3[[1]], cex=.9, edge.shift.ann = F, edge.width = 6, x.lim=c(0,1.6)) # DW
mtext(labels[1], 4, line = 13, cex=2)

plot(eModel.3[[2]], cex=.9,  edge.shift.ann = F, edge.width = 6, x.lim=c(0,1.6)) # Glicerol
mtext(labels[2], 4, line = 13, cex=2)

plot(eModel.3[[3]], cex=.9,  edge.shift.ann = F, edge.width = 6, x.lim=c(0,1.6)) # RQ
mtext(labels[3], 4, line = 13, cex=2)

plot(eModel.3[[4]], cex=.9,  edge.shift.ann = F, edge.width = 6, x.lim=c(0,1.6)) # EthY
mtext(labels[4], 4, line = 13, cex=2)
#dev.off() 

############################################################################################
#################### PHYLOGENETIC SIGNAL - CONTINUOUS TRAITS################################
colnames(vars)
all.equal(rownames(vars), tr2$tip.label)

phy1<-phylosig(tree = tr2, x = vars[,"DW"], method = "K", test = T, nsim = 1000) # DW
phy2<-phylosig(tree = tr2, x = vars[,"Gly"], method = "K", test = T, nsim = 1000) # Gly
phy3<-phylosig(tree = tr2, x = vars[,"RQ"], method = "K", test = T, nsim = 1000) # RQ
phy4<-phylosig(tree = tr2, x = vars[,"EthY"], method = "K", test = T, nsim = 1000) # EthY

filosig.table<-data.frame(matrix(nrow=4, ncol=2))
rownames(filosig.table)<-colnames(vars)
colnames(filosig.table)<-c("Blomberg's K", "P-value")
filosig.table[1,]<-c(phy1$K, phy1$P)
filosig.table[2,]<-c(phy2$K, phy2$P)
filosig.table[3,]<-c(phy3$K, phy3$P)
filosig.table[4,]<-c(phy4$K, phy4$P)
filosig.table[,1]<-round(filosig.table[,1],3)
filosig.table