@@ -1,7 +1,7 @@

 Package: ggtree

 Type: Package

 Title: a phylogenetic tree viewer for different types of tree annotations

-Version: 1.1.14

+Version: 1.1.15

 Author: Guangchuang Yu and Tommy Tsan-Yuk Lam

 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>

 Description: ggtree extends the ggplot2 plotting system which implemented the

@@ -20,6 +20,7 @@ Imports:

     jsonlite,

     magrittr,

     methods,

+    phytools,

     reshape2,

     stats4

 Suggests:

@@ -65,6 +65,7 @@ export(read.hyphy)

 export(read.jplace)

 export(read.paml_rst)

 export(read.tree)

+export(reroot)

 export(rotate)

 export(rtree)

 export(scaleClade)

@@ -90,6 +91,7 @@ exportMethods(groupClade)

 exportMethods(groupOTU)

 exportMethods(gzoom)

 exportMethods(plot)

+exportMethods(reroot)

 exportMethods(scale_color)

 exportMethods(show)

 importFrom(Biostrings,GENETIC_CODE)

@@ -156,6 +158,7 @@ importFrom(magrittr,"%>%")

 importFrom(magrittr,add)

 importFrom(magrittr,equals)

 importFrom(methods,show)

+importFrom(phytools,reroot)

 importFrom(reshape2,melt)

 importFrom(stats4,plot)

 importMethodsFrom(Biostrings,width)

@@ -1,3 +1,7 @@

+CHANGES IN VERSION 1.1.15

+------------------------

+ o reroot methods for phylo and beast <2015-08-07, Fri>

+ 

 CHANGES IN VERSION 1.1.14

 ------------------------

  o update paml_rst to compatible with only marginal ancestral sequence or joint ancestral sequence available <2015-08-07, Fri>

@@ -22,12 +22,22 @@ as.binary <- function(tree, ...) {

 if ( !isGeneric("plot") )

 	setGeneric("plot", function(x, ...) standardGeneric("plot"))

+##' @docType methods

+##' @name reroot

+##' @rdname reroot-methods

+##' @title reroot method

+##' @param object one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object

+##' @param node internal nnode number

+##' @param ... additional parameter

+##' @return tree object

+##' @export

+setGeneric("reroot", function(object, node, ...) standardGeneric("reroot"))

 ##' @docType methods

 ##' @name get.tree

 ##' @rdname get.tree-methods

 ##' @title get.tree method

-##' @param object one of \code{jplace}, \code{beast} object

+##' @param object one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object

 ##' @param ... additional parameter

 ##' @return phylo object

 ##' @export

@@ -37,7 +47,7 @@ setGeneric("get.tree", function(object, ...) standardGeneric("get.tree"))

 ##' @name get.treetext

 ##' @rdname get.treetext-methods

 ##' @title get.treetext method

-##' @param object one of \code{jplace}, \code{beast} object

+##' @param object one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object

 ##' @param ... additional parameter

 ##' @return phylo object

 ##' @export

@@ -62,7 +72,7 @@ setGeneric("get.treeinfo", function(object, layout="phylogram", ladderize=TRUE,

 ##' @name get.fields

 ##' @rdname get.fields-methods

 ##' @title get.fields method

-##' @param object one of \code{jplace}, \code{beast} object

+##' @param object one of \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object

 ##' @param ... additional parameter

 ##' @return available annotation variables

 ##' @export

@@ -348,3 +348,17 @@ read.stats_beast <- function(file) {

 }

+##' @rdname reroot-methods

+##' @exportMethod reroot

+setMethod("reroot", signature(object="beast"),

+          function(object, node, ...) {

+              object@phylo <- reroot(object@phylo, node, ...)

+

+              node_map <- attr(object@phylo, "node_map")

+              idx <- match(object@stats$node, node_map[,1])

+              object@stats$node <- node_map[idx, 2]

+              

+              return(object)

+          })

+

+

@@ -1,3 +1,17 @@

+##' @rdname reroot-methods

+##' @exportMethod reroot

+setMethod("reroot", signature(object="phylo"),

+          function(object, node, ...) {

+              pos <- 0.5* object$edge.length[which(object$edge[,2] == node)]

+              tree <- phytools_reroot(object, node, pos)

+              attr(tree, "reroot") <- TRUE

+              node_map <- reroot_node_mapping(object, tree)

+              attr(tree, "node_map") <- node_map

+              return(tree)

+          })

+

+

+

 ##' @rdname get.tree-methods

 ##' @exportMethod get.tree

 setMethod("get.tree", signature(object="phylo"),

@@ -71,3 +85,7 @@ setMethod("gzoom", signature(object="phylo"),

           function(object, focus, subtree=FALSE, widths=c(.3, .7)) {

               gzoom.phylo(object, focus, subtree, widths)

           })

+

+

+##' @importFrom phytools reroot

+phytools_reroot <- phytools::reroot

@@ -1,3 +1,35 @@

+reroot_node_mapping <- function(tree, tree2) {

+    root <- getRoot(tree)

+

+    node_map <- data.frame(from=1:getNodeNum(tree), to=NA, visited=FALSE)

+    node_map[1:Ntip(tree), 2] <- match(tree$tip.label, tree2$tip.label)

+    node_map[1:Ntip(tree), 3] <- TRUE

+

+    node_map[root, 2] <- root

+    node_map[root, 3] <- TRUE

+

+    node <- rev(tree$edge[,2])

+    for (k in node) {

+        ip <- getParent(tree, k)

+        if (node_map[ip, "visited"])

+            next

+        

+        cc <- getChild(tree, ip)

+        node2 <- node_map[cc,2]

+        if (any(is.na(node2))) {

+            node <- c(node, k)

+            next

+        }

+        

+        to <- unique(sapply(node2, getParent, tr=tree2))

+        to <- to[! to %in% node_map[,2]]

+        node_map[ip, 2] <- to

+        node_map[ip, 3] <- TRUE

+    }

+    node_map <- node_map[, -3]

+    return(node_map)

+}

+

 ##' @importFrom colorspace rainbow_hcl

 scale_color_ <- function(phylo, by, low=NULL, high=NULL, na.color=NULL, default.color="darkgrey", interval=NULL) {

@@ -455,7 +455,7 @@ fortify.phylo <- function(model, data, layout="phylogram",

         df <- add_angle_cladogram(df)

     }

     aa <- names(attributes(tree))

-    group <- aa[ ! aa %in% c("names", "class", "order")]

+    group <- aa[ ! aa %in% c("names", "class", "order", "reroot", "node_map")]

     if (length(group) > 0) {

         ## groupOTU & groupClade

         group_info <- attr(tree, group)

@@ -26,7 +26,7 @@ get.fields(object, ...)

 \S4method{get.fields}{paml_rst}(object)

 }

 \arguments{

-\item{object}{one of \code{jplace}, \code{beast} object}

+\item{object}{one of \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object}

 \item{...}{additional parameter}

 }

@@ -29,7 +29,7 @@ get.tree(object, ...)

 \S4method{get.tree}{phylo}(object, ...)

 }

 \arguments{

-\item{object}{one of \code{jplace}, \code{beast} object}

+\item{object}{one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object}

 \item{...}{additional parameter}

@@ -11,7 +11,7 @@ get.treetext(object, ...)

 get.treetext(object, ...)

 }

 \arguments{

-\item{object}{one of \code{jplace}, \code{beast} object}

+\item{object}{one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object}

 \item{...}{additional parameter}

 }

new file mode 100644

@@ -0,0 +1,29 @@

+% Generated by roxygen2 (4.1.1): do not edit by hand

+% Please edit documentation in R/AllGenerics.R, R/beast.R, R/phylo.R

+\docType{methods}

+\name{reroot}

+\alias{reroot}

+\alias{reroot,beast-method}

+\alias{reroot,phylo-method}

+\title{reroot method}

+\usage{

+reroot(object, node, ...)

+

+\S4method{reroot}{beast}(object, node, ...)

+

+\S4method{reroot}{phylo}(object, node, ...)

+}

+\arguments{

+\item{object}{one of \code{phylo}, \code{jplace}, \code{beast}, \code{hyphy}, \code{codeml}, \code{codeml_mlc}, \code{paml_rst} object}

+

+\item{node}{internal nnode number}

+

+\item{...}{additional parameter}

+}

+\value{

+tree object

+}

+\description{

+reroot method

+}

+