Nothing
#'
#' Phylogenetic tree exploration
#'
#' Compares phylogenetic trees and maps them into a small number of dimensions for easy visualisation and identification of clusters.
#'
#' @param x an object of the class multiPhylo
#' @param method the method for summarising the tree as a vector.
#' Choose from:
#' \code{treeVec} (default) the Kendall Colijn metric vector
#' \code{BHV} the Billera, Holmes Vogtmann metric using \code{dist.multiPhylo} from package \code{distory}
#' \code{KF} the Kuhner Felsenstein metric (branch score distance) using \code{KF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
#' \code{RF} the Robinson Foulds metric using \code{RF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted and issues a corresponding warning)
#' \code{wRF} the weighted Robinson Foulds metric using \code{wRF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted and issues a corresponding warning)
#' \code{nNodes} the Steel & Penny tip-tip path difference metric, (topological, ignoring branch lengths), using \code{path.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
#' \code{patristic} the Steel & Penny tip-tip path difference metric, using branch lengths, calling \code{path.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
#' others inherited from \code{distTips} in \code{adephylo}:
#' \itemize{
#' \item \code{Abouheif}: performs Abouheif's test. See Pavoine et al. (2008) and \code{adephylo}.
#' \item \code{sumDD}: sum of direct descendants of all nodes on the path, related to Abouheif's test. See \code{adephylo}.
#' }
#' @param nf the number of principal components to retain
#' @param return.tree.vectors option to also return the tree vectors. Note that this can use a lot of memory so defaults to \code{FALSE}.
#' @param ... further arguments to be passed to \code{method}.
#'
#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
#'
#' @import ape
#' @importFrom ade4 dudi.pco cailliez
#' @importFrom adephylo distTips
#' @importFrom distory dist.multiPhylo
#' @importFrom fields rdist
#' @importFrom phangorn KF.dist
#' @importFrom phangorn path.dist
#' @importFrom phangorn RF.dist
#' @importFrom phangorn wRF.dist
#'
#' @examples
#'
#' ## generate list of trees
#' x <- rmtree(10, 20)
#' names(x) <- paste("tree", 1:10, sep = "")
#'
#' ## use treescape
#' res <- treescape(x, nf=3)
#' table.paint(as.matrix(res$D))
#' scatter(res$pco)
#'
#' data(woodmiceTrees)
#' woodmiceDists <- treescape(woodmiceTrees,nf=3)
#' plot(woodmiceDists$pco$li[,1],woodmiceDists$pco$li[,2])
#' woodmicedf <- woodmiceDists$pco$li
#' if(require(ggplot2)){
#' woodmiceplot <- ggplot(woodmicedf, aes(x=A1, y=A2)) # create plot
#' woodmiceplot + geom_density2d(colour="gray80") + # contour lines
#' geom_point(size=6, shape=1, colour="gray50") + # grey edges
#' geom_point(size=6, alpha=0.2, colour="navy") + # transparent blue points
#' xlab("") + ylab("") + theme_bw(base_family="") # remove axis labels and grey background
#' }
#'
#' \dontrun{
#' if(require(rgl)){
#' plot3d(woodmicedf[,1], woodmicedf[,2], woodmicedf[,3], type="s", size=1.5,
#' col="navy", alpha=0.5, xlab="", ylab="", zlab="")
#' }
#' }
#'
#'
#' @export
treescape <- function(x, method="treeVec", nf=NULL, return.tree.vectors=FALSE, ...){
## CHECKS ##
if(!inherits(x, "multiPhylo")) stop("x should be a multiphylo object")
num_trees <- length(x) # number of trees
## fix potential bug with input of two trees
if(num_trees<3) {
stop("treescape expects at least three trees. The function treeDist is suitable for comparing two trees.")
}
# check for user supplying invalid options (these gave unhelpful error messages before)
dots <- list(...)
if(!is.null(dots$return.lambda.function)) stop("return.lambda.function is not compatible with treescape. Consider using multiDist instead.")
if(!is.null(dots$save.memory)) stop("save.memory is not compatible with treescape. Consider using multiDist instead.")
# make name labels well defined
if(is.null(names(x))) names(x) <- 1:num_trees
else if(length(unique(names(x)))!=num_trees){
warning("duplicates detected in tree labels - using generic names")
names(x) <- 1:num_trees
}
lab <- names(x)
# check all trees have same tip labels
for (i in 1:num_trees) {
if (!setequal(x[[i]]$tip.label,x[[1]]$tip.label)) {
stop(paste0("Tree ",lab[[i]]," has different tip labels from the first tree."))
}
}
## GET DISTANCES BETWEEN TREES, according to method ##
## get data.frame of all summary vectors ##
if (method=="treeVec") {
df <- t(data.frame(lapply(x, function(e) as.vector(treeVec(e, ...)))))
## get pairwise Euclidean distances ##
D <- as.dist(rdist(df))
}
else if(method %in% c("Abouheif","sumDD")){
df <- t(data.frame(lapply(x, function(e) as.vector(adephylo::distTips(e,method=method,...)))))
## get pairwise Euclidean distances ##
D <- as.dist(rdist(df))
}
else if(method=="patristic"){
D <- path.dist(x, use.weight=TRUE)
}
else if(method=="nNodes"){
D <- path.dist(x, use.weight=FALSE)
}
else if(method=="RF"){
D <- RF.dist(x)
## make the distance Euclidean
D <- ade4::cailliez(D, print=FALSE)
}
else if(method=="wRF"){
names(x) <- NULL # temporary fix to avoid wRF error
D <- wRF.dist(x)
}
else if(method=="KF"){
D <- KF.dist(x)
}
else if(method=="BHV"){
D <- dist.multiPhylo(x)
## make the distance Euclidean
D <- ade4::cailliez(D, print=FALSE)
}
## restore labels
attr(D,"Labels") <- lab
## perform PCoA/MDS ##
pco <- dudi.pco(D, scannf=is.null(nf), nf=nf)
## BUILD RESULT AND RETURN ##
if (return.tree.vectors==TRUE) {
out <- list(D=D, pco=pco, vectors=df)
}
else {
out <- list(D=D, pco=pco)
}
return(out)
} # end treescape
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.