@@ -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.7.11

+Version: 1.9.1

 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,12 @@

+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>

+

 CHANGES IN VERSION 1.7.11

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

  o remove layout.method parameter <2017-04-20, Thu>

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,33 +112,36 @@ 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)

-  if (is.null(mapping)) {

-    mapping <- default_aes

-  } else {

-    mapping <- modifyList(mapping, default_aes)

-  }

-  

-  layer(stat=StatCladeText,

-        data=data,

-        mapping=mapping,

-        geom=geom,

-        position=position,

-        show.legend = show.legend,

-        inherit.aes = inherit.aes,

-        params=list(node=node,

-                    label  = label,

-                    offset = offset,

-                    align  = align,

-                    na.rm  = na.rm,

-                    parse  = parse,

-                    ...),

-        check.aes = FALSE

-  )

-  

+

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

+    if (is.null(mapping)) {

+        mapping <- default_aes

+    } else {

+        mapping <- modifyList(mapping, default_aes)

+    }

+

+    layer(stat=StatCladeText,

+          data=data,

+          mapping=mapping,

+          geom=geom,

+          position=position,

+          show.legend = show.legend,

+          inherit.aes = inherit.aes,

+          params=list(node=node,

+                      label  = label,

+                      offset = offset,

+                      align  = align,

+                      na.rm  = na.rm,

+                      parse  = parse,

+                      angle_ = angle,

+                      ...),

+          check.aes = FALSE

+          )

+

+

 }

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

@@ -169,46 +172,62 @@ 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)

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

-                           df$label <- label

-                           return(df)

+                         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)

-  if (align) {

-    # Find max x value for all tree nodes so all clade labels align to same position.

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

-  } else {

-    mx <- df$x

-  }

-  mx <- mx * adjustRatio + offset

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

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

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

+    if (align) {

+        # Find max x value for all tree nodes so all clade labels align to same position.

+        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, angle=angle)

 }

-# get x, y and yend of clade region.

-get_cladelabel_position_ <- function(data, node) {

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

-  sp2 <- c(sp, node)

-  sp.df <- data[match(sp2, 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))

+  # get x, y and yend of clade region.

+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),]

+

+    y <- sp.df$y

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

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

+

+    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,23 +31,23 @@

 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)

-    

+

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

-    

+

     df <- p$data

     df <- df[df$isTip,]

     start <- max(df$x) + offset

-    

+

     dd <- as.data.frame(data)

     ## dd$lab <- rownames(dd)

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

@@ -69,10 +69,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 +83,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 +94,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 {

@@ -303,7 +306,7 @@ layoutDaylight <- function( tree, branch.length ){

     i <- 1

     ave_change <- 1.0

     while( i <= MAX_COUNT & ave_change > MINIMUM_AVERAGE_ANGLE_CHANGE ){

-        cat('Iteration: ', i, '\n')

+        message('Iteration: ', i)

         ## Reset max_change after iterating over tree.

         total_max <- 0.0

@@ -1159,6 +1162,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]

@@ -1267,9 +1271,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

         ##

@@ -350,7 +350,8 @@ is.tree <- function(x) {

                         "codeml",

                         "hyphy",

                         "beast",

-                        "phangorn")

+                        "phangorn",

+                        "treedata")

         ) {

         return(TRUE)

     }

@@ -69,7 +69,7 @@ __G Yu__, DK Smith, H Zhu, Y Guan, TTY Lam^\*^. ggtree: an R package for visuali

 ### Citation

 `r badge_citation("HtEfBTGE9r8C", "7268358477862164627", "green")`

-`r badge_sci_citation("http://apps.webofknowledge.com/InboundService.do?mode=FullRecord&customersID=RID&IsProductCode=Yes&product=WOS&Init=Yes&Func=Frame&DestFail=http%3A%2F%2Fwww.webofknowledge.com&action=retrieve&SrcApp=RID&SrcAuth=RID&SID=U2EMQLA1958R5PUSAKt&UT=WOS%3A000393305300004", "green")`

+

 ```{r echo=F, comment=NA}

@@ -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.6.11-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![](https://img.shields.io/badge/devel%20version-1.7.10-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-14336/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-16372/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--20-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--19-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-348-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-346-green.svg?style=flat)](https://www.altmetric.com/details/10533079)

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

 ### Citation

-[![citation](https://img.shields.io/badge/cited%20by-15-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) [![](https://img.shields.io/badge/cited%20in%20Web%20of%20Science%20Core%20Collection-6-green.svg?style=flat)](http://apps.webofknowledge.com/InboundService.do?mode=FullRecord&customersID=RID&IsProductCode=Yes&product=WOS&Init=Yes&Func=Frame&DestFail=http%3A%2F%2Fwww.webofknowledge.com&action=retrieve&SrcApp=RID&SrcAuth=RID&SID=U2EMQLA1958R5PUSAKt&UT=WOS%3A000393305300004)

+[![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)

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

-       |                                                   *   |

+    20 +                                                   *   +

        |                                                       |

        |                                                       |

-    10 +                                                       +

+    15 +                                                       +

        |                                                       |

        |                                                       |

+    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-14336/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-16372/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

@@ -258,6 +258,7 @@

     Annotation</a></li>

 <li><a href="https://bioconductor.org/packages/devel/bioc/vignettes/ggtree/inst/doc/ggtreeUtilities.html">ggtree

     utilities</a></li>

+<li><a href="https://cran.r-project.org/web/packages/emojifont/vignettes/phylomoji.html">Phylomoji</a></li>

 </ul>

 <h2 id="blog-posts"><i class="fa fa-wordpress"></i> Blog posts</h2>

 <h3 id="news-and-updates"><i class="fa fa-angle-double-right"></i> News and updates</h3>

@@ -220,8 +220,7 @@

 <p><link rel="stylesheet" href="https://guangchuangyu.github.io/css/font-awesome.min.css"></p>

 <p><a href="https://github.com/GuangchuangYu/featured_img">Let us know</a> if you have

 published using <code>ggtree</code> and your publication will be featured here.</p>

-<p><a href="https://scholar.google.com.hk/scholar?oi=bibs&amp;hl=en&amp;cites=7268358477862164627"><img alt="citation" src="https://img.shields.io/badge/cited%20by-15-blue.svg?style=flat" /></a>

-<a href="http://apps.webofknowledge.com/InboundService.do?mode=FullRecord&amp;customersID=RID&amp;IsProductCode=Yes&amp;product=WOS&amp;Init=Yes&amp;Func=Frame&amp;DestFail=http%3A%2F%2Fwww.webofknowledge.com&amp;action=retrieve&amp;SrcApp=RID&amp;SrcAuth=RID&amp;SID=U2EMQLA1958R5PUSAKt&amp;UT=WOS%3A000393305300004"><img alt="" src="https://img.shields.io/badge/cited%20in%20Web%20of%20Science%20Core%20Collection-6-blue.svg?style=flat" /></a></p>

+<p><a href="https://scholar.google.com.hk/scholar?oi=bibs&amp;hl=en&amp;cites=7268358477862164627"><img alt="citation" src="https://img.shields.io/badge/cited%20by-22-blue.svg?style=flat" /></a></p>

 <p><link rel='stylesheet' href=https://guangchuangyu.github.io/resume/css/morris.css>