############################################################################################################# # # # Supplementary Information (R script) # # Title: Birds have peramorphic skulls, too: oppositional heterochronies in avian skull evolution # Authors:Olivia Plateau, Christian Foth # Date: 2019 # The network script is Adapted from Werneburg et al. 2019 and Esteve-Altava B. 2017 (parcellation parameter) ############################################################################################################# ## ################################################################################## ############################### Networking script ################################ ################################################################################## ##################################### ######### required packages ######### ##################################### library(XLConnect) # load adjacency matrices from Excel to R library(igraph) # network analysis library(ape) # phylogenetic analysis and hierarchical cluster manipulation library(phytools) # phylogenetic analysis and hierarchical cluster manipulation library(geiger) # phylogenetic analysis and hierarchical cluster manipulation library(adephylo) # phylogenetic analysis and hierarchical cluster manipulation library(phylobase) # phylogenetic analysis and hierarchical cluster manipulation library(picante) # phylogenetic analysis and hierarchical cluster manipulation ################################################### ######### Adjacency matrices and networks ######### ################################################### species <- c("Species_1","Species_2","Species_n") mat.list <- mapply(readWorksheetFromFile, "Species_file.xlsx",sheet=1:length(species), rownames=1, check.names=FALSE) adj.list <- lapply(mat.list, data.matrix, rownames.force=TRUE) pre.graph.list <- lapply(adj.list, graph_from_adjacency_matrix, mode="undirected") graph.list <- pre.graph.list names(graph.list) <- species ############################## ######### Networking ######### ############################## ######### Anatomical Network Analysis ##################################### # parameters parameters <- matrix(NA, nrow=length(species), ncol=6) rownames(parameters) <- species colnames(parameters) <- c("N", "K", "D", "C", "L", "H") parameters[,1] <- mapply(vcount, graph.list) parameters[,2] <- mapply(ecount, graph.list) parameters[,3] <- mapply(edge_density, graph.list) parameters[,4] <- mapply(transitivity, graph.list, type="average", isolates="NaN") parameters[,5] <- mapply(mean_distance, graph.list, directed=FALSE) heterogeneity = function(graph){ deg = degree(graph) res = sd(deg, na.rm=TRUE)/mean(deg, na.rm=FALSE) } parameters[,6] <- mapply(heterogeneity, graph.list) ######### Community structure (modularity) ########################################## #### function: GTOM (from http://labs.genetics.ucla.edu/horvath/GTOM/old/gtom.R) #### GTOMmdist1 = function(adjmat1,m=1){ if (m!=round(abs(m))){ stop("m must be a positive integer", call.=TRUE);} if (any(adjmat1!=0 & adjmat1!=1)){ stop("The adjacency matrix must be binary", call.=TRUE);} B <- adjmat1; if (m>=2) { for (i in 2:m) { diag(B) <- diag(B) + 1; B = B %*% adjmat1;}} # number of paths with length at most m connecting each pair B <- (B>0); # m-step reachability matrix diag(B) <- 0; # exclude each node being its own neighbor B <- B %*% B; # number of common k-step neighbors that each pair of nodes share Nk <- diag(B); # number of common k-step neighbors that each node possesses B <- B +adjmat1; diag(B) <- 1; denomTOM=outer(Nk,Nk,FUN="pmin")+1-adjmat1; diag(denomTOM) <- 1; 1 - B/denomTOM # turn the GTOM matrix into a dissimilarity } #### function: prepare adjacency matrices #### na.zero <- function (x) { x[is.na(x)] <- 0 return(x) } #### calculate GTOM and hierarchical clustering #### adj.list <- lapply(adj.list, na.zero) tom.list <- lapply(adj.list, GTOMmdist1, m=1) dist.tom.list <- lapply(tom.list, as.dist) hclust.list <- lapply(dist.tom.list, hclust, method="ward.D2") #### method minimizes variance (Ward 1963; Murtagh & Legendre, 2014) for (i in 1:length(species)){hclust.list[[i]]$labels <- V(graph.list[[i]])$name} phylo.list <- lapply(hclust.list, as.phylo) #### function: jackknife of modularity Q value #### jackknife_Q = function(graph, membership){ Qi <- vector() for (j in 1:ecount(graph)){ g <- delete_edges(graph, j) Qi[j] <- modularity(g, membership) } ss <- sum((Qi-mean(Qi))^2) n <- (ecount(graph)-1)/ecount(graph) Q.error <- sqrt(n*ss) return(Q.error) } #### best partition based on Q max #### best.partition <- vector() for (i in 1:length(species)){ Qvalue <- vector() for (j in 1:vcount(graph.list[[i]])){ Qvalue[j] <- modularity(graph.list[[i]], cutree(hclust.list[[i]], k=j)) } best.partition[i] <- which(Qvalue==max(Qvalue)) } #### function: Wilcox test to evaluate modules #### community.significance.test <- function(graph, vids, ...) { subgraph <- induced_subgraph(graph, vids) indegrees <- degree(subgraph) outdegrees <- degree(graph, vids) - indegrees wilcox.test(indegrees, outdegrees, alternative="greater") } #### partition based on statistical significance #### Ho_modules_pvalue <- list() for (i in 1:length(species)){ graph <- graph.list[[i]] tree <- phylo.list[[i]] tipN <- vcount(graph) intN <- tipN-1 Ho_modules_pvalue_v <- vector() for (j in 1:intN){ Ho_m <- extract.clade(tree, node=(tipN+j)) # get all subtrees is_tip <- Ho_m$edge[,2] <= length(Ho_m$tip.label) ordered_tips <- Ho_m$edge[is_tip, 2] who <- Ho_m$tip.label[ordered_tips] index <- which((V(graph)$name %in% who)==TRUE) Ho_mp <- community.significance.test(graph, vids=index) Ho_modules_pvalue_v[j] <- Ho_mp$p.value } Ho_modules_pvalue[[i]] <- Ho_modules_pvalue_v } #### dendrogram plots #### for (i in 1:length(species)){ plotTree(phylo.list[[i]], lwd=0.5, mar=c(1.1,1.1,1.1,1.1)) # p-value groups sign <- which(Ho_modules_pvalue[[i]]<0.05) bs <- Ho_modules_pvalue[[i]][sign] co <- c("black", "grey", "white") p <- character(length(sign)) p[bs < 0.001] <- co[1] p[bs >= 0.001 & bs < 0.01] <- co[2] p[bs >= 0.01 & bs < 0.05] <- co[3] nodelabels(node=(sign+vcount(graph.list[[i]])), pch=21, bg=p, cex=2) nodelabels(phylo.list[[i]]$node.label, node=(sign+vcount(graph.list[[i]])), adj=c(1.1,- 0.7),frame="none") #### Qmax groups #### obj <- ltt(phylo.list[[i]], plot=FALSE) k <- best.partition[i] h <- mean(obj$times[c(which(obj$ltt==k), which(obj$ltt==(k+1)))]) lines(rep(h,2), par()$usr[3:4], col="red", lty="dashed") title(main=paste("Modularity of the skull network of", species[i])) } #### groping bones by module #### members.list <- list() for (i in 1:length(species)){ n <- 2 p <- 0 end <- FALSE while (end==FALSE){ members <- cutree(hclust.list[[i]], n) for (j in 1:n){p[j] <- community.significance.test(graph.list[[i]], vids=(members==j))$p.value} if (all(p<0.05)==TRUE){ n <- n+1 } else { n <- n-1 p <- 0 members <- cutree(hclust.list[[i]], n) for (j in 1:n){p[j] <- community.significance.test(graph.list[[i]], vids=(members==j))$p.value} end <- TRUE } } members.list[[i]] <- members } #### modules information #### modules <- matrix(NA, nrow=length(species), ncol=4) rownames(modules) <- species colnames(modules) <- c("S Modules", "Q Modules", "Qmax", "Qmax error") for (i in 1:length(species)){ modules[i,1] <- max(members.list[[i]]) membership <- cutree(hclust.list[[i]], k=best.partition[i]) modules[i,2] <- best.partition[i] modules[i,3] <- modularity(graph.list[[i]], membership) modules[i,4] <- jackknife_Q(graph.list[[i]], membership) } ################################################################################## ############################### Character mapping ################################ ################################################################################## library(ape) tree <- read.tree(file=file.choose()) data=read.table(file=file.choose(),header=TRUE) names<-tree$tip.label data_order_phylogeny<-setNames(JuvCha,names) Ace<-ace(data_order_phylogeny,tree,type="continuous",method="ML")