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

 Package: ggtree

 Type: Package

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

-Version: 1.1.12

+Version: 1.1.13

 Author: Guangchuang Yu and Tommy Tsan-Yuk Lam

 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>

 Description: ggtree extends the ggplot2 plotting system which implemented the

@@ -141,6 +141,7 @@ importFrom(ggplot2,theme_bw)

 importFrom(ggplot2,xlab)

 importFrom(ggplot2,xlim)

 importFrom(ggplot2,ylab)

+importFrom(ggplot2,ylim)

 importFrom(grDevices,col2rgb)

 importFrom(grDevices,rgb)

 importFrom(grid,linesGrob)

@@ -1,3 +1,8 @@

+CHANGES IN VERSION 1.1.13

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

+ o better implementation of geom_tiplab for accepting aes mapping and auto add align dotted line <2015-08-01, Sat>

+ o open group_name parameter of groupOTU/groupClade to user <2015-08-01, Sat>

+ 

 CHANGES IN VERSION 1.1.12

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

  o update vignette according to the changes <2015-07-31, Fri>

@@ -110,9 +110,10 @@ setGeneric("get.tipseq", function(object, ...) standardGeneric("get.tipseq"))

 ##' @param object supported objects, including phylo, paml_rst,

 ##'               codeml_mlc, codeml, jplace, beast, hyphy

 ##' @param focus a vector of tip (label or number) or a list of tips.

+##' @param group_name name of the group, 'group' by default

 ##' @return group index

 ##' @export

-setGeneric("groupOTU", function(object, focus) standardGeneric("groupOTU"))

+setGeneric("groupOTU", function(object, focus, group_name="group") standardGeneric("groupOTU"))

 ##' @docType methods

 ##' @name groupClade

@@ -121,9 +122,10 @@ setGeneric("groupOTU", function(object, focus) standardGeneric("groupOTU"))

 ##' @param object supported objects, including phylo, paml_rst,

 ##'               codeml_mlc, codeml, jplace, beast, hyphy

 ##' @param node a internal node or a vector of internal nodes

+##' @param group_name name of the group, 'group' by default

 ##' @return group index

 ##' @export

-setGeneric("groupClade", function(object, node) standardGeneric("groupClade"))

+setGeneric("groupClade", function(object, node, group_name="group") standardGeneric("groupClade"))

 ##' @docType methods

@@ -102,16 +102,16 @@ setMethod("show", signature(object = "beast"),

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU_(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU_(object, focus, group_name)

           }

           )

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

 setMethod("groupClade", signature(object="beast"),

-          function(object, node) {

-              groupClade_(object, node)

+          function(object, node, group_name="group") {

+              groupClade_(object, node, group_name)

           })

 ##' @rdname scale_color-methods

@@ -25,16 +25,16 @@ read.codeml <- function(rstfile, mlcfile) {

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU_(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU_(object, focus, group_name)

           }

           )

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

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

-          function(object, node) {

-              groupClade_(object, node)

+          function(object, node, group_name="group") {

+              groupClade_(object, node, group_name)

           }

           )

@@ -34,16 +34,16 @@ setMethod("gzoom", signature(object="codeml_mlc"),

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU_(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU_(object, focus, group_name)

           }

           )

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

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

-          function(object, node) {

-              groupClade_(object, node)

+          function(object, node, group_name="group") {

+              groupClade_(object, node, group_name)

           }

           )

@@ -156,8 +156,11 @@ geom_hilight <- function(tree_object, node, ...) {

 ##'

 ##' 

 ##' @title geom_tiplab 

-##' @param align align tip lab or not, logical

+##' @param mapping aes mapping

 ##' @param hjust horizontal adjustment

+##' @param align align tip lab or not, logical

+##' @param linetype linetype for adding line if align = TRUE

+##' @param line.size line size of line if align = TRUE

 ##' @param ... additional parameter

 ##' @return tip label layer

 ##' @importFrom ggplot2 geom_text

@@ -167,13 +170,39 @@ geom_hilight <- function(tree_object, node, ...) {

 ##' require(ape)

 ##' tr <- rtree(10)

 ##' ggtree(tr) + geom_tiplab()

-geom_tiplab <- function(align=FALSE, hjust=0, ...) {

+geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dotted", line.size=1, ...) {

     x <- y <- label <- isTip <- NULL

     if (align == TRUE) {

-        geom_text(aes(x=max(x)+ diff(range(x))/200, label=label), subset=.(isTip), hjust=hjust, ...)

+        self_mapping <- aes(x = max(x) + diff(range(x))/200, label = label)

+    }

+    else {

+        self_mapping <- aes(x = x + diff(range(x))/200, label = label)

+    }

+

+    if (is.null(mapping)) {

+        text_mapping <- self_mapping          

     } else {

-        geom_text(aes(x = x + diff(range(x))/200, label=label), subset=.(isTip), hjust=hjust, ...)

+        text_mapping <- modifyList(self_mapping, mapping)

     }

+

+    dot_mapping <- NULL

+    if (align && (!is.na(linetype) || !is.null(linetype))) {

+        dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y)

+        if (!is.null(mapping)) {

+            dot_mapping <- modifyList(dot_mapping, mapping)

+        }

+    } 

+    

+    list(

+        geom_text(mapping=text_mapping, 

+                  subset = .(isTip),

+                  hjust = hjust, ...),

+        if (!is.null(dot_mapping))

+            geom_segment(mapping=dot_mapping,

+                         subset=.(isTip),

+                         linetype = linetype,

+                         size = line.size, ...)

+        )

 }

@@ -621,6 +650,7 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) {

 ##' @return tree view

 ##' @importFrom grid linesGrob

 ##' @importFrom grid textGrob

+##' @importFrom ggplot2 ylim

 ##' @export

 ##' @author Guangchuang Yu

 add_legend <- function(p, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {

@@ -688,7 +718,7 @@ annotation_clade <- function(tree_view, node, label, bar.size=2, font.size=4, of

     sp.df <- df[c(sp, node), ]

     y <- sp.df$y

-    mx <- max(p$data$x) + offset

+    mx <- max(df$x) + offset

     annotation_clade_internal(tree_view, mx, y, label, bar.size, font.size, offset.text, ...)

 }

@@ -715,7 +745,7 @@ annotation_clade2 <- function(tree_view, tip1, tip2, label, bar.size=2, font.siz

     y <- c(df[which(tip1 == df$label | tip1 == df$node), "y"],

            df[which(tip2 == df$label | tip2 == df$node), "y"])

-    mx <- max(p$data$x) + offset

+    mx <- max(df$x) + offset

     annotation_clade_internal(tree_view, mx, y, label, bar.size, font.size, offset.text, ...)

 }

@@ -732,50 +762,31 @@ annotation_clade_internal <- function(tree_view, x, y, label, bar.size, font.siz

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU.ggplot(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU.ggplot(object, focus, group_name)

           })

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU.ggplot(object, focus)

+          function(object, focus, group_name) {

+              groupOTU.ggplot(object, focus, group_name)

           })

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

 setMethod("groupClade", signature(object="ggplot"),

-          function(object, node) {

-              groupClade.ggplot(object, node)

+          function(object, node, group_name) {

+              groupClade.ggplot(object, node, group_name)

           })

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

 setMethod("groupClade", signature(object="gg"),

-          function(object, node) {

-              groupClade.ggplot(object, node)

+          function(object, node, group_name) {

+              groupClade.ggplot(object, node, group_name)

           })

-

-groupClade.ggplot <- function(object, nodes) {

-    df <- object$data

-    group_name <- "group"

-    df[, group_name] <- 0

-    for (node in nodes) {

-        df <- groupClade.df(df, node, group_name)

-    }

-    df$group <- factor(df$group)

-    object$data <- df

-    return(object)

-}

-

-groupClade.df <- function(df, node, group_name) {

-    foc <- c(node, get.offspring.df(df, node))

-    idx <- match(foc, df$node)

-    df[idx, group_name] <- max(df$group) + 1

-    return(df)

-}

@@ -92,16 +92,16 @@ setMethod("plot", signature(x = "hyphy"),

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU_(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU_(object, focus, group_name)

           }

           )

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

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

-          function(object, node) {

-              groupClade_(object, node)

+          function(object, node, group_name="group") {

+              groupClade_(object, node, group_name)

           }

           )

@@ -29,16 +29,16 @@ read.jplace <- function(file) {

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU_(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU_(object, focus, group_name)

           }

           )

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

 setMethod("groupClade", signature(object="jplace"),

-          function(object, node) {

-              groupClade_(object, node)

+          function(object, node, group_name="group") {

+              groupClade_(object, node, group_name)

           }

           )

@@ -72,16 +72,16 @@ setMethod("gzoom", signature(object="paml_rst"),

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU_(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU_(object, focus, group_name)

           }

           )

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

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

-          function(object, node) {

-              groupClade_(object, node)

+          function(object, node, group_name="group") {

+              groupClade_(object, node, group_name)

           }

           )

@@ -16,8 +16,8 @@ setMethod("scale_color", signature(object="phylo"),

 ##' @rdname groupOTU-methods

 ##' @exportMethod groupOTU

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

-          function(object, focus) {

-              groupOTU.phylo(object, focus)

+          function(object, focus, group_name="group") {

+              groupOTU.phylo(object, focus, group_name)

           })

@@ -27,6 +27,7 @@ setMethod("groupOTU", signature(object="phylo"),

 ##' @title groupOTU.phylo

 ##' @param phy tree object

 ##' @param focus tip list

+##' @param group_name name of the group

 ##' @return phylo object

 ##' @author ygc

 groupOTU.phylo <- function(phy, focus, group_name="group") {

@@ -45,11 +46,11 @@ groupOTU.phylo <- function(phy, focus, group_name="group") {

 ##' @rdname groupClade-methods

 ##' @exportMethod groupClade

 setMethod("groupClade", signature(object="phylo"),

-          function(object, node) {

-              groupClade.phylo(object, node)

+          function(object, node, group_name="group") {

+              groupClade.phylo(object, node, group_name)

           })

-groupClade.phylo <- function(object, node) {

+groupClade.phylo <- function(object, node, group_name) {

     if (length(node) == 1) {

         clade <- extract.clade(object, node)

         tips <- clade$tip.label

@@ -60,7 +61,7 @@ groupClade.phylo <- function(object, node) {

         })

     }

-    groupOTU.phylo(object, tips, "group")

+    groupOTU.phylo(object, tips, group_name)

 }

@@ -55,20 +55,20 @@ scale_color_ <- function(phylo, by, low=NULL, high=NULL, na.color=NULL, default.

     return(color)

 }

-groupClade_ <- function(object, node) {

+groupClade_ <- function(object, node, group_name) {

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

-        object <- groupClade.phylo(object, node)

+        object <- groupClade.phylo(object, node, group_name)

     } else {

-        object@phylo <- groupClade.phylo(get.tree(object), node)

+        object@phylo <- groupClade.phylo(get.tree(object), node, group_name)

     }

     return(object)

 }

-groupOTU_ <- function(object, focus) {

+groupOTU_ <- function(object, focus, group_name) {

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

-        object <- groupOTU.phylo(object, focus)

+        object <- groupOTU.phylo(object, focus, group_name)

     } else {

-        object@phylo <- groupOTU.phylo(get.tree(object), focus)

+        object@phylo <- groupOTU.phylo(get.tree(object), focus, group_name)

     }

     return(object)

 }

@@ -454,8 +454,14 @@ fortify.phylo <- function(model, data, layout="phylogram",

     if(layout == "cladogram") {

         df <- add_angle_cladogram(df)

     }

-    if (!is.null(attr(tree, "group"))) {

-        df$group <- attr(tree, "group")

+    aa <- names(attributes(tree))

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

+    if (length(group) > 0) {

+        ## groupOTU & groupClade

+        group_info <- attr(tree, group)

+        if (length(group_info) == nrow(df)) {

+            df[, group] <- group_info

+        }

     }

     return(df)

 }

@@ -527,7 +533,7 @@ as.data.frame.phylo_ <- function(x, layout="phylogram",

     if (layout == "fan") {

         idx <- match(1:N, order(res$y))

-        angle <- -360/(N+1) * (1:N + 1)

+        angle <- -360/(N+1) * 1:N

         angle <- angle[idx]

         res$angle <- angle

     } 

@@ -471,9 +471,28 @@ getCols <- function (n) {

 }

-groupOTU.ggplot <- function(object, focus) {

+

+groupClade.ggplot <- function(object, nodes, group_name) {

+    df <- object$data

+    df[, group_name] <- 0

+    for (node in nodes) {

+        df <- groupClade.df(df, node, group_name)

+    }

+    df[, group_name] <- factor(df[, group_name])

+    object$data <- df

+    return(object)

+}

+

+groupClade.df <- function(df, node, group_name) {

+    foc <- c(node, get.offspring.df(df, node))

+    idx <- match(foc, df$node)

+    df[idx, group_name] <- max(df[, group_name]) + 1

+    return(df)

+}

+

+

+groupOTU.ggplot <- function(object, focus, group_name) {

     df <- object$data

-    group_name <- "group"

     df[, group_name] <- 0

     object$data <- groupOTU.df(df, focus, group_name)

     return(object)     

@@ -488,14 +507,14 @@ groupOTU.df <- function(df, focus, group_name) {

     } else {

         df <- gfocus.df(df, focus, group_name)

     }

-    df$group <- factor(df$group)

+    df[, group_name] <- factor(df[, group_name])

     return(df)

 }

 gfocus.df <- function(df, focus, group_name) {

     focus <- df$node[which(df$label %in% focus)]

     if (length(focus) == 1) {

-        df[match(focus, df$node), group_name] <- max(df(df$group)) + 1

+        df[match(focus, df$node), group_name] <- max(df(df[, group_name])) + 1

         return(df)

     }

@@ -509,7 +528,7 @@ gfocus.df <- function(df, focus, group_name) {

         foc <- c(foc, comAnc[1])

     }

     idx <- match(foc, df$node)

-    df[idx, group_name] <- max(df$group) + 1

+    df[idx, group_name] <- max(df[, group_name]) + 1

     return(df)

 }

@@ -4,13 +4,20 @@

 \alias{geom_tiplab}

 \title{geom_tiplab}

 \usage{

-geom_tiplab(align = FALSE, hjust = 0, ...)

+geom_tiplab(mapping = NULL, hjust = 0, align = FALSE,

+  linetype = "dotted", line.size = 1, ...)

 }

 \arguments{

-\item{align}{align tip lab or not, logical}

+\item{mapping}{aes mapping}

 \item{hjust}{horizontal adjustment}

+\item{align}{align tip lab or not, logical}

+

+\item{linetype}{linetype for adding line if align = TRUE}

+

+\item{line.size}{line size of line if align = TRUE}

+

 \item{...}{additional parameter}

 }

 \value{

@@ -14,31 +14,33 @@

 \alias{groupClade,phylo-method}

 \title{groupClade method}

 \usage{

-groupClade(object, node)

+groupClade(object, node, group_name = "group")

-\S4method{groupClade}{beast}(object, node)

+\S4method{groupClade}{beast}(object, node, group_name = "group")

-\S4method{groupClade}{codeml}(object, node)

+\S4method{groupClade}{codeml}(object, node, group_name = "group")

-\S4method{groupClade}{codeml_mlc}(object, node)

+\S4method{groupClade}{codeml_mlc}(object, node, group_name = "group")

-\S4method{groupClade}{ggplot}(object, node)

+\S4method{groupClade}{ggplot}(object, node, group_name = "group")

-\S4method{groupClade}{gg}(object, node)

+\S4method{groupClade}{gg}(object, node, group_name = "group")

-\S4method{groupClade}{hyphy}(object, node)

+\S4method{groupClade}{hyphy}(object, node, group_name = "group")

-\S4method{groupClade}{jplace}(object, node)

+\S4method{groupClade}{jplace}(object, node, group_name = "group")

-\S4method{groupClade}{paml_rst}(object, node)

+\S4method{groupClade}{paml_rst}(object, node, group_name = "group")

-\S4method{groupClade}{phylo}(object, node)

+\S4method{groupClade}{phylo}(object, node, group_name = "group")

 }

 \arguments{

 \item{object}{supported objects, including phylo, paml_rst,

 codeml_mlc, codeml, jplace, beast, hyphy}

 \item{node}{a internal node or a vector of internal nodes}

+

+\item{group_name}{name of the group, 'group' by default}

 }

 \value{

 group index

@@ -14,31 +14,33 @@

 \alias{groupOTU,phylo-method}

 \title{groupOTU method}

 \usage{

-groupOTU(object, focus)

+groupOTU(object, focus, group_name = "group")

-\S4method{groupOTU}{beast}(object, focus)

+\S4method{groupOTU}{beast}(object, focus, group_name = "group")

-\S4method{groupOTU}{codeml}(object, focus)

+\S4method{groupOTU}{codeml}(object, focus, group_name = "group")

-\S4method{groupOTU}{codeml_mlc}(object, focus)

+\S4method{groupOTU}{codeml_mlc}(object, focus, group_name = "group")

-\S4method{groupOTU}{ggplot}(object, focus)

+\S4method{groupOTU}{ggplot}(object, focus, group_name = "group")

-\S4method{groupOTU}{gg}(object, focus)

+\S4method{groupOTU}{gg}(object, focus, group_name = "group")

-\S4method{groupOTU}{hyphy}(object, focus)

+\S4method{groupOTU}{hyphy}(object, focus, group_name = "group")

-\S4method{groupOTU}{jplace}(object, focus)

+\S4method{groupOTU}{jplace}(object, focus, group_name = "group")

-\S4method{groupOTU}{paml_rst}(object, focus)

+\S4method{groupOTU}{paml_rst}(object, focus, group_name = "group")

-\S4method{groupOTU}{phylo}(object, focus)

+\S4method{groupOTU}{phylo}(object, focus, group_name = "group")

 }

 \arguments{

 \item{object}{supported objects, including phylo, paml_rst,

 codeml_mlc, codeml, jplace, beast, hyphy}

 \item{focus}{a vector of tip (label or number) or a list of tips.}

+

+\item{group_name}{name of the group, 'group' by default}

 }

 \value{

 group index

@@ -10,6 +10,8 @@ groupOTU.phylo(phy, focus, group_name = "group")

 \item{phy}{tree object}

 \item{focus}{tip list}

+

+\item{group_name}{name of the group}

 }

 \value{

 phylo object

@@ -224,6 +224,17 @@ library("ggtree")

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

 ```

+## color tree

+

+In `r Githubpkg("GuangchuangYu/ggtree")`, coloring phylogenetic tree is easy, by using `aes(color=VAR)` to map the color of tree based on a specific variable (numeric and category are both supported).

+

+```{r fig.width=5, fig.height=5}

+ggtree(tree, aes(color=branch.length)) +

+    scale_color_continuous(low="green", high="red") +

+        theme(legend.position="bottom")

+```

+User can use any feature, including clade posterior and dN/dS _etc._, to scale the color of the tree.

+

 ## annotate clade

 `r Githubpkg("GuangchuangYu/ggtree")` implements _`annotation_clade`_ and _`annotation_clade2`_ functions to annotate a selected clade with a bar indicating that clade with a corresponding label.

@@ -617,12 +628,12 @@ merged_tree <- merge_tree(beast_tree, codeml_tree)

 merged_tree

 ```

-After merging, all evidences inferred from different tools can be used to annotate the tree simultaneously. In this example, we used 'dN/dS' inferred by CodeML to color the tree and annotate the tree with 'posterior' inferred by BEAST.

+After merging, all evidences inferred from different tools can be used to annotate the tree simultaneously. In this example, we used 'dN' inferred by CodeML to color the tree and annotate the tree with 'posterior' inferred by BEAST.

 ```{r fig.width=20, fig.height=26, warning=FALSE}

-ggtree(merged_tree, aes(color=dN_vs_dS), time_scale=TRUE, ndigits = 3) +

+ggtree(merged_tree, aes(color=dN), time_scale=TRUE, ndigits = 3) +

     geom_text(aes(label=posterior), vjust=.1, hjust=-.1, size=5) + theme_tree2() +

-        scale_color_continuous(low="steelblue", high="red")

+        scale_color_continuous(low="green", high="red") + theme(legend.position="right")

 ```