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

 CHANGES IN VERSION 1.7.4

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

+ o now branch.length can set to feature available in phylo4d@data and yscale is supported for phylo4d object <2016-12-06, Tue>

  o bug fixed of rm.singleton.newick, remove singleton parent instead of singleton <2016-12-01, Thu>

  o reorder phylo to postorder before ladderrize <2016-11-28, Mon>

  o allow yscale to use data stored in phylo4d object <2016-11-24, Thu>

@@ -394,8 +394,11 @@ fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none",

 ##' @method fortify phylo4d

 ##' @export

 fortify.phylo4d <- function(model, data, layout="rectangular", yscale="none",

-                            ladderize=TRUE, right=FALSE, mrsd=NULL, ...) {

-    res <- fortify.phylo4(model, data, layout, yscale="none", ladderize, right, mrsd, ...) # not apply yscale at this moment

+                            ladderize=TRUE, right=FALSE, branch.length="branch.length",

+                            mrsd=NULL, ...) {

+    phylo <- set_branch_length(model, branch.length)

+    res <- fortify(phylo, data, layout, branch.length=branch.length,

+                   ladderize, right, mrsd, ...)

     tdata <- model@data[match(res$node, rownames(model@data)), , drop=FALSE]

     df <- cbind(res, tdata)

     scaleY(as.phylo.phylo4(model), df, yscale, layout, ...)

@@ -65,3 +65,6 @@ setMethod("get.tree", signature(object="phylo"),

           function(object, ...) {

               return(object)

           })

+

+

+

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

 ##' convert tip or node label(s) to internal node number

 ##'

-##' 

+##'

 ##' @title nodeid

 ##' @param x tree object or graphic object return by ggtree

 ##' @param label tip or node label(s)

@@ -8,9 +8,9 @@

 ##' @export

 ##' @author Guangchuang Yu

 nodeid <- function(x, label) {

-    if (is(x, "gg")) 

+    if (is(x, "gg"))

         return(nodeid.gg(x, label))

-    

+

     nodeid.tree(x, label)

 }

@@ -40,14 +40,14 @@ reroot_node_mapping <- function(tree, tree2) {

         ip <- getParent(tree, k)

         if (node_map[ip, "visited"])

             next

-        

+

         cc <- getChild(tree, ip)

         node2 <- node_map[cc,2]

         if (anyNA(node2)) {

             node <- c(node, k)

             next

         }

-        

+

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

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

         node_map[ip, 2] <- to

@@ -75,7 +75,7 @@ layout.unrooted <- function(tree) {

     df[root, "start"] <- 0

     df[root, "end"]   <- 2

     df[root, "angle"] <- 0

-    

+

     nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i)))

     nodes <- getNodes_by_postorder(tree)

@@ -83,22 +83,22 @@ layout.unrooted <- function(tree) {

     for(curNode in nodes) {

         curNtip <- nb.sp[curNode]

         children <- getChild(tree, curNode)

-        

+

         start <- df[curNode, "start"]

         end <- df[curNode, "end"]

-        

+

         if (length(children) == 0) {

             ## is a tip

             next

         }

-        

+

         for (i in seq_along(children)) {

             child <- children[i]

             ntip.child <- nb.sp[child]

-            

+

             alpha <- (end - start) * ntip.child/curNtip

             beta <- start + alpha / 2

-            

+

             length.child <- df[child, "length"]

             df[child, "x"] <- df[curNode, "x"] + cospi(beta) * length.child

             df[child, "y"] <- df[curNode, "y"] + sinpi(beta) * length.child

@@ -107,9 +107,9 @@ layout.unrooted <- function(tree) {

             df[child, "end"] <- start + alpha

             start <- start + alpha

         }

-        

+

     }

-    

+

     return(df)

 }

@@ -118,7 +118,7 @@ getParent.df <- function(df, node) {

     res <- df$parent[i]

     if (res == node) {

         ## root node

-        return(0) 

+        return(0)

     }

     return(res)

 }

@@ -165,10 +165,10 @@ get.offspring.df <- function(df, node) {

     return(sp)

 }

-    

+

 ##' extract offspring tips

 ##'

-##' 

+##'

 ##' @title get.offspring.tip

 ##' @param tr tree

 ##' @param node node

@@ -188,17 +188,17 @@ get.offspring.tip <- function(tr, node) {

 ##' calculate total number of nodes

 ##'

-##' 

+##'

 ##' @title getNodeNum

 ##' @param tr phylo object

-##' @return number 

+##' @return number

 ##' @author Guangchuang Yu

 ##' @export

 getNodeNum <- function(tr) {

     Ntip <- length(tr[["tip.label"]])

     Nnode <- tr[["Nnode"]]

     ## total nodes

-    N <- Ntip + Nnode 

+    N <- Ntip + Nnode

     return(N)

 }

@@ -233,7 +233,7 @@ getSibling <- function(tr, node) {

     if (node == root) {

         return(NA)

     }

-    

+

     parent <- getParent(tr, node)

     child <- getChild(tr, parent)

     sib <- child[child != node]

@@ -272,9 +272,9 @@ getNodeName <- function(tr) {

     return(nodeName)

 }

-##' get the root number 

+##' get the root number

+##'

 ##'

-##' 

 ##' @title getRoot

 ##' @param tr phylo object

 ##' @return root number

@@ -286,7 +286,7 @@ getRoot <- function(tr) {

     ## 2nd col is child,

     if (!is.null(attr(tr, "order")) && attr(tr, "order") == "postorder")

         return(edge[nrow(edge), 1])

-    

+

     parent <- unique(edge[,1])

     child <- unique(edge[,2])

     ## the node that has no parent should be the root

@@ -306,7 +306,7 @@ get.trunk <- function(tr) {

 ##' path from start node to end node

 ##'

-##' 

+##'

 ##' @title get.path

 ##' @param phylo phylo object

 ##' @param from start node

@@ -333,7 +333,7 @@ get.path_length <- function(phylo, from, to, weight=NULL) {

     if (is.null(weight)) {

         return(length(path)-1)

     }

-    

+

     df <- fortify(phylo)

     if ( ! (weight %in% colnames(df))) {

         stop("weight should be one of numerical attributes of the tree...")

@@ -350,7 +350,7 @@ get.path_length <- function(phylo, from, to, weight=NULL) {

         ee <- get_edge_index(df, path[i], path[i+1])

         res <- res + df[ee, weight]

     }

-    

+

     return(res)

 }

@@ -362,7 +362,7 @@ getNodes_by_postorder <- function(tree) {

 getXcoord2 <- function(x, root, parent, child, len, start=0, rev=FALSE) {

     x[root] <- start

     x[-root] <- NA  ## only root is set to start, by default 0

-        

+

     currentNode <- root

     direction <- 1

     if (rev == TRUE) {

@@ -395,12 +395,12 @@ getXcoord_no_length <- function(tr) {

     cl <- split(child, parent)

     child_list <- list()

     child_list[as.numeric(names(cl))] <- cl

-    

+

     while(anyNA(x)) {

         idx <- match(currentNode, child)

         pNode <- parent[idx]

         ## child number table

-        p1 <- table(parent[parent %in% pNode]) 

+        p1 <- table(parent[parent %in% pNode])

         p2 <- table(pNode)

         np <- names(p2)

         i <- p1[np] == p2

@@ -419,8 +419,8 @@ getXcoord_no_length <- function(tr) {

         currentNode <- unique(c(currentNode, newNode))

     }

-    x <- x - min(x) 

-    return(x)    

+    x <- x - min(x)

+    return(x)

 }

@@ -439,7 +439,7 @@ getXcoord <- function(tr) {

 }

 getXYcoord_slanted <- function(tr) {

-    

+

     edge <- tr$edge

     parent <- edge[,1]

     child <- edge[,2]

@@ -470,7 +470,7 @@ getYcoord <- function(tr, step=1) {

     cl <- split(child, parent)

     child_list <- list()

     child_list[as.numeric(names(cl))] <- cl

-    

+

     y <- numeric(N)

     tip.idx <- child[child <= Ntip]

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

@@ -486,19 +486,19 @@ getYcoord <- function(tr, step=1) {

         ## idx <- sapply(pNode, function(i) all(child[parent == i] %in% currentNode))

         idx <- sapply(pNode, function(i) all(child_list[[i]] %in% currentNode))

         newNode <- pNode[idx]

-        

+

         y[newNode] <- sapply(newNode, function(i) {

             mean(y[child_list[[i]]], na.rm=TRUE)

-            ##child[parent == i] %>% y[.] %>% mean(na.rm=TRUE)           

+            ##child[parent == i] %>% y[.] %>% mean(na.rm=TRUE)

         })

-        

+

         currentNode <- c(currentNode[!currentNode %in% unlist(child_list[newNode])], newNode)

         ## currentNode <- c(currentNode[!currentNode %in% child[parent %in% newNode]], newNode)

         ## parent %in% newNode %>% child[.] %>%

         ##     `%in%`(currentNode, .) %>% `!` %>%

         ##         currentNode[.] %>% c(., newNode)

     }

-    

+

     return(y)

 }

@@ -507,7 +507,7 @@ getYcoord_scale <- function(tr, df, yscale) {

     N <- getNodeNum(tr)

     y <- numeric(N)

-    

+

     root <- getRoot(tr)

     y[root] <- 0

     y[-root] <- NA

@@ -539,7 +539,7 @@ getYcoord_scale <- function(tr, df, yscale) {

 getYcoord_scale2 <- function(tr, df, yscale) {

     root <- getRoot(tr)

-    

+

     pathLength <- sapply(1:length(tr$tip.label), function(i) {

         get.path_length(tr, i, root, yscale)

     })

@@ -566,7 +566,7 @@ getYcoord_scale2 <- function(tr, df, yscale) {

         } else {

             ordered_tip <- c(ordered_tip[1:ii],sib)

         }

-        

+

         ii <- ii + nn + 1

     }

@@ -576,20 +576,20 @@ getYcoord_scale2 <- function(tr, df, yscale) {

     N <- getNodeNum(tr)

     y <- numeric(N)

-    

+

     y[root] <- 0

     y[-root] <- NA

     ## yy <- df[, yscale]

     ## yy[is.na(yy)] <- 0

-    

+

     for (i in 2:length(long_branch)) {

         y[long_branch[i]] <- y[long_branch[i-1]] + df[long_branch[i], yscale]

     }

-    

+

     parent <- df[, "parent"]

     child <- df[, "node"]

-    

+

     currentNodes <- root

     while(anyNA(y)) {

         newNodes <- c()

@@ -618,14 +618,14 @@ getYcoord_scale2 <- function(tr, df, yscale) {

 getYcoord_scale_numeric <- function(tr, df, yscale, ...) {

     df <- .assign_parent_status(tr, df, yscale)

     df <- .assign_child_status(tr, df, yscale)

-    

+

     y <- df[, yscale]

     if (anyNA(y)) {

         warning("NA found in y scale mapping, all were setting to 0")

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

     }

-    

+

     return(y)

 }

@@ -655,7 +655,7 @@ getYcoord_scale_numeric <- function(tr, df, yscale, ...) {

     if (!is.null(yscale_mapping)) {

         yy <- yscale_mapping[yy]

     }

-    

+

     na.idx <- which(is.na(yy))

     if (length(na.idx) > 0) {

         tree <- get.tree(tr)

@@ -680,7 +680,7 @@ getYcoord_scale_numeric <- function(tr, df, yscale, ...) {

 getYcoord_scale_category <- function(tr, df, yscale, yscale_mapping=NULL, ...) {

     if (is.null(yscale_mapping)) {

         stop("yscale is category variable, user should provide yscale_mapping,

-             which is a named vector, to convert yscale to numberical values...") 

+             which is a named vector, to convert yscale to numberical values...")

     }

     if (! is(yscale_mapping, "numeric") ||

         is.null(names(yscale_mapping))) {

@@ -694,11 +694,11 @@ getYcoord_scale_category <- function(tr, df, yscale, yscale_mapping=NULL, ...) {

             df[ii, yscale] <- df[ii, "node"]

         }

     }

-    

+

     ## assign to parent status is more prefer...

     df <- .assign_parent_status(tr, df, yscale)

     df <- .assign_child_status(tr, df, yscale, yscale_mapping)

-    

+

     y <- df[, yscale]

     if (anyNA(y)) {

@@ -733,37 +733,43 @@ calculate_branch_mid <- function(res) {

 set_branch_length <- function(tree_object, branch.length) {

-    phylo <- get.tree(tree_object)

-    

+    if (is(tree_object, "phylo4d")) {

+        phylo <- as.phylo.phylo4(tree_object)

+        d <- tree_object@data

+        tree_anno <- data.frame(node=rownames(d), d)

+    } else {

+        phylo <- get.tree(tree_object)

+    }

+

     if (branch.length %in%  c("branch.length", "none")) {

         return(phylo)

     }

-

     ## if (is(tree_object, "codeml")) {

     ##     tree_anno <- tree_object@mlc@dNdS

     ## } else

-    

+

     if (is(tree_object, "codeml_mlc")) {

         tree_anno <- tree_object@dNdS

     } else if (is(tree_object, "beast")) {

         tree_anno <- tree_object@stats

     }

+

     if (has.extraInfo(tree_object)) {

         tree_anno <- merge(tree_anno, tree_object@extraInfo, by.x="node", by.y="node")

     }

     cn <- colnames(tree_anno)

     cn <- cn[!cn %in% c('node', 'parent')]

-    

+

     length <- match.arg(branch.length, cn)

     if (all(is.na(as.numeric(tree_anno[, length])))) {

         stop("branch.length should be numerical attributes...")

     }

-    

+

     edge <- as.data.frame(phylo$edge)

     colnames(edge) <- c("parent", "node")

-    

+

     dd <- merge(edge, tree_anno,

                 by.x  = "node",

                 by.y  = "node",

@@ -772,7 +778,7 @@ set_branch_length <- function(tree_object, branch.length) {

     len <- unlist(dd[, length])

     len <- as.numeric(len)

     len[is.na(len)] <- 0

-    

+

     phylo$edge.length <- len

     return(phylo)

@@ -785,7 +791,7 @@ re_assign_ycoord_df <- function(df, currentNode) {

         idx <- sapply(pNode, function(i) with(df, all(node[parent == i & parent != node] %in% currentNode)))

         newNode <- pNode[idx]

         ## newNode <- newNode[is.na(df[match(newNode, df$node), "y"])]

-        

+

         df[match(newNode, df$node), "y"] <- sapply(newNode, function(i) {

             with(df, mean(y[parent == i], na.rm = TRUE))

         })

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

 [![releaseVersion](https://img.shields.io/badge/release%20version-1.6.4-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![develVersion](https://img.shields.io/badge/devel%20version-1.7.4-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) [![total](https://img.shields.io/badge/downloads-16878/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1621/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) <img src="logo.png" align="right" />

-[![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-2016--12--01-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-2016--12--06-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) [![install with bioconda](https://img.shields.io/badge/install%20with-bioconda-green.svg?style=flat)](http://bioconda.github.io/recipes/bioconductor-ggtree/README.html)

@@ -18,7 +18,7 @@ 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***. *accepted*

-[![doi](https://img.shields.io/badge/doi-10.1111/2041--210X.12628-green.svg?style=flat)](http://dx.doi.org/10.1111/2041-210X.12628) [![citation](https://img.shields.io/badge/cited%20by-1-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) [![Altmetric](https://img.shields.io/badge/Altmetric-274-green.svg?style=flat)](https://www.altmetric.com/details/10533079)

+[![doi](https://img.shields.io/badge/doi-10.1111/2041--210X.12628-green.svg?style=flat)](http://dx.doi.org/10.1111/2041-210X.12628) [![citation](https://img.shields.io/badge/cited%20by-1-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) [![Altmetric](https://img.shields.io/badge/Altmetric-284-green.svg?style=flat)](https://www.altmetric.com/details/10533079)

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