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

 Package: ggtree

 Type: Package

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

-Version: 0.99.9

+Version: 0.99.10

 Author: Guangchuang Yu

 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>

 Description: ggtree extends the ggplot2 plotting system which implemented the

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

+CHANGES IN VERSION 0.99.10

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

+ o support order nodes by yscale <2015-02-03, Tue>

+

 CHANGES IN VERSION 0.99.9

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

  o update vignette <2015-02-02, Mon>

@@ -255,6 +255,33 @@ getChild <- function(tr, node) {

     return(res)

 }

+getSibling <- function(tr, node) {

+    root <- getRoot(tr)

+    if (node == root) {

+        return(NA)

+    }

+    

+    parent <- getParent(tr, node)

+    child <- getChild(tr, parent)

+    sib <- child[child != node]

+    return(sib)

+}

+

+

+getAncestor <- function(tr, node) {

+    root <- getRoot(tr)

+    if (node == root) {

+        return(NA)

+    }

+    parent <- getParent(tr, node)

+    res <- parent

+    while(parent != root) {

+        parent <- getParent(tr, parent)

+        res <- c(res, parent)

+    }

+    return(res)

+}

+

 isRoot <- function(tr, node) {

     getRoot(tr) == node

 }

@@ -286,6 +313,30 @@ getRoot <- function(tr) {

     return(root)

 }

+get.path_length <- function(df, from, to, weight=NULL) {

+    ## df is output of fortify(tree)

+    ## from and to are nodes

+    ## weight is a numeric column of df

+    res <- 0

+    if (from == to) {

+        return(res)

+    }

+    

+    if (is.null(weight)) {

+        res <- res + 1

+    } else {

+        res <- res + df[from, weight]

+    }

+

+    newNode <- df[from, "parent"]

+    if (newNode == to) {

+        return(res)

+    } else {

+        res <- res + get.path_length(df, newNode, to, weight)

+    }

+    return(res)

+}

+

 getNodes_by_postorder <- function(tree) {

     tree <- reorder.phylo(tree, "postorder")

     nodes <- tree$edge[,c(2,1)] %>% t %>%

@@ -418,7 +469,8 @@ getYcoord <- function(tr, step=1) {

 }

-getYcoord_scale <- function(tr, yscale) {

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

+

     N <- getNodeNum(tr)

     y <- numeric(N)

@@ -429,7 +481,7 @@ getYcoord_scale <- function(tr, yscale) {

     edge <- tr$edge

     parent <- edge[,1]

     child <- edge[,2]

-    

+

     currentNodes <- root

     while(any(is.na(y))) {

         newNodes <- c()

@@ -438,12 +490,94 @@ getYcoord_scale <- function(tr, yscale) {

             newNode <- child[idx]

             direction <- -1

             for (i in seq_along(newNode)) {

-                y[newNode[i]] <- y[currentNode] + yscale[newNode[i]] * direction

+                y[newNode[i]] <- y[currentNode] + df[newNode[i], yscale] * direction

                 direction <- -1 * direction

             }

             newNodes <- c(newNodes, newNode)

         }

         currentNodes <- unique(newNodes)

     }

+    if (min(y) < 0) {

+        y <- y + abs(min(y))

+    }

+    return(y)

+}

+

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

+

+    root <- getRoot(tr)

+    

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

+        get.path_length(df, i, root, yscale)

+    })

+

+    ordered_tip <- order(pathLength, decreasing = TRUE)

+    ii <- 1

+    ntip <- length(ordered_tip)

+    while(ii < ntip) {

+        sib <- getSibling(tr, ordered_tip[ii])

+        if (length(sib) == 0) {

+            ii <- ii + 1

+            next

+        }

+        jj <- which(ordered_tip %in% sib)

+        if (length(jj) == 0) {

+            ii <- ii + 1

+            next

+        }

+        sib <- ordered_tip[jj]

+        ordered_tip <- ordered_tip[-jj]

+        nn <- length(sib)

+        if (ii < length(ordered_tip)) {

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

+        } else {

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

+        }

+        

+        ii <- ii + nn + 1

+    }

+

+

+    long_branch <- getAncestor(tr, ordered_tip[1]) %>% rev

+    long_branch <- c(long_branch, ordered_tip[1])

+

+    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(any(is.na(y))) {

+        newNodes <- c()

+        for (currentNode in currentNodes) {

+            idx <- which(parent %in% currentNode)

+            newNode <- child[idx]

+            newNode <- c(newNode[! newNode %in% ordered_tip],

+                         rev(ordered_tip[ordered_tip %in% newNode]))

+            direction <- -1

+            for (i in seq_along(newNode)) {

+                if (is.na(y[newNode[i]])) {

+                    y[newNode[i]] <- y[currentNode] + df[newNode[i], yscale] * direction

+                    direction <- -1 * direction

+                }

+            }

+            newNodes <- c(newNodes, newNode)

+        }

+        currentNodes <- unique(newNodes)

+    }

+    if (min(y) < 0) {

+        y <- y + abs(min(y))

+    }

     return(y)

 }

@@ -185,7 +185,7 @@ fortify.beast <- function(model, data,

     stats <- stats[,colnames(stats) != "node"]

     df <- cbind(df, stats)

-    scaleY(phylo, df, yscale)

+    scaleY(phylo, df, yscale, ...)

 }

@@ -225,7 +225,7 @@ fortify.codeml <- function(model, data,

     res <- merge_phylo_anno.codeml_mlc(df, dNdS, ndigits)

     df <- merge_phylo_anno.paml_rst(res, model@rst)

-    scaleY(phylo, df, yscale)

+    scaleY(phylo, df, yscale, ...)

 }

@@ -248,7 +248,7 @@ fortify.codeml_mlc <- function(model, data,

     dNdS <- model@dNdS

     df <- merge_phylo_anno.codeml_mlc(df, dNdS, ndigits)

-    scaleY(phylo, df, yscale)

+    scaleY(phylo, df, yscale, ...)

 }

 merge_phylo_anno.codeml_mlc <- function(df, dNdS, ndigits = NULL) {

@@ -302,7 +302,7 @@ fortify.paml_rst <- function(model, data, layout = "phylogram", yscale="none",

                              ladderize=TRUE, right=FALSE, ...) {

     df <- fortify.phylo(model@phylo, data, layout, ladderize, right, ...)

     df <- merge_phylo_anno.paml_rst(df, model)

-    scaleY(model@phylo, df, yscale)

+    scaleY(model@phylo, df, yscale, ...)

 }

 merge_phylo_anno.paml_rst <- function(df, model) {

@@ -329,10 +329,10 @@ fortify.jplace <- function(model, data,

     df <- get.treeinfo(model, layout, ladderize, right, ...)

     place <- get.placements(model, by="best")

     df <- df %add2% place

-    scaleY(model@phylo, df, yscale)

+    scaleY(model@phylo, df, yscale, ...)

 }

-scaleY <- function(phylo, df, yscale) {

+scaleY <- function(phylo, df, yscale, order.y = TRUE) {

     if (yscale == "none") {

         return(df)

     }

@@ -344,7 +344,13 @@ scaleY <- function(phylo, df, yscale) {

         warning("yscale should be numeric...\n")

         return(df)

     }

-    y <- getYcoord_scale(phylo, df[, yscale])

+

+    if (order.y) {

+        y <- getYcoord_scale2(phylo, df, yscale)

+    } else {

+        y <- getYcoord_scale(phylo, df, yscale)

+    }

+    

     df[, "y"] <- y

     return(df)

 }