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

 Package: ggtree

 Type: Package

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

-Version: 0.99.11

+Version: 0.99.12

 Author: Guangchuang Yu

 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>

 Description: ggtree extends the ggplot2 plotting system which implemented the

@@ -16,6 +16,7 @@ export(.)

 export(aes)

 export(as.binary)

 export(geom_aline)

+export(geom_hilight)

 export(geom_text)

 export(geom_tiplab)

 export(geom_tippoint)

@@ -62,6 +63,7 @@ exportMethods(get.tree)

 exportMethods(get.treeinfo)

 exportMethods(get.treetext)

 exportMethods(groupOTU)

+exportMethods(gzoom)

 exportMethods(plot)

 exportMethods(scale_color)

 exportMethods(show)

@@ -1,3 +1,9 @@

+CHANGES IN VERSION 0.99.12

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

+ o update vignette <2015-02-04, Wed>

+ o gzoom methods that supports all tree objects <2015-02-04, Wed>

+ o geom_hilight layer for highlighting clade <2015-02-04, Wed> 

+ 

 CHANGES IN VERSION 0.99.11

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

  o add scale_color to support colored lines and text based on numerical values and update vignette <2015-02-04, Wed>

@@ -126,3 +126,14 @@ setGeneric("groupOTU", function(object, focus) standardGeneric("groupOTU"))

 ##' @export

 setGeneric("scale_color", function(object, by, ...) standardGeneric("scale_color"))

+##' @docType methods

+##' @name gzoom

+##' @rdname gzoom-methods

+##' @title gzoom method

+##' @param object supported tree objects

+##' @param focus selected tips

+##' @param subtree logical

+##' @param widths widths

+##' @return figure

+##' @export

+setGeneric("gzoom", function(object, focus, subtree=FALSE, widths=c(.3, .7)) standardGeneric("gzoom"))

@@ -97,6 +97,13 @@ setMethod("scale_color", signature(object="beast"),

           })

+##' @rdname gzoom-methods

+##' @exportMethod gzoom

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

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

+              gzoom.phylo(get.tree(object), focus, subtree, widths)

+          })

+

 ##' get.tree method

 ##'

 ##'

@@ -133,6 +140,7 @@ read.treetext_beast <- function(file) {

         tree <- paste0(tree)

     }

     tree %<>% sub("tree TREE1\\s+=\\s+\\[&R\\]\\s+", "", .)

+    tree %<>% sub("[^(]*", "", .)

     return(tree)

 }

@@ -38,6 +38,13 @@ setMethod("scale_color", signature(object="codeml"),

           })

+##' @rdname gzoom-methods

+##' @exportMethod gzoom

+setMethod("gzoom", signature(object="codeml"),

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

+              gzoom.phylo(get.tree(object), focus, subtree, widths)

+          })

+

 ##' @rdname show-methods

 ##' @exportMethod show

 setMethod("show", signature(object = "codeml"),

@@ -23,6 +23,14 @@ read.codeml_mlc <- function(mlcfile) {

         mlcfile  = mlcfile)

 }

+

+##' @rdname gzoom-methods

+##' @exportMethod gzoom

+setMethod("gzoom", signature(object="codeml_mlc"),

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

+              gzoom.phylo(get.tree(object), focus, subtree, widths)

+          })

+

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

 setMethod("groupOTU", signature(object="codeml_mlc"),

@@ -69,7 +69,7 @@ ggtree <- function(tr, showDistance=FALSE, layout="phylogram", ...) {

 ##' tr <- rtree(10)

 ##' require(ggplot2)

 ##' ggplot(tr) + geom_tree()

-geom_tree <- function(layout="phylogram", color="black", linetype="solid", size=1, ...) {

+geom_tree <- function(layout="phylogram", color="black", linetype="solid", size=0.5, ...) {

     x <- y <- parent <- NULL

     if (layout == "phylogram" || layout == "fan") {

         if (length(color) != 1) {

@@ -86,17 +86,41 @@ geom_tree <- function(layout="phylogram", color="black", linetype="solid", size=

                          y    = c(y,         y[parent]),

                          yend = c(y,         y)),

                      color = color,

-                     linetype = linetype, ...)

+                     linetype = linetype,

+                     size = size, ...)

     } else if (layout == "cladogram" || layout == "unrooted") {

         geom_segment(aes(x    = x[parent],

                          xend = x,

                          y    = y[parent],

                          yend = y),

                      color = color,

-                     linetype = linetype, ...)

+                     linetype = linetype,

+                     size = size, ...)

     }

 }

+##' hilight clade with rectangle

+##'

+##' 

+##' @title geom_hilight 

+##' @param tree_object supported tree object

+##' @param node internal node

+##' @param ... additional parameters

+##' @return ggplot layer

+##' @importFrom ape extract.clade

+##' @export

+##' @author Guangchuang Yu

+geom_hilight <- function(tree_object, node, ...) {

+    clade <- extract.clade(get.tree(tree_object), node)

+    idx <- groupOTU(tree_object, clade$tip.label)

+    dd <- fortify(tree_object)

+    x <- dd[idx == 2, "x"]

+    y <- dd[idx == 2, "y"]

+    annotate("rect", xmin=min(x)-dd[node, "branch.length"]/2,

+             xmax=max(x), ymin=min(y)-0.5, ymax=max(y)+0.5, ...)

+}

+

+

 ##' add tip label layer

 ##'

 ##' 

@@ -104,6 +104,14 @@ setMethod("scale_color", signature(object="hyphy"),

               scale_color_(object, by, ...)

           })

+

+##' @rdname gzoom-methods

+##' @exportMethod gzoom

+setMethod("gzoom", signature(object="hyphy"),

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

+              gzoom.phylo(get.tree(object), focus, subtree, widths)

+          })

+

 ##' @rdname show-methods

 ##' @exportMethod show

 setMethod("show", signature(object = "hyphy"),

@@ -60,6 +60,14 @@ read.paml_rst <- function(rstfile, tip.fasfile = NULL) {

     set.paml_rst_(res)

 }

+

+##' @rdname gzoom-methods

+##' @exportMethod gzoom

+setMethod("gzoom", signature(object="paml_rst"),

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

+              gzoom.phylo(get.tree(object), focus, subtree, widths)

+          })

+

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

 setMethod("groupOTU", signature(object="paml_rst"),

new file mode 100644

@@ -0,0 +1,49 @@

+##' @rdname get.tree-methods

+##' @exportMethod get.tree

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

+          function(object, ...) {

+              return(object)

+          })

+

+##' @rdname scale_color-methods

+##' @exportMethod scale_color

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

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

+              scale_color_(object, by, ...)

+          })

+

+

+##' @rdname groupOTU-methods

+##' @exportMethod groupOTU

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

+          function(object, focus) {

+              groupOTU.phylo(object, focus)

+          })

+

+

+##' group OTU

+##'

+##' 

+##' @title groupOTU.phylo

+##' @param phy tree object

+##' @param focus tip list

+##' @return cluster index

+##' @author ygc

+groupOTU.phylo <- function(phy, focus) {

+    if ( is(focus, "list") ) {

+        for (i in 1:length(focus)) {

+            phy <- gfocus(phy, focus[[i]])

+        } 

+    } else {

+        phy <- gfocus(phy, focus)

+    }

+    attr(phy, "focus")

+}

+

+

+##' @rdname gzoom-methods

+##' @exportMethod gzoom

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

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

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

+          })

@@ -1,9 +1,3 @@

-##' @rdname scale_color-methods

-##' @exportMethod scale_color

-setMethod("scale_color", signature(object="phylo"),

-          function(object, by, ...) {

-              scale_color_(object, by, ...)

-          })

 ##' @importFrom colorspace rainbow_hcl

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

@@ -18,12 +12,8 @@ scale_color_ <- function(phylo, by, low=NULL, high=NULL, na.color=NULL, default.

     idx <- sapply(vals, getIdx, min(vals, na.rm=TRUE), max(vals, na.rm=TRUE))

     df$color <- cols[idx]

-    if ( is(phylo, "phylo")) {

-        tree <- phylo

-    } else {

-        tree <- get.tree(phylo)

-    }

-

+    tree <- get.tree(phylo)

+    

     if (is.null(na.color)) {

         nodes <- getNodes_by_postorder(tree)

         for (curNode in nodes) {

@@ -52,37 +42,10 @@ scale_color_ <- function(phylo, by, low=NULL, high=NULL, na.color=NULL, default.

 }

-##' @rdname groupOTU-methods

-##' @exportMethod groupOTU

-setMethod("groupOTU", signature(object="phylo"),

-          function(object, focus) {

-              groupOTU.phylo(object, focus)

-          })

-

-

 groupOTU_ <- function(object, focus) {

     groupOTU.phylo(get.tree(object), focus)

 }

-##' group OTU

-##'

-##' 

-##' @title groupOTU.phylo

-##' @param phy tree object

-##' @param focus tip list

-##' @return cluster index

-##' @author ygc

-groupOTU.phylo <- function(phy, focus) {

-    if ( is(focus, "list") ) {

-        for (i in 1:length(focus)) {

-            phy <- gfocus(phy, focus[[i]])

-        } 

-    } else {

-        phy <- gfocus(phy, focus)

-    }

-    attr(phy, "focus")

-}

-

 ##' @importFrom ape which.edge

 gfocus <- function(phy, focus) {

     if (is.character(focus)) {

@@ -121,13 +84,12 @@ gfocus <- function(phy, focus) {

 ##' @importFrom ggplot2 xlim

 ##' @importFrom ggplot2 scale_color_manual

 ##' @importFrom ape drop.tip

-##' @export

 ##' @author ygc

 ##' @examples

 ##' require(ape)

 ##' data(chiroptera)

 ##' gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label))

-gzoom <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) {

+gzoom.phylo <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) {

     if (is.character(focus)) {

         focus <- which(phy$tip.label %in% focus)

     }

@@ -136,9 +98,8 @@ gzoom <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) {

     foc <- attr(phy, "focus")

     cols <- c("black", "red")[foc]

-    

-    p1 <- ggplot(phy) + geom_tree(colour=cols) +

-        xlab("") + ylab("") + theme_tree()

+

+    p1 <- ggtree(phy, color=cols)

     subtr <- drop.tip(phy, phy$tip.label[-focus],

                       subtree=subtree, rooted=TRUE)

new file mode 100644

@@ -0,0 +1,25 @@

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

+% Please edit documentation in R/ggtree.R

+\name{geom_hilight}

+\alias{geom_hilight}

+\title{geom_hilight}

+\usage{

+geom_hilight(tree_object, node, ...)

+}

+\arguments{

+\item{tree_object}{supported tree object}

+

+\item{node}{internal node}

+

+\item{...}{additional parameters}

+}

+\value{

+ggplot layer

+}

+\description{

+hilight clade with rectangle

+}

+\author{

+Guangchuang Yu

+}

+

@@ -5,7 +5,7 @@

 \title{geom_tree}

 \usage{

 geom_tree(layout = "phylogram", color = "black", linetype = "solid",

-  size = 1, ...)

+  size = 0.5, ...)

 }

 \arguments{

 \item{layout}{one of phylogram, cladogram}

@@ -1,5 +1,5 @@

 % Generated by roxygen2 (4.1.0): do not edit by hand

-% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/jplace.R, R/paml_rst.R

+% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/jplace.R, R/paml_rst.R, R/phylo.R

 \docType{methods}

 \name{get.tree}

 \alias{get.tree}

@@ -9,6 +9,7 @@

 \alias{get.tree,hyphy-method}

 \alias{get.tree,jplace-method}

 \alias{get.tree,paml_rst-method}

+\alias{get.tree,phylo-method}

 \title{get.tree method}

 \usage{

 get.tree(object, ...)

@@ -24,6 +25,8 @@ get.tree(object, ...)

 \S4method{get.tree}{jplace}(object)

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

+

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

 }

 \arguments{

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

@@ -1,5 +1,5 @@

 % Generated by roxygen2 (4.1.0): do not edit by hand

-% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/jplace.R, R/paml_rst.R, R/tree.R

+% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/jplace.R, R/paml_rst.R, R/phylo.R

 \docType{methods}

 \name{groupOTU}

 \alias{groupOTU}

@@ -1,5 +1,5 @@

 % Generated by roxygen2 (4.1.0): do not edit by hand

-% Please edit documentation in R/tree.R

+% Please edit documentation in R/phylo.R

 \name{groupOTU.phylo}

 \alias{groupOTU.phylo}

 \title{groupOTU.phylo}

new file mode 100644

@@ -0,0 +1,49 @@

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

+% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/paml_rst.R, R/phylo.R

+\docType{methods}

+\name{gzoom}

+\alias{gzoom}

+\alias{gzoom,beast-method}

+\alias{gzoom,codeml-method}

+\alias{gzoom,codeml_mlc-method}

+\alias{gzoom,hyphy-method}

+\alias{gzoom,paml_rst-method}

+\alias{gzoom,phylo-method}

+\title{gzoom method}

+\usage{

+gzoom(object, focus, subtree = FALSE, widths = c(0.3, 0.7))

+

+\S4method{gzoom}{beast}(object, focus, subtree = FALSE, widths = c(0.3,

+  0.7))

+

+\S4method{gzoom}{codeml}(object, focus, subtree = FALSE, widths = c(0.3,

+  0.7))

+

+\S4method{gzoom}{codeml_mlc}(object, focus, subtree = FALSE, widths = c(0.3,

+  0.7))

+

+\S4method{gzoom}{hyphy}(object, focus, subtree = FALSE, widths = c(0.3,

+  0.7))

+

+\S4method{gzoom}{paml_rst}(object, focus, subtree = FALSE, widths = c(0.3,

+  0.7))

+

+\S4method{gzoom}{phylo}(object, focus, subtree = FALSE, widths = c(0.3,

+  0.7))

+}

+\arguments{

+\item{object}{supported tree objects}

+

+\item{focus}{selected tips}

+

+\item{subtree}{logical}

+

+\item{widths}{widths}

+}

+\value{

+figure

+}

+\description{

+gzoom method

+}

+

similarity index 82%

rename from man/gzoom.Rd

rename to man/gzoom.phylo.Rd

@@ -1,10 +1,10 @@

 % Generated by roxygen2 (4.1.0): do not edit by hand

 % Please edit documentation in R/tree.R

-\name{gzoom}

-\alias{gzoom}

+\name{gzoom.phylo}

+\alias{gzoom.phylo}

 \title{gzoom}

 \usage{

-gzoom(phy, focus, subtree = FALSE, widths = c(0.3, 0.7))

+gzoom.phylo(phy, focus, subtree = FALSE, widths = c(0.3, 0.7))

 }

 \arguments{

 \item{phy}{phylo object}

@@ -1,5 +1,5 @@

 % Generated by roxygen2 (4.1.0): do not edit by hand

-% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/jplace.R, R/paml_rst.R, R/tree.R

+% Please edit documentation in R/AllGenerics.R, R/beast.R, R/codeml.R, R/codeml_mlc.R, R/hyphy.R, R/jplace.R, R/paml_rst.R, R/phylo.R

 \docType{methods}

 \name{scale_color}

 \alias{scale_color}

@@ -533,6 +533,30 @@ library("ggtree")

 gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label))

 ```

+## highlight clade

+

+`r Githubpkg("GuangchuangYu/ggtree")` implements _`geom_hilight`_ layer, that accepts tree object and internal node number and add a layer of rectangle to hilight the selected clade.

+

+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}

+nwk <- system.file("extdata", "sample.nwk", package="ggtree")

+tree <- read.tree(nwk)

+

+ggtree(tree) + geom_text(aes(label=node))

+```

+

+User can use _`geom_text`_ to display all the node numbers, and select interesting clade to hilight.

+

+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}

+ggtree(tree) + geom_hilight(tree, node=21, fill="steelblue", alpha=.6) +

+     geom_hilight(tree, node=17, fill="darkgreen", alpha=.6)

+```

+

+

+```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}

+ggtree(tree, layout="fan") + geom_hilight(tree, node=21, fill="steelblue", alpha=.6) +

+     geom_hilight(tree, node=17, fill="darkgreen", alpha=.6)

+```

+

 ## scale color based on numerical attribute

 `r Githubpkg("GuangchuangYu/ggtree")` provides _`scale_color`_ to calculate colors based on numerical attribute of the tree. The output can be used to color lines and annotation text.

@@ -553,10 +577,6 @@ ggtree(ml, color=cols) + geom_text(aes(label=label), color=cols, hjust=.25)

 `r Githubpkg("GuangchuangYu/ggtree")` provides _`groupOTU`_ function to group tips and all their related ancestors. It return a cluster index of each line segment in the tree view.

 ```{r}

-nwk <- system.file("extdata", "sample.nwk", package="ggtree")

-tree <- read.tree(nwk)

-

-

 cluster_index <- groupOTU(tree, focus=c("A", "B", "C", "D", "E"))

 cluster_index

 ```

@@ -597,12 +617,6 @@ ggtree(tree, color=cols[cls_ind], linetype=linetype[cls_ind], size=size[cls_ind]

 All the tree classes defined in `r Githubpkg("GuangchuangYu/ggtree")`, including _`beast`_, _`paml_rst`_, _`codeml_mlc`_, _`codeml`_, _`hyphy`_ and _`jplace`_ are all supported.

-For example:

-```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}

-ind <- groupOTU(ml, c("A", "B", "F", "M"))

-cols <- c("black", "blue")

-ggtree(ml, color=cols[ind])

-```

 ### iris example

@@ -623,11 +637,9 @@ ggtree(tree_iris, color=cols[cls_ind]) +

 ```

 <!--

-```

-ggtree(tree_iris) + geom_text(aes(label=node))

-```

 By adding a layer of internal node number, we can easily extract tip labels of a particular clade by the _`get.offspring.tip`_ function.

 ```{r}

+ggtree(tree_iris) + geom_text(aes(label=node))

 cl1 <- get.offspring.tip(tree_iris, 242)

 cl2 <- get.offspring.tip(tree_iris, 152) 

 cl2 <- cl2[!cl2 %in% cl1]