@@ -1,3 +1,4 @@

+

 Justin Silverman

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

 + `geom_balance`

@@ -2,7 +2,7 @@ Package: ggtree

 Type: Package

 Title: an R package for visualization and annotation of phylogenetic trees with

     their covariates and other associated data

-Version: 1.9.0

+Version: 1.9.2

 Authors@R: c(

 	   person("Guangchuang", "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph")),

 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com", rol = c("aut", "ths")),

@@ -1,3 +1,13 @@

+CHANGES IN VERSION 1.9.2

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

+ o gheatmap support handling collapsed tree <2017-06-29, Thu>

+   + https://github.com/GuangchuangYu/ggtree/issues/137

+

+CHANGES IN VERSION 1.9.1

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

+ o now mapping parameter will passed to segment layer in geom_tiplab(align=T) <2017-06-19, Mon>

+ o geom_cladelabel support `angle="auto"` for circular layout tree <2017-05-05, Fri>

+

 CHANGES IN VERSION 1.8.0

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

  o BioC 3.5 release <2017-04-26, Wed>

deleted file mode 100644

@@ -1,281 +0,0 @@

-

-## ##' read beast output

-## ##'

-## ##'

-## ##' @title read.beast

-## ##' @param file beast file

-## ##' @return \code{beast} object

-## ##' @importFrom ape read.nexus

-## ##' @export

-## ##' @author Guangchuang Yu \url{http://ygc.name}

-## ##' @examples

-## ##' file <- system.file("extdata/BEAST", "beast_mcc.tree", package="ggtree")

-## ##' read.beast(file)

-## read.beast <- function(file) {

-##     translation <- read.trans_beast(file)

-##     treetext <- read.treetext_beast(file)

-##     stats <- read.stats_beast(file)

-##     phylo <- read.nexus(file)

-

-##     if (length(treetext) == 1) {

-##         obj <- BEAST(file, treetext, translation, stats, phylo)

-##     } else {

-##         obj <- lapply(seq_along(treetext), function(i) {

-##             BEAST(file, treetext[i], translation, stats[[i]], phylo[[i]])

-##         })

-##         class(obj) <- "beastList"

-##     }

-##     return(obj)

-## }

-

-

-## BEAST <- function(file, treetext, translation, stats, phylo) {

-##     stats$node %<>% gsub("\"*'*", "", .)

-

-##     fields <- sub("_lower|_upper", "", names(stats)) %>% unique

-##     fields %<>% `[`(.!="node")

-

-##     phylo <- remove_quote_in_tree_label(phylo)

-

-##     obj <- new("beast",

-##                fields      = fields,

-##                treetext    = treetext,

-##                phylo       = phylo,

-##                translation = translation,

-##                stats       = stats,

-##                file        = filename(file)

-##                )

-##     return(obj)

-## }

-

-## remove_quote_in_tree_label <- function(phylo) {

-##     if (!is.null(phylo$node.label)) {

-##         phylo$node.label %<>% gsub("\"*'*", "", .)

-##     }

-##     if ( !is.null(phylo$tip.label)) {

-##         phylo$tip.label %<>% gsub("\"*'*", "", .)

-##     }

-##     return(phylo)

-## }

-

-

-## ##' @rdname get.fields-methods

-## ##' @exportMethod get.fields

-## setMethod("get.fields", signature(object="beast"),

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

-##               get.fields.tree(object)

-##           }

-##           )

-

-

-## read.treetext_beast <- function(file) {

-##     beast <- readLines(file)

-

-##     ii <- grep("[Bb]egin trees;", beast)

-##     jj <- grep("[Ee]nd;", beast)

-##     jj <- jj[jj > max(ii)][1]

-##     jj <- c(ii[-1], jj)

-

-##     trees <- sapply(seq_along(ii), function(i) {

-##         tree <- beast[(ii[i]+1):(jj[i]-1)]

-##         tree <- tree[grep("\\s*[Tt]ree", tree)]

-##         ## if (length(tree) > 1) {

-##         ##     tree <- paste0(tree, collapse='')

-##         ## }

-##         sub("[^(]*", "", tree)

-##     })

-

-##     return(trees)

-## }

-

-## read.trans_beast <- function(file) {

-##     beast <- readLines(file)

-##     i <- grep("TRANSLATE", beast, ignore.case = TRUE)

-##     if (length(i) == 0) {

-##         return(matrix())

-##     }

-##     end <- grep(";", beast)

-##     j <- end[end %>% `>`(i) %>% which %>% `[`(1)]

-##     trans <- beast[(i+1):j]

-##     trans %<>% gsub("\\t+", "", .)

-##     trans %<>% gsub(",|;", "", .)

-##     trans %<>% `[`(nzchar(trans))

-##     ## remove quote if strings were quoted

-##     trans %<>% gsub("'|\"", "",.)

-##     trans %<>% sapply(., strsplit, split="\\s+")

-##     trans %<>% do.call(rbind, .)

-##     ## trans is a matrix

-##     return(trans)

-## }

-

-

-## read.stats_beast <- function(file) {

-##     beast <- readLines(file)

-##     trees <- read.treetext_beast(file)

-##     if (length(trees) == 1) {

-##         return(read.stats_beast_internal(beast, trees))

-##     }

-##     lapply(trees, read.stats_beast_internal, beast=beast)

-## }

-

-## read.stats_beast_internal <- function(beast, tree) {

-##     tree2 <- gsub("\\[[^\\[]*\\]", "", tree)

-##     phylo <- read.tree(text = tree2)

-

-##     tree2 <- add_pseudo_nodelabel(phylo, tree2)

-

-##     ## node name corresponding to stats

-##     nn <- strsplit(tree2, split=",") %>% unlist %>%

-##         strsplit(., split="\\)") %>% unlist %>%

-##         gsub("\\(*", "", .) %>%

-##         gsub("[:;].*", "", .)

-

-##     phylo <- read.tree(text = tree2)

-##     root <- getRoot(phylo)

-##     nnode <- phylo$Nnode

-

-##     ## phylo2 <- read.nexus(file)

-##     ## treeinfo <- fortify.phylo(phylo)

-##     ## treeinfo2 <- fortify.phylo(phylo2)

-##     ## treeinfo$label2 <- NA

-##     ## treeinfo$label2[treeinfo$isTip] <- treeinfo2$node[as.numeric(treeinfo$label[treeinfo$isTip])]

-##     ## treeinfo$visited <- FALSE

-##     ## root <- getRoot(phylo2)

-##     ## treeinfo[root, "visited"] <- TRUE

-##     ## currentNode <- 1:Ntip(phylo2)

-##     ## while(any(treeinfo$visited == FALSE)) {

-##     ##     pNode <- c()

-##     ##     for (kk in currentNode) {

-##     ##         i <- which(treeinfo$label2 == kk)

-##     ##         treeinfo[i, "visited"] <- TRUE

-##     ##         j <- which(treeinfo2$node == kk)

-##     ##         ip <- treeinfo$parent[i]

-##     ##         if (ip != root) {

-##     ##             ii <- which(treeinfo$node == ip)

-##     ##             if (treeinfo$visited[ii] == FALSE) {

-##     ##                 jp <- treeinfo2$parent[j]

-##     ##                 jj <- which(treeinfo2$node == jp)

-##     ##                 treeinfo[ii, "label2"] <- treeinfo2[jj, "node"]

-##     ##                 pNode <- c(pNode, jp)

-##     ##             }

-##     ##             treeinfo[ii, "visited"] <- TRUE

-##     ##         }

-##     ##     }

-##     ##     currentNode <- unique(pNode)

-##     ## }

-##     ## treeinfo[root, "label2"] <- root

-##     ## ## convert nn to node that encoded in phylo2

-##     ## node <- treeinfo$label2[match(nn, treeinfo$label)]

-

-

-##     ####################################################

-##     ##                                                ##

-##     ##  after doing it in the hard way                ##

-##     ##  I finally figure out the following easy way   ##

-##     ##                                                ##

-##     ####################################################

-##     treeinfo <- fortify.phylo(phylo)

-

-##     if (any(grepl("TRANSLATE", beast, ignore.case = TRUE))) {

-##         label2 <- c(treeinfo[treeinfo$isTip, "label"],

-##                     root:(root+nnode-1))

-##         node <- label2[match(nn, treeinfo$label)]

-##     } else {

-##         node <- as.character(treeinfo$node[match(nn, treeinfo$label)])

-##     }

-

-##     ## stats <- unlist(strsplit(tree, "\\["))[-1]

-##     ## stats <- sub(":.+$", "", stats

-##     stats <- strsplit(tree, ":") %>% unlist

-##     names(stats) <- node

-##     stats <- stats[grep("\\[", stats)]

-##     stats <- sub("[^\\[]+\\[", "", stats)

-

-##     stats <- sub("^&", "", stats)

-##     stats <- sub("];*$", "", stats)

-

-##     stats2 <- lapply(stats, function(x) {

-##         y <- unlist(strsplit(x, ","))

-##         sidx <- grep("=\\{", y)

-##         eidx <- grep("\\}$", y)

-

-##         flag <- FALSE

-##         if (length(sidx) > 0) {

-##             flag <- TRUE

-##             SETS <- sapply(seq_along(sidx), function(k) {

-##                 p <- y[sidx[k]:eidx[k]]

-##                 gsub(".*=\\{", "", p) %>% gsub("\\}$", "", .) %>% list

-##             })

-##             names(SETS) <- gsub("=.*", "", y[sidx])

-

-##             kk <- sapply(seq_along(sidx), function(k) sidx[k]:eidx[k]) %>% unlist

-##             y <- y[-kk]

-##         }

-

-

-##         name <- gsub("=.*", "", y)

-##         val <- gsub(".*=", "", y) %>% gsub("^\\{", "", .) %>%

-##             gsub("\\}$", "", .)

-

-

-##         if (flag) {

-##             nn <- c(name, names(SETS))

-##         } else {

-##             nn <- name

-##         }

-

-##         res <- character(length(nn))

-##         names(res) <- nn

-

-##         for (i in seq_along(name)) {

-##             res[i] <- val[i]

-##         }

-##         if (flag) {

-##             j <- i

-##             for (i in seq_along(SETS)) {

-##                 res[i+j] <- SETS[i]

-##             }

-##         }

-

-##         return(res)

-##     })

-

-##     nn <- lapply(stats2, names) %>% unlist %>%

-##         unique %>% sort

-

-##     ## stats3 is a matrix

-##     stats3 <- t(sapply(stats2, function(x) {

-##         for (ii in nn[!nn %in% names(x)]) {

-##             x[ii] <- NA

-##         }

-##         x[nn]

-##     }))

-

-##     stats3 <- as.data.frame(stats3)

-##     if (nrow(stats3) == 1) {

-##         ## only has one evidence

-##         ## transpose

-##         stats3 <- data.frame(X=unlist(stats3[1,]))

-##         colnames(stats3) <- nn

-##     }

-##     colnames(stats3) <- gsub("(\\d+)%", "0.\\1", colnames(stats3))

-

-##     ## stats3$node <- node

-##     stats3$node <- names(stats)

-##     return(stats3)

-## }

-

-## add_pseudo_nodelabel <- function(phylo, treetext) {

-##     if(is.null(phylo$node.label)) {

-##         nnode <- phylo$Nnode

-##         nlab <- paste("X", 1:nnode, sep="")

-##         for (i in 1:nnode) {

-##             treetext <- sub("\\)([:;])", paste0("\\)", nlab[i], "\\1"), treetext)

-##         }

-##     }

-

-##    return(treetext)

-## }

-

-

-

@@ -69,7 +69,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,

                                         mapping=mapping, data=data, geom=geom, hjust=hjust,

                                         position=position, show.legend = show.legend,

                                         inherit.aes = inherit.aes, na.rm=na.rm,

-                                        parse = parse, ...)

+                                        parse = parse,  ...)

         }

         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,

@@ -84,7 +84,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,

                                         align=align, size=fontsize, angle=angle, color=labelcolor, family=family,

                                         mapping=mapping, data=data, geom=geom, hjust=hjust,

                                         position=position, show.legend = show.legend,

-                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse, ...)

+                                        inherit.aes = inherit.aes, na.rm=na.rm, parse=parse,  ...)

         } else {

             layer_text = stat_cladeText(node=node, label=label, offset=offset+offset.text,

@@ -92,7 +92,7 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,

                                         mapping=mapping, data=data, geom=geom, hjust=hjust,

                                         position=position, show.legend = show.legend,

                                         inherit.aes = inherit.aes, na.rm=na.rm,

-                                        parse = parse, ...)

+                                        parse = parse,  ...)

         }

         layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,

@@ -112,10 +112,10 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,

 stat_cladeText <- function(mapping=NULL, data=NULL,

                            geom="text", position="identity",

-                           node, label, offset, align, ...,

+                           node, label, offset, align, ..., angle,

                            show.legend=NA, inherit.aes=FALSE,

                            na.rm=FALSE, parse=FALSE) {

-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)

+    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, angle=~angle)

     if (is.null(mapping)) {

         mapping <- default_aes

     } else {

@@ -135,6 +135,7 @@ stat_cladeText <- function(mapping=NULL, data=NULL,

                       align  = align,

                       na.rm  = na.rm,

                       parse  = parse,

+                      angle_ = angle,

                       ...),

           check.aes = FALSE

           )

@@ -169,38 +170,45 @@ stat_cladeBar <- function(mapping=NULL, data=NULL,

 }

 StatCladeText <- ggproto("StatCladeText", Stat,

-                         compute_group = function(self, data, scales, params, node, label, offset, align) {

-                             df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03)

+                         compute_group = function(self, data, scales, params, node, label, offset, align, angle_) {

+                             df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03, angle_)

                              df$y <- mean(c(df$y, df$yend))

                              df$label <- label

                              return(df)

                          },

-                         required_aes = c("x", "y", "label")

+                         required_aes = c("x", "y", "label", "angle")

                          )

 StatCladeBar <- ggproto("StatCladBar", Stat,

                         compute_group = function(self, data, scales, params, node, offset, align) {

-                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02)

+                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02, angle=0)

                         },

                         required_aes = c("x", "y", "xend", "yend")

                         )

-get_cladelabel_position <- function(data, node, offset, align, adjustRatio) {

-    df <- get_cladelabel_position_(data, node)

+get_cladelabel_position <- function(data, node, offset, align, adjustRatio, angle="auto") {

+    df <- get_cladelabel_position_(data, node, angle)

     if (align) {

         mx <- max(data$x, na.rm=TRUE)

     } else {

         mx <- df$x

     }

+

+    angle <- df$angle

+    ## if (angle >= 90 & angle <=270) {

+    ##     angle <- angle + 180

+    ## }

+

     mx <- mx * adjustRatio + offset

-    data.frame(x=mx, xend=mx, y=df$y, yend=df$yend)

+    

+    data.frame(x=mx, xend=mx, y=df$y, yend=df$yend, angle=angle)

 }

-get_cladelabel_position_ <- function(data, node) {

+get_cladelabel_position_ <- function(data, node, angle="auto") {

     sp <- get.offspring.df(data, node)

     sp2 <- c(sp, node)

     sp.df <- data[match(sp2, data$node),]

@@ -208,6 +216,16 @@ get_cladelabel_position_ <- function(data, node) {

     y <- sp.df$y

     y <- y[!is.na(y)]

     mx <- max(sp.df$x, na.rm=TRUE)

-    data.frame(x=mx, y=min(y), yend=max(y))

+

+    d <- data.frame(x=mx, y=min(y), yend=max(y))

+    if (missing(angle))

+        return(d)

+

+    if (angle == "auto") {

+        d$angle <- mean(range(sp.df$angle))

+    } else {

+        d$angle <- angle

+    }

+    return(d)

 }

@@ -18,7 +18,7 @@

 ##' require(ape)

 ##' tr <- rtree(10)

 ##' ggtree(tr) + geom_tiplab()

-geom_tiplab <- function(mapping=NULL, hjust = 0,  align = FALSE, linetype = "dotted", linesize=1, geom="text", offset = 0, ...) {

+geom_tiplab <- function(mapping=NULL, hjust = 0,  align = FALSE, linetype = "dotted", linesize=1, geom="text",  offset=0, ...) {

     geom <- match.arg(geom, c("text", "label"))

     if (geom == "text") {

         text_geom <- geom_text2

@@ -43,6 +43,12 @@ geom_tiplab <- function(mapping=NULL, hjust = 0,  align = FALSE, linetype = "dot

     show_segment <- FALSE

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

         show_segment <- TRUE

+        segment_mapping <- aes(x = max(x, na.rm=TRUE),

+                               xend = x + diff(range(x, na.rm=TRUE))/200,

+                               y = y, yend = y,

+                               subset=isTip)

+        if (!is.null(mapping))

+            segment_mapping <- modifyList(segment_mapping, mapping)

     }

     list(

@@ -50,10 +56,14 @@ geom_tiplab <- function(mapping=NULL, hjust = 0,  align = FALSE, linetype = "dot

                   hjust = hjust, nudge_x = offset, ...)

         ,

         if (show_segment)

-            geom_tipsegment(mapping = aes(subset=isTip),

-                            offset = offset,

-                            linetype = linetype,

-                            size = linesize, ...)

+            geom_segment2(mapping = segment_mapping,

+                          linetype = linetype,

+                          size = linesize, ...)

+

+            ## geom_tipsegment(mapping = segment_mapping,

+            ##                 offset = offset,

+            ##                 linetype = linetype,

+            ##                 size = linesize, ...)

     )

 }

@@ -88,47 +98,47 @@ geom_tiplab2 <- function(mapping=NULL, hjust=0, ...) {

          )

 }

-geom_tipsegment <- function(mapping=NULL, data=NULL,

-                            geom=GeomSegmentGGtree, position = "identity",

-                            offset,  ...,

-                            show.legend=NA, inherit.aes=FALSE,

-                            na.rm=TRUE) {

-

-    default_aes <- aes_(x=~x, y=~y)

-    if (is.null(mapping)) {

-        mapping <- default_aes

-    } else {

-        mapping <- modifyList(default_aes, mapping)

-    }

-

-    layer(stat=StatTipSegment,

-          data = data,

-          mapping = mapping,

-          geom = geom,

-          position = position,

-          show.legend = show.legend,

-          inherit.aes = inherit.aes,

-          params = list(offset = offset,

-                        na.rm = na.rm,

-                        ...),

-          check.aes = FALSE

-          )

-}

-

-StatTipSegment <- ggproto("StatTipSegment", Stat,

-                        compute_group = function(self, data, scales, params, offset) {

-                            get_tipsegment_position(data, offset)

-                        },

-                        required_aes = c("x", "y")

-                        )

-

-

-get_tipsegment_position <- function(data, offset, adjustRatio=1/200) {

-    adjust <- diff(range(data$x, na.rm=TRUE)) * adjustRatio

-    xend <- data$x + adjust

-    x <- max(data$x, na.rm = TRUE)  + offset

-    y <- data$y

-    data.frame(x=x, xend=xend, y=y, yend=y)

-}

+## geom_tipsegment <- function(mapping=NULL, data=NULL,

+##                             geom=GeomSegmentGGtree, position = "identity",

+##                             offset,  ...,

+##                             show.legend=NA, inherit.aes=FALSE,

+##                             na.rm=TRUE) {

+

+##     default_aes <- aes_(x=~x, y=~y)

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

+##         mapping <- default_aes

+##     } else {

+##         mapping <- modifyList(default_aes, mapping)

+##     }

+

+##     layer(stat=StatTipSegment,

+##           data = data,

+##           mapping = mapping,

+##           geom = geom,

+##           position = position,

+##           show.legend = show.legend,

+##           inherit.aes = inherit.aes,

+##           params = list(offset = offset,

+##                         na.rm = na.rm,

+##                         ...),

+##           check.aes = FALSE

+##           )

+## }

+

+## StatTipSegment <- ggproto("StatTipSegment", Stat,

+##                         compute_group = function(self, data, scales, params, offset) {

+##                             get_tipsegment_position(data, offset)

+##                         },

+##                         required_aes = c("x", "y")

+##                         )

+

+

+## get_tipsegment_position <- function(data, offset, adjustRatio=1/200) {

+##     adjust <- diff(range(data$x, na.rm=TRUE)) * adjustRatio

+##     xend <- data$x + adjust

+##     x <- max(data$x, na.rm = TRUE)  + offset

+##     y <- data$y

+##     data.frame(x=x, xend=xend, y=y, yend=y)

+## }

@@ -1,6 +1,6 @@

 ##' append a heatmap of a matrix to right side of phylogenetic tree

 ##'

-##' 

+##'

 ##' @title gheatmap

 ##' @param p tree view

 ##' @param data matrix or data.frame

@@ -31,26 +31,32 @@

 gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", color="white",

                      colnames=TRUE, colnames_position="bottom", colnames_angle=0, colnames_level=NULL,

                      colnames_offset_x = 0, colnames_offset_y = 0, font.size=4, hjust=0.5) {

-    

+

     colnames_position %<>% match.arg(c("bottom", "top"))

     variable <- value <- lab <- y <- NULL

-    

+

     ## if (is.null(width)) {

     ##     width <- (p$data$x %>% range %>% diff)/30

     ## }

-    

+

     ## convert width to width of each cell

-    width <- width * (p$data$x %>% range %>% diff) / ncol(data)

-    

+    width <- width * (p$data$x %>% range(na.rm=TRUE) %>% diff) / ncol(data)

+

     isTip <- x <- y <- variable <- value <- from <- to <- NULL

-    

+

     df <- p$data

     df <- df[df$isTip,]

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

-    

+    start <- max(df$x, na.rm=TRUE) + offset

+

     dd <- as.data.frame(data)

     ## dd$lab <- rownames(dd)

-    lab <- df$label[order(df$y)]

+    i <- order(df$y)

+

+    ## handle collapsed tree

+    ## https://github.com/GuangchuangYu/ggtree/issues/137

+    i <- i[!is.na(df$y[i])]

+

+    lab <- df$label[i]

     dd <- dd[lab, , drop=FALSE]

     dd$y <- sort(df$y)

     dd$lab <- lab

@@ -69,10 +75,10 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", color=

     V2 <- start + as.numeric(dd$variable) * width

     mapping <- data.frame(from=dd$variable, to=V2)

     mapping <- unique(mapping)

-    

+

     dd$x <- V2

     dd$width <- width

-    

+

     if (is.null(color)) {

         p2 <- p + geom_tile(data=dd, aes(x, y, fill=value), width=width, inherit.aes=FALSE)

     } else {

@@ -83,7 +89,7 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", color=

     } else {

         p2 <- p2 + scale_fill_discrete(na.value=NA) #"white")

     }

-    

+

     if (colnames) {

         if (colnames_position == "bottom") {

             y <- 0

@@ -94,10 +100,10 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red", color=

         p2 <- p2 + geom_text(data=mapping, aes(x=to, y = y, label=from), size=font.size, inherit.aes = FALSE,

                              angle=colnames_angle, nudge_x=colnames_offset_x, nudge_y = colnames_offset_y, hjust=hjust)

     }

-    

+

     p2 <- p2 + theme(legend.position="right", legend.title=element_blank())

     ## p2 <- p2 + guides(fill = guide_legend(override.aes = list(colour = NULL)))

-    

+

     attr(p2, "mapping") <- mapping

     return(p2)

 }

@@ -8,6 +8,9 @@ fortify.treedata <- function(model, data, layout="rectangular", yscale="none",

     model <- set_branch_length(model, branch.length)

     x <- reorder.phylo(get.tree(model), "postorder")

+    if (ladderize == TRUE) {

+        x <- ladderize(x, right=right)

+    }

     if (is.null(x$edge.length) || branch.length == "none") {

         xpos <- getXcoord_no_length(x)

     } else {

@@ -1078,6 +1081,7 @@ getXcoord2 <- function(x, root, parent, child, len, start=0, rev=FALSE) {

     if (rev == TRUE) {

         direction <- -1

     }

+

     while(anyNA(x)) {

         idx <- which(parent %in% currentNode)

         newNode <- child[idx]

@@ -1186,9 +1190,15 @@ getYcoord <- function(tr, step=1) {

     y[tip.idx] <- 1:Ntip * step

     y[-tip.idx] <- NA

+    ## use lookup table

+    pvec <- integer(max(tr$edge))

+    pvec[child] = parent

+

     currentNode <- 1:Ntip

     while(anyNA(y)) {

-        pNode <- unique(parent[child %in% currentNode])

+        ## pNode <- unique(parent[child %in% currentNode])

+        pNode <- unique(pvec[currentNode])

+

         ## piping of magrittr is slower than nested function call.

         ## pipeR is fastest, may consider to use pipeR

         ##

@@ -4,9 +4,9 @@ ggtree: an R package for visualization and annotation of phylogenetic trees with

 <img src="https://raw.githubusercontent.com/Bioconductor/BiocStickers/master/ggtree/ggtree.png" height="200" align="right" />

-[![](https://img.shields.io/badge/release%20version-1.8.0-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![](https://img.shields.io/badge/devel%20version-1.9.0-green.svg?style=flat)](https://github.com/guangchuangyu/ggtree) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [![](https://img.shields.io/badge/download-14583/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1385/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)

+[![](https://img.shields.io/badge/release%20version-1.8.1-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![](https://img.shields.io/badge/devel%20version-1.9.1-green.svg?style=flat)](https://github.com/guangchuangyu/ggtree) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [![](https://img.shields.io/badge/download-16674/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1117/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)

-[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree) [![Last-changedate](https://img.shields.io/badge/last%20change-2017--04--28-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master) [![GitHub forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network) [![GitHub stars](https://img.shields.io/github/stars/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/stargazers) [![Awesome](https://cdn.rawgit.com/sindresorhus/awesome/d7305f38d29fed78fa85652e3a63e154dd8e8829/media/badge.svg)](https://awesome-r.com/#awesome-r-graphic-displays)

+[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree) [![Last-changedate](https://img.shields.io/badge/last%20change-2017--06--29-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master) [![GitHub forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network) [![GitHub stars](https://img.shields.io/github/stars/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/stargazers) [![Awesome](https://cdn.rawgit.com/sindresorhus/awesome/d7305f38d29fed78fa85652e3a63e154dd8e8829/media/badge.svg)](https://awesome-r.com/#awesome-r-graphic-displays)

 [![platform](http://www.bioconductor.org/shields/availability/devel/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#archives) [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/ggtree.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/) [![Linux/Mac Travis Build Status](https://img.shields.io/travis/GuangchuangYu/ggtree/master.svg?label=Mac%20OSX%20%26%20Linux)](https://travis-ci.org/GuangchuangYu/ggtree) [![AppVeyor Build Status](https://img.shields.io/appveyor/ci/Guangchuangyu/ggtree/master.svg?label=Windows)](https://ci.appveyor.com/project/GuangchuangYu/ggtree)

@@ -27,56 +27,56 @@ Please cite the following article when using `ggtree`:

 **G Yu**, DK Smith, H Zhu, Y Guan, TTY Lam<sup>\*</sup>. ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data. ***Methods in Ecology and Evolution***. 2017, 8(1):28-36.

-[![](https://img.shields.io/badge/doi-10.1111/2041--210X.12628-green.svg?style=flat)](http://dx.doi.org/10.1111/2041-210X.12628) [![](https://img.shields.io/badge/Altmetric-347-green.svg?style=flat)](https://www.altmetric.com/details/10533079)

+[![](https://img.shields.io/badge/doi-10.1111/2041--210X.12628-green.svg?style=flat)](http://dx.doi.org/10.1111/2041-210X.12628) [![](https://img.shields.io/badge/Altmetric-345-green.svg?style=flat)](https://www.altmetric.com/details/10533079)

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

 ### Citation

-[![citation](https://img.shields.io/badge/cited%20by-16-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627)

+[![citation](https://img.shields.io/badge/cited%20by-22-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627)

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

-    15 +                                                   *   +

+    20 +                                                   *   +

        |                                                       |

        |                                                       |

+    15 +                                                       +

        |                                                       |

-    10 +                                                       +

        |                                                       |

+    10 +                                                       +

        |                                                       |

        |                                                       |

      5 +                                                       +

-       |                                                       |

        |                                                       |

        | *                                                     |

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

+     0 +-+---------+---------+---------+---------+---------+---+

        2016     2016.2    2016.4    2016.6    2016.8     2017   

 ### Download stats

-[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-14583/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1385/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)

+[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-16674/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1117/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)

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

-    3000 +                                                                                        *    +

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

+    3000 +                                                                                  *          +

          |                                                                                             |

          |                                                                                             |

     2500 +                                                                                             +

          |                                                                                             |

          |                                                                                             |

          |                                                                                             |

-    2000 +                                                                                             +

-         |                                                                           *     *  *        |

-         |                                                                    *   *                    |

+    2000 +                                                                                     *   *   +

+         |                                                                      *     *  *             |

+         |                                                                *  *                         |

     1500 +                                                                                             +

          |                                                                                             |

-         |                                                          *                                  |

-         |                                                 *            *  *            *              |

-    1000 +                                                    *  *                                     +

-         |                                    *     *                                                  |

-         |                                *      *     *                                               |

-         |                             *                                                               |

-     500 +                   *      *                                                                  +

-         |                *      *                                                                     |

-         |             *                                                                               |

-       0 +   *  *   *                                                                                  +

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

-        2015               2015.5              2016               2016.5              2017

+         |                                                       *                                     |

+         |                                              *           *  *           *                   |

+    1000 +                                                 *  *                                        +

+         |                                  *     *                                                    |

+         |                               *     *     *                                                 |

+         |                            *                                                                |

+     500 +                  *      *                                                                   +

+         |               *     *                                                                       |

+         |            *                                                                                |

+       0 +   *  *  *                                                                                   +

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

+        2015              2015.5             2016             2016.5             2017            2017.5

@@ -6,7 +6,7 @@ author: "Guangchuang Yu and Tommy Tsan-Yuk Lam\\

 date: "`r Sys.Date()`"

 bibliography: ggtree.bib

 csl: nature.csl

-output: 

+output:

   prettydoc::html_pretty:

     toc: true

     theme: cayman

@@ -52,7 +52,7 @@ This project arose from our needs to annotate nucleotide substitutions in the ph

 Previously, phylogenetic trees were much smaller. Annotation of phylogenetic trees was not as necessary as nowadays much more data is becomming available. We want to associate our experimental data, for instance antigenic change, with the evolution relationship. Visualizing these associations in a phylogenetic tree can help us to identify evolution patterns. We believe we need a next generation tree viewer that should be programmable and extensible. It can view a phylogenetic tree easily as we did with classical software and support adding annotation data in a layer above the tree. This is the objective of developing the `ggtree`. Common tasks of annotating a phylogenetic tree should be easy and complicated tasks can be possible to achieve by adding multiple layers of annotation.

-The `ggtree` is designed by extending the `ggplot2`[@wickham_ggplot2_2009] package. It is based on the grammar of graphics and takes all the good parts of `ggplot2`. There are other R packages that implement tree viewer using `ggplot2`, including `OutbreakTools`, `phyloseq`[@mcmurdie_phyloseq_2013] and [ggphylo](https://github.com/gjuggler/ggphylo); they mostly create complex tree view functions for their specific needs. Internally, these packages interpret a phylogenetic as a collection of `lines`, which makes it hard to annotate diverse user input that are related to node (taxa). The `ggtree` is different to them by interpreting a tree as a collection of `taxa` and allowing general flexibilities of annotating phylogenetic tree with diverse types of user inputs. 

+The `ggtree` is designed by extending the `ggplot2`[@wickham_ggplot2_2009] package. It is based on the grammar of graphics and takes all the good parts of `ggplot2`. There are other R packages that implement tree viewer using `ggplot2`, including `OutbreakTools`, `phyloseq`[@mcmurdie_phyloseq_2013] and [ggphylo](https://github.com/gjuggler/ggphylo); they mostly create complex tree view functions for their specific needs. Internally, these packages interpret a phylogenetic as a collection of `lines`, which makes it hard to annotate diverse user input that are related to node (taxa). The `ggtree` is different to them by interpreting a tree as a collection of `taxa` and allowing general flexibilities of annotating phylogenetic tree with diverse types of user inputs.

 # Getting data into `R`

@@ -84,7 +84,7 @@ Most of the phylogenetic trees are scaled by evolutionary distance (substitution

 The `ggtree` package provides several layers to annotate a phylogenetic tree, including:

 + `geom_cladelabel` for labelling selected clades

-+ `geom_hilight` for highlighting selected clades 

++ `geom_hilight` for highlighting selected clades

 + `geom_range` to indicate uncertainty of branch lengths

 + `geom_strip` for adding strip/bar to label associated taxa (with optional label)

 + `geom_taxalink` for connecting related taxa

@@ -107,7 +107,7 @@ Visualizing an annotated phylogenetic tree with numerical matrix (e.g. genotype

 + [Tree Annotation](treeAnnotation.html)

 + [Advance Tree Annotation](advanceTreeAnnotation.html)

 + [ggtree utilities](ggtreeUtilities.html)

-

++ [Phylomoji](https://cran.r-project.org/web/packages/emojifont/vignettes/phylomoji.html)

 More documents can be found in <https://guangchuangyu.github.io/ggtree>.

@@ -115,7 +115,7 @@ More documents can be found in <https://guangchuangyu.github.io/ggtree>.

  - For bugs or feature request, please post to [github issue](https://github.com/GuangchuangYu/ggtree/issues).

  - For user questions, please post to [google group](https://groups.google.com/forum/#!forum/bioc-ggtree) or post to [Bioconductor support site](https://support.bioconductor.org/) or [Biostars](https://www.biostars.org/). We are following every post tagged with **ggtree**.

-  

+

 # Session info