#############################################################################################
# Program versions
#############################################################################################
#
# BiogeoBears version 0.2.1
# Lagrange version 
# R version 3.3.1 (2016-06-21)
# Authors: V. Valcárcel & N.G. Medina
# Date 2017-06-09

#############################################################################################
# Load required packages
#############################################################################################

library(optimx)  # (either 2012 or 2013 version, as of January 2014)
library(ape)
library(FD)        # for FD::maxent() (make sure this is up-to-date)
library(snow)     # (if you want to use multicore functionality; prob. better than library(parallel))
library(BioGeoBEARS)
library(phangorn)
library(phylotools)
library(phylobase)
source("http://phylo.wdfiles.com/local--files/biogeobears/BioGeoBEARS_univ_model_v1.R")
source("http://phylo.wdfiles.com/local--files/biogeobears/BioGeoBEARS_plots_v1.R")
source("http://phylo.wdfiles.com/local--files/biogeobears/BioGeoBEARS_readwrite_v1.R")
source("http://phylo.wikidot.com/local--files/biogeobears/calc_loglike_sp_v01.R")
calc_loglike_sp = compiler::cmpfun(calc_loglike_sp_prebyte)    # crucial to fix bug in uppass 


#############################################################################################
# File locations and project structure                                            ###########
#############################################################################################
# /home/Hedera            #home folder to store lagrange files and results
# /home/Hedera/Parse LGpy # folder to store parsed results as files after applying parse_lagrange_python_output


#############################################################################################
# Parse Python LAGRANGE output. STEP 1: divide the original output in as many files as splits 
#############################################################################################

# internal function to read Lagrange output file (used latter)
read_nodedat_fn <- function(x){
	rep(node_number_clean)
	dat=read.table(text=tree_data[x])
	return(dat)
}

outfn <- "/home/Hedera/ITS.txt"
results_dir <- "/home/Hedera/Parse LGpy"

#the following lines allow you to (1) read and (2) parse the results from Lagrange 
#the output returns N files, each containing Lagrange results of one tree. 

# First read the Lagrange output file row by row as text(string)
all_data <- readLines(outfn)

# Then identify the rows that contain tree start and end
tree_start <- grep("### Tree", all_data)
tree_end <- grep("########", all_data)

# Calculate the numer of trees 
number_trees <- length(tree_start)
name_trees <- stringr::str_extract(all_data[tree_start], "-*[0-9]+")

for (i in 1:number_trees) {
#extract the data of each tree (still row by row, string format)
	tree_data <- all_data[tree_start[i]:tree_end[i]]
	
#find the start and end points of the nodes (number of row) of each tree
	node_line <- grep("At node", tree_data)
	
	node_data_start <- node_line+2
	node_data_end <- c(node_line[-1]-2, length(tree_data)-2)		
	
	node_list <- Map(seq, node_data_end, node_data_start)
	
#extract node numbers
#The regular expression [0-9]+ matches one or more numbers, 
#and str_extract gets the number out of the string.	
	node_number_raw <- tree_data[node_line]
	node_number_clean <- as.numeric(stringr::str_extract(node_number_raw, "-*[0-9]+"))
	
	names(node_list) <- node_number_clean
	
#read the data of all the nodes of each tree in table format and export to txt file
	node_data <- plyr::ldply(.data = node_list, 
			.fun= read_nodedat_fn )
	
	write.table(node_data, paste0(results_dir,"/ITS_splits",name_trees[i],".txt",sep=""), quote=FALSE,col.names=FALSE,row.names=FALSE)
}


#############################################################################################
# Parse Python LAGRANGE output: Recover Ancestral areas, L, Pr..                  ###########     
#############################################################################################

splits_table_fn=list.files("/home/Hedera/Parse LGpy/") #to create a vector that lists the files

LGITSmatrix<-list() #creates a list of unkown length to include the Results
MLITSmatrix<-list()

for (i in 1:length(splits_table_fn))
{
LGpy_splits =  LGpy_splits_fn_to_table(splits_fn=splits_table_fn[i])
MLsplits = LGpy_MLsplit_per_node(splits=LGpy_splits)
x<-vector(mode="character",length=dim(MLsplits)[1]) #creates a vector to include the 
#name of the original file from where the splits are taken, so that I can always trace back Results
x[1:dim(MLsplits)[1]]=splits_table_fn [i] #add to that vector the name of the original file
y<-vector(mode="character",length=dim(LGpy_splits)[1])
y[1:dim(LGpy_splits)[1]]=splits_table_fn [i]
MLsplits$new.col<-x #add vector x to ML dataframe
MLsplits$LagTreeNum<-i
MLITSmatrix[[i]]<-MLsplits #saves the MLsplits for every i in the MLmatrix
LGpy_splits$Splits_file<-y
LGpy_splits$LagTreeNum<-i
LGITSmatrix[[i]]<-LGpy_splits
}

###################################################
# select nodes of interest
###################################################
setwd("/home/Hedera/")

ITSLagTrees<-read.tree("ITSLag.tre")# Reading input trees process by Lagrange. It is important to read Lagrange processed trees beacuse
#they contain a label with the name of nodes according to Lagrange labelling 

#create a list of list to store the results and attch it so that each list is available on the global environment
list.names <- apply(expand.grid(paste(rep("LagRes",6), c("HedSte","HedCro","Pol","EPol","WPol","Dip"), sep=""), 
                                c("LGITS","MLITS")), 1, paste, collapse="")
reslist <- replicate(12, list()) 
reslist <- setNames(reslist,list.names)
attach(reslist)


LagMrcaRHed<-matrix(nrow=687,ncol=18) #we will paste Lagrange results in this matrix
colnames(LagMrcaRHed)<-c("LagSortTree","HedMon","HedCroR","HedCroLag","HedSteR","HedSteLag","PolMon","PolCroR","PolCroLag","EPolMon","EPolCroR","EPolCroLag","WPolMon","WPolCroR","WPolCroLag","DipMon","DipCroR","DipCroLag") #la primer columna 

mymrcaAllNodes<-matrix(nrow=5,ncol=5)#we will paste node selection results in this matrix
colnames(mymrcaAllNodes)<-c("LagTreeNum","NodInt","NodIntMon","mymrca","equivLagR")

#creates a vector defining the node of interest  
groupHed<-c("eHedColLancaster296","eHedPasWen7322","eHedColLancaster269","eHedCypAJ131225","eHedCypAJ131224","eHedPas259HAM","wHedMadAJ131234","wHedMad18HAM","wHedHib937HAM","wHedHib949HAM","wHedIbe15HAM","wHedHib545HAM","wHedHib925HAM","dHedNep246HAM","dHedNepWen5980","dHedNep895HAM","dHedNepWen9278","dHedRhoKiougsn","dHedAlg838HAM","dHedAlgAJ131217","dHedMar152PV00","dHedCan237HAM","dHedCanAJ131221","dHedHelAJ131226","dHedMar861HAM","dHedMar868HAM","dHedAzoAJ131219","dHedHelAF506077","dHedAzoAJ131218","dHedHel5PV97","dHedRhoAJ131241","dHedRhoAJ131240","dHedHelAJ131228","dHedHel570HAM")
groupPol<-c("eHedColLancaster296","eHedPasWen7322","eHedColLancaster269","eHedCypAJ131225","eHedCypAJ131224","eHedPas259HAM","wHedMadAJ131234","wHedMad18HAM","wHedHib937HAM","wHedHib949HAM","wHedIbe15HAM","wHedHib545HAM","wHedHib925HAM")
groupEPol<-c("eHedColLancaster296","eHedPasWen7322","eHedColLancaster269","eHedCypAJ131225","eHedCypAJ131224","eHedPas259HAM")
groupWPol<-c("wHedMadAJ131234","wHedMad18HAM","wHedHib937HAM","wHedHib949HAM","wHedIbe15HAM","wHedHib545HAM","wHedHib925HAM")
groupDip<-c("dHedNep246HAM","dHedNepWen5980","dHedNep895HAM","dHedNepWen9278","dHedRhoKiougsn","dHedAlg838HAM","dHedAlgAJ131217","dHedMar152PV00","dHedCan237HAM","dHedCanAJ131221","dHedHelAJ131226","dHedMar861HAM","dHedMar868HAM","dHedAzoAJ131219","dHedHelAF506077","dHedAzoAJ131218","dHedHel5PV97","dHedRhoAJ131241","dHedRhoAJ131240","dHedHelAJ131228","dHedHel570HAM")
NodInt<-list(groupHed,groupPol,groupEPol,groupWPol,groupDip)


for (j in 1:length(ITSLagTrees)){
mytree<-(ITSLagTrees[[j]])
class(mytree)<-"phylo"

###################################################
# RETURN THE MRCA OF A SET OF SPECIES #######
###################################################
for (k in 1: length(NodInt))
	{
	x<-match(NodInt[[k]],mytree$tip.label)
	mytreeMon<-is.monophyletic(mytree,NodInt[[k]])#group 1 is monophyletic? This retrieves 1, if the node is monophyletic, and 0 if non-mon
    a<-Ancestors(mytree,x)  #this function that recovers all the Ancestors for each of the tips defined in the node of interest 
	CommAnc<-Reduce(intersect, a)  #with this we look for all the ancestors all the tips have in common
	mymrca<-max(CommAnc)#with this we recover the most recent Ancestors within all the common ancestors
	internal<-unique(mytree$edge[,1])#with this function we recover the internal nodes number according to R labelling
	Lagnodenum<-as.numeric(substr(mytree$node.label,2,5))#with this we remove the Ns from the original node labelling of LAgrange 
	#since all nodes start N178 we are from that column read only characters from site 2 to site 5 and retrieve a numeric vector
	equivLagR<-Lagnodenum[which(internal==mymrca)]#recovers Lagrange labelling whenever the internal node 
	#coincides with mymrca
	mymrcaAllNodes[k,1]<-j
  mymrcaAllNodes[k,2]<-k #include the input number of NodInt in column 1 (1: Hed, 2: Pol, 3: EPol, 4: WPol, 5: Dip)
	mymrcaAllNodes[k,3]<-mytreeMon #include if the node of interest is monophyletic (1) or not (2) in column 2
	mymrcaAllNodes[k,4]<-mymrca #include node labell for mrca accoring to R labelling
	mymrcaAllNodes[k,5]<-equivLagR #include node labell for mrca accoring to R phyton Lagrange
	
}
	
#These following functions are specifically to recover the stem node  
AncR<-mytree$edge[,1]# Get Ancestors from edge object  
HedSte<-AncR[which(mytree$edge[,2]==mymrcaAllNodes[1,3])]#recovers the ancestor of mrca
equivLagRHedSte<-Lagnodenum[which(internal==HedSte)]#get Lagrange labelling for the mrca Ancestor

#HedSte<-lapply(LagResHedSteLGPlasto,"[",c(3,4,5,7))
#to extract the columns I'm interested in
#res <- lapply(LGITSmatrix, function(x) x[2:nrow(x),, drop=FALSE])

myLGITSmatrix<-LGITSmatrix[[j]]#creates a single matrix for the results of the i tree included in the LGITSmatrix 																
myMLITSmatrix<-MLITSmatrix[[j]]

LagResHedSteLGITS[[j]]<-subset(myLGITSmatrix,myLGITSmatrix[,2]==equivLagRHedSte)#extract results from myLGITSmatrix  
#only for nodes of interest = LagMrcaRHed[j,6]
LagResHedSteMLITS[[j]]<-subset(myMLITSmatrix,myMLITSmatrix[,2]==equivLagRHedSte) 
LagResHedCroLGITS[[j]]<-subset(myLGITSmatrix,myLGITSmatrix[,2]==mymrcaAllNodes[1,5] & mymrcaAllNodes[1,3]==1)
LagResHedCroMLITS[[j]]<-subset(myMLITSmatrix,myMLITSmatrix[,2]==mymrcaAllNodes[1,5] & mymrcaAllNodes[1,3]==1)
LagResPolLGITS[[j]]<-subset(myLGITSmatrix,myLGITSmatrix[,2]==mymrcaAllNodes[2,5] & mymrcaAllNodes[2,3]==1)
LagResPolMLITS[[j]]<-subset(myMLITSmatrix,myMLITSmatrix[,2]==mymrcaAllNodes[2,5] & mymrcaAllNodes[2,3]==1)
LagResEPolLGITS[[j]]<-subset(myLGITSmatrix,myLGITSmatrix[,2]==mymrcaAllNodes[3,5] & mymrcaAllNodes[3,3]==1) 
LagResEPolMLITS[[j]]<-subset(myMLITSmatrix,myMLITSmatrix[,2]==mymrcaAllNodes[3,5] & mymrcaAllNodes[3,3]==1)
LagResWPolLGITS[[j]]<-subset(myLGITSmatrix,myLGITSmatrix[,2]==mymrcaAllNodes[4,5] & mymrcaAllNodes[4,3]==1) 
LagResWPolMLITS[[j]]<-subset(myMLITSmatrix,myMLITSmatrix[,2]==mymrcaAllNodes[4,5] & mymrcaAllNodes[4,3]==1)
LagResDipLGITS[[j]]<-subset(myLGITSmatrix,myLGITSmatrix[,2]==mymrcaAllNodes[5,5] & mymrcaAllNodes[5,3]==1) 
LagResDipMLITS[[j]]<-subset(myMLITSmatrix,myMLITSmatrix[,2]==mymrcaAllNodes[5,5] & mymrcaAllNodes[5,3]==1)
}																		

##### to process the results
CodCom2ITS<-matrix(nrow=6,ncol=2)
colnames(CodCom2ITS)<-c("GeoCod","GeoAre")
CodCom2ITS <- matrix(c("A","America", "B", "WMed","C","EMed", "D", "Europa", "E", "WAsia","F", "EAsia"),byrow=T, nrow=6,ncol=2)


################## RESULTS FOR STEM ####################

HedSte<-lapply(LagResHedSteLGITS,"[",c(3,4,5,7))#to extract the columns I'm interested in
HedSte<-do.call(rbind,HedSte)#to convert the list fo dataframes into a single dataframe
HedSteAreUniCom<-unique(HedSte$splits)#to see how many area combinations do I actually have

#[1] "AH|A"  "H|H"   "A|AH"  "H|A"   "A|A"   "H|AH"  "AH|H"  "A|H"   "G|H"   "E|G"   "G|GH"  "G|G"   "EG|G" 
#[14] "GH|H"  "E|EG"  "H|GH"  "GH|G"  "H|G"   "G|EG"  "D|D"   "G|E"   "EG|E"  "B|E"   "E|E"   "DF|D"  "DEF|D"
#[27] "DE|D"  "F|D"   "D|DE"  "F|DF"  "F|F"   "D|DF"  "EF|D"  "DF|F"  "F|DEF" "F|DE"  "BE|E" 

# create a vector to name de results
names.area.Ste <- gsub("|", ".", HedSteAreUniCom,fixed=TRUE)
names.area.Ste <- paste(rep("HedSte",length(HedSteAreUniCom)),names.area, sep="" )

# extract the results in separate matrices
for (i in 1:length(names.area.Ste)){
  matrix <- subset(HedSte,HedSte[,1]==HedSteAreUniCom[i])
  assign(names.area[i],matrix)
}

###To bind all the dataframes that depict the same area combination to do the mean over 687 total trees
HedSteAncAreAH<-rbind.data.frame(HedSteAH.A,HedSteAH.A,HedSteH.A,HedSteH.AH,HedSteAH.H,HedSteA.H)
HedSteAncAreAHMean<-sum(HedSteAncAreAH$relprob)/687# 0.123647 
HedSteAncAreGH<-rbind.data.frame(HedSteG.H,HedSteG.GH,HedSteGH.G,HedSteH.GH,HedSteGH.G,HedSteH.G)
HedSteAncAreGHMean<-sum(HedSteAncAreGH$relprob)/687# 0.2856007
HedSteAncAreEG<-rbind.data.frame(HedSteE.G,HedSteEG.G,HedSteE.EG,HedSteG.EG,HedSteG.E,HedSteEG.E)
HedSteAncAreEGMean<-sum(HedSteAncAreEG$relprob)/687# 0.0782033
HedSteAncAreDF<-rbind.data.frame(HedSteDF.D,HedSteF.D,HedSteF.DF,HedSteD.DF,HedSteDF.D)
HedSteAncAreDFMean<-sum(HedSteAncAreDF$relprob)/687#  0.005709651
HedSteAncAreDEF<-rbind.data.frame(HedSteDEF.D,HedSteEF.D,HedSteF.DEF,HedSteF.DE)
HedSteAncAreDEFMean<-sum(HedSteAncAreDEF$relprob)/687#  0.0001898879
HedSteAncAreBE<-rbind.data.frame(HedSteB.E,HedSteBE.E)
HedSteAncAreBEMean<-sum(HedSteAncAreBE$relprob)/687#  0.001052872
HedSteAncAreDE<-rbind.data.frame(HedSteDE.D,HedSteD.DE)
HedSteAncAreDEMean<-sum(HedSteAncAreDE$relprob)/687#  0.000156492
HedSteAncAreAMean<-sum(HedSteA.A$relprob)/687# 0.06807317
HedSteAncAreDMean<-sum(HedSteD.D$relprob)/687# 0.004122562
HedSteAncAreEMean<-sum(HedSteE.E$relprob)/687# 0.00208787
HedSteAncAreGMean<-sum(HedSteG.G$relprob)/687# 0.09884911
HedSteAncAreHMean<-sum(HedSteH.H$relprob)/687# 0.250889

################## RESULTS FOR CROWN ###################


HedCro<-lapply(LagResHedCroLGITS,"[",c(3,4,5,7))#to extract the columns I'm interested in
HedCro<-do.call(rbind,HedCro)#to convert the list fo dataframes into a single dataframe
HedCroAreUniCom<-unique(HedCro$splits)#to see how many area combinations do I actually have
####[1] "E|EG"  "E|G"   "E|E"   "EG|G"  "EG|E"  "G|EG"  "G|G"   "DE|E"  "DE|D"  "E|DE" 
####[11] "D|DE"  "G|E"   "E|EF"  "D|DEF" "D|E"   "E|DEF" "DE|F"  "E|D"   "D|EF"  "DEF|E"
####[21] "DEF|D" "EF|E"  "EF|D"  "F|DE"  "E|F"   "E|DF"  "DF|E"  "F|DEF" "D|D"   "EF|F" 
####[31] "F|EF"  "G|GH"  "DEF|F" "F|E"   "GH|G"

# create a vector to name de results
names.area.Cro <- gsub("|", ".", HedCroAreUniCom,fixed=TRUE)
names.area.Cro <- paste(rep("HedCro",length(HedCroAreUniCom)),names.area.Cro, sep="" )

# extract the results in separate matrices
for (i in 1:length(names.area.Cro)){
  matrix <- subset(HedCro,HedCro[,1]==HedCroAreUniCom[1])
  assign(names.area.Cro[i],matrix)
}


###To bind all the dataframes that depict the same area combination to do the mean over 687 total trees
HedCroAncAreEG<-rbind.data.frame(HedCroE.EG,HedCroE.G, HedCroE.E, HedCroEG.G, HedCroEG.E,HedCroG.EG, HedCroG.E)
HedCroAncAreEGMean<-sum(HedCroAncAreEG$relprob)/687# 0.7656843
HedCroAncAreGMean<-sum(HedCroG.G$relprob)/687# 0.01937738
HedCroAncAreDE<-rbind.data.frame(HedCroDE.E,HedCroDE.D,HedCroE.DE,HedCroD.DE,HedCroD.E,HedCroE.D)
HedCroAncAreDEMean<-sum(HedCroAncAreDE$relprob)/687# 0.1149216
HedCroAncAreEF<-rbind.data.frame(HedCroE.EF,HedCroEF.F,HedCroEF.E,HedCroE.F,HedCroF.EF,HedCroF.E)
HedCroAncAreEFMean<-sum(HedCroAncAreEF$relprob)/687# 0.01014718
HedCroAncAreDEF<-rbind.data.frame(HedCroD.DEF,HedCroE.DEF,HedCroDE.F,HedCroD.EF,HedCroDEF.E,HedCroDEF.D,HedCroEF.D,HedCroF.DE,HedCroE.DF,HedCroDF.E,HedCroF.DEF,HedCroDEF.F)
HedCroAncAreDEFMean<-sum(HedCroAncAreDEF$relprob)/687# 0.04314947 
HedCroAncAreDMean<-sum(HedCroD.D$relprob)/687# 0.0004682445
HedCroAncAreGH<-rbind.data.frame(HedCroG.GH,HedCroGH.G)
HedCroAncAreGHMean<-sum(HedCroAncAreGH$relprob)/687#  0.000144885


################## RESULTS FOR POLYPLOIDS ###################

HedPol<-lapply(LagResPolLGITS,"[",c(3,4,5,7))
HedPol<-do.call(rbind,HedPol)
HedPolAreUniCom<-unique(HedPol$splits)
HedPolAreUniCom
#[1] "E|D"   "E|E"   "E|DF"  "EG|E"  "E|F"   "E|DE"  "DE|D"  "D|E"   "E|EG"  "F|E"   "E|G"   "DE|E"  "D|DE" 
#[14] "DF|E"  "DEF|E" "E|DEF" "EF|E"  "G|E"   "E|EF"  "D|D"   "G|EG"  "EG|G"  "G|G"   "D|EF"  "F|F"   "EF|F" 
#[27] "EF|D" 

# create a vector to name de results
names.area.Pol <- gsub("|", ".", HedPolAreUniCom,fixed=TRUE)
names.area.Pol <- paste(rep("HedPol",length(names.area.Pol)),names.area.Pol, sep="" )

# extract the results in separate matrices
for (i in 1:length(names.area.Pol)){
  matrix <- subset(HedPol,HedPol[,1]==HedPolAreUniCom[i])
  assign(names.area.Pol[i],matrix)
}

HedPolAncAreED<-rbind.data.frame(HedPolE.D,HedPolE.DE,HedPolDE.D,HedPolD.E,HedPolDE.E,HedPolD.DE)
HedPolAncAreEDMean<-sum(HedPolAncAreED$relprob)/687#  0.3565175
HedPolAncAreDEF<-rbind.data.frame(HedPolE.DF,HedPolDF.E,HedPolDEF.E,HedPolE.DEF,HedPolD.EF,HedPolEF.D)
HedPOlAncAreDEFMean<-sum(HedPolAncAreDEF$relprob)/687# 0.1328409
HedPolAncAreEG<-rbind.data.frame(HedPolEG.E,HedPolE.EG,HedPolE.G,HedPolG.E,HedPolG.EG,HedPolEG.G)
HedPOlAncAreEGMean<-sum(HedPolAncAreEG$relprob)/687#  0.2152729
HedPolAncAreEF<-rbind.data.frame(HedPolE.F,HedPolF.E,HedPolEF.E,HedPolE.EF,HedPolEF.F)
HedPolAncAreEFMean<-sum(HedPolAncAreEF$relprob)/687#  0.1013634
HedPolAncAreDMean<-sum(HedPolD.D$relprob)/687# 0.0002555924
HedPolAncAreEMean<-sum(HedPolE.E$relprob)/687# 0.1211872
HedPOlAncAreGMean<-sum(HedPolG.G$relprob)/687#  0.0005352838
HedPOlAncAreFMean<-sum(HedPolF.F$relprob)/687#  1.962154e-05


################## RESULTS FOR E POLYPLOIDS ###################
HedEPol<-lapply(LagResEPolLGITS,"[",c(3,4,5,7))
HedEPol<-do.call(rbind,HedEPol)
HedEPolAreUniCom<-unique(HedEPol$splits)
HedEPolAreUniCom
#[1] "E|E"  "EG|E" "G|EG" "E|EG" "EG|G" "G|E"  "E|G"  "G|G" 

# create a vector to name de results
names.area.EPol <- gsub("|", ".", HedEPolAreUniCom,fixed=TRUE)
names.area.EPol <- paste(rep("HedEPol",length(names.area.EPol)),names.area.EPol, sep="" )

# extract the results in separate matrices
for (i in 1:length(names.area.EPol)){
  matrix <- subset(HedEPol,HedEPol[,1]==HedEPolAreUniCom[i])
  assign(names.area.EPol[i],matrix)
}

HedEPolAncAreEG<-rbind.data.frame(HedEPolEG.E,HedEPolG.EG,HedEPolE.EG,HedEPolEG.G,HedEPolG.E,HedEPolE.G)
HedEPolAncAreEGMean<-sum(HedEPolAncAreEG$relprob)/687# 0.6029508
HedEPolAncAreEMean<-sum(HedEPolE.E$relprob)/687#  0.3286539
HedEPolAncAreGMean<-sum(HedEPolG.G$relprob)/687# 0.02517346

################## RESULTS FOR W POLYPLOIDS ###################

HedWPol<-lapply(LagResWPolLGITS,"[",c(3,4,5,7))
HedWPol<-do.call(rbind,HedWPol)
HedWPolAreUniCom<-unique(HedWPol$splits)
HedWPolAreUniCom
#[1] "D|D"   "D|DF"  "DE|D"  "D|DE"  "D|F"   "D|DEF" "DF|F"  "DF|D"  "F|F"   "F|DF"  "DEF|F" "DEF|D" "F|D"  
#[14] "EF|F"  "D|EF"  "D|E"   "F|EF"  "DE|F"  "F|DEF" "EF|D"  "E|D"   "F|DE"  "E|DF" 

# create a vector to name de results
names.area.WPol <- gsub("|", ".", HedWPolAreUniCom,fixed=TRUE)
names.area.WPol <- paste(rep("HedWPol",length(names.area.WPol)),names.area.WPol, sep="" )

# extract the results in separate matrices
for (i in 1:length(names.area.WPol)){
  matrix <- subset(HedWPol,HedWPol[,1]==HedWPolAreUniCom[i])
  assign(names.area.WPol[i],matrix)
}


HedWPolAncAreDMean<-sum(HedWPolD.D$relprob)/687# 0.4287635
HedWPolAncAreFMean<-sum(HedWPolF.F$relprob)/687# 0.02495243
HedWPolAncAreDF<-rbind.data.frame(HedWPolD.DF,HedWPolD.F,HedWPolDF.F,HedWPolDF.D,HedWPolF.DF,HedWPolF.D)
HedWPolAncAreDFMean<-sum(HedWPolAncAreDF$relprob)/687#  0.4222032
HedWPolAncAreDE<-rbind.data.frame(HedWPolDE.D,HedWPolD.DE,HedWPolD.E,HedWPolE.D)
HedWPolAncAreDEMean<-sum(HedWPolAncAreDE$relprob)/687# 0.04001627
HedWPolAncAreEF<-rbind.data.frame(HedWPolEF.F,HedWPolF.EF)
HedWPolAncAreEFMean<-sum(HedWPolAncAreEF$relprob)/687# 0.001559316
HedWPolAncAreDEF<-rbind.data.frame(HedWPolD.DEF,HedWPolDEF.F,HedWPolDEF.D,HedWPolD.EF,HedWPolDE.F,HedWPolF.DEF,HedWPolEF.D,HedWPolF.DE,HedWPolE.DF)
HedWPolAncAreDEFMean<-sum(HedWPolAncAreDEF$relprob)/687#  0.04013043

################## RESULTS FOR DIPLOIDS ###################

HedDip<-lapply(LagResDipLGITS,"[",c(3,4,5,7))
HedDip<-do.call(rbind,HedDip)
HedDipAreUniCom<-unique(HedDip$splits)
HedDipAreUniCom
# [1] "G|E"   "G|EG"  "E|EG"  "D|DE"  "E|E"   "E|G"   "DE|E"  "D|E"   "EG|E"  "EG|G"  "G|G"   "DE|D"  "DEF|D"
#[14] "E|D"   "D|D"   "EF|D"  "E|DE"  "D|DEF" "E|DEF" "DE|F"  "E|EF"  "E|DF"  "D|DF"  "DF|D"  "F|DE"  "EF|E" 
#[27] "DEF|E" "D|EF"  "GH|G"  "DF|E"  "F|E"   "E|F"


# create a vector to name de results
names.area.Dip <- gsub("|", ".", HedDipAreUniCom,fixed=TRUE)
names.area.Dip <- paste(rep("HedDip",length(names.area.Dip)),names.area.Dip, sep="" )

# extract the results in separate matrices
for (i in 1:length(names.area.Dip)){
  matrix <- subset(HedDip,HedDip[,1]==HedDipAreUniCom[i])
  assign(names.area.Dip[i],matrix)
}

HedDiplAncAreDMean<-sum(HedDipD.D$relprob)/687# 0.0397892
HedDiplAncAreEMean<-sum(HedDipE.E$relprob)/687#  0.03567506
HedDiplAncAreGMean<-sum(HedDipG.G$relprob)/687# 0.001060697
HedDiplAncAreGE<-rbind.data.frame(HedDipG.E,HedDipG.EG,HedDipE.EG,HedDipE.G,HedDipEG.E,HedDipEG.G)
HedDiplAncAreGEMean<-sum(HedDiplAncAreGE$relprob)/687#  0.5174295
HedDiplAncAreDE<-rbind.data.frame(HedDipD.DE,HedDipDE.E,HedDipD.E,HedDipDE.D,HedDipE.D,HedDipE.DE)
HedDiplAncAreDEMean<-sum(HedDiplAncAreDE$relprob)/687#  0.3415719
HedDiplAncAreDEF<-rbind.data.frame(HedDipDEF.D,HedDipEF.D,HedDipD.DEF,HedDipE.DEF,HedDipDE.F,HedDipE.DF,HedDipF.DE,HedDipDEF.E,HedDipD.EF,HedDipDF.E)
HedDiplAncAreDEFMean<-sum(HedDiplAncAreDEF$relprob)/687#  0.02285116
HedDiplAncAreEF<-rbind.data.frame(HedDipE.EF,HedDipEF.E,HedDipF.E,HedDipE.F)
HedDiplAncAreEFMean<-sum(HedDiplAncAreEF$relprob)/687#   0.0009602635
HedDiplAncAreDF<-rbind.data.frame(HedDipD.DF,HedDipDF.D)
HedDiplAncAreDFMean<-sum(HedDiplAncAreDF$relprob)/687#    0.000913706
HedDiplAncAreGHMean<-sum(HedDipGH.G$relprob)/687#    2.224163e-05