@@ -68,6 +68,7 @@ fortify.phylo <- function(model, data,

         res <- calculate_angle(res)

     }

     res <- scaleY(as.phylo(model), res, yscale, layout, ...)

+    res <- adjust_hclust_tip.edge.len(res, x)

     class(res) <- c("tbl_tree", class(res))

     attr(res, "layout") <- layout

     return(res)

@@ -148,7 +149,6 @@ fortify.phylo4 <- function(model, data,

     df <- fortify.phylo(phylo, data,

                         layout, ladderize, right, mrsd=mrsd, ...)

-    df <- adjust_hclust_tip.edge.len(df, phylo)

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

 }

@@ -202,7 +202,6 @@ fortify.phylo4d <- function(model, data,

                             ...) {

     model <- as.treedata(model, hang = hang)

     df <- fortify(model, data, layout, yscale, ladderize, right, branch.length, mrsd, ...)

-    df <- adjust_hclust_tip.edge.len(df, model@phylo)

     return (df)

 }

@@ -148,14 +148,7 @@ fortify.phylo4 <- function(model, data,

     df <- fortify.phylo(phylo, data,

                         layout, ladderize, right, mrsd=mrsd, ...)

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

-    df$x <- df$x - mx

-    df$branch <- df$branch - mx

-    tip.edge.len <- attr(phylo, 'tip.edge.len')

-    if (!is.null(tip.edge.len)){

-        df[df$isTip, "x", drop=TRUE] <- tip.edge.len

-    }

-    attr(df, 'revts.done') = TRUE

+    df <- adjust_hclust_tip.edge.len(df, phylo)

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

 }

@@ -205,8 +198,12 @@ fortify.phylo4d <- function(model, data,

                             right         = FALSE,

                             branch.length = "branch.length",

                             mrsd          = NULL,

+							hang          = 0.1,

                             ...) {

-    fortify(as.treedata(model), data, layout, yscale, ladderize, right, branch.length, mrsd, ...)

+    model <- as.treedata(model, hang = hang)

+    df <- fortify(model, data, layout, yscale, ladderize, right, branch.length, mrsd, ...)

+    df <- adjust_hclust_tip.edge.len(df, model@phylo)

+    return (df)

 }

 ##' @method fortify pvclust

@@ -135,7 +135,8 @@ fortify.phylo4 <- function(model, data,

                            mrsd      = NULL,

                            hang      = .1,

                            ...) {

-    if (inherits(model, c("dendrogram", "agnes", "diana", "twins"))) {

+    if (inherits(model, c("dendrogram", "linkage", 

+                        "agnes", "diana", "twins"))) {

         model <- stats::as.hclust(model)

     }

@@ -190,6 +191,9 @@ fortify.phylog <- fortify.phylo4

 ##' @export

 fortify.igraph <- fortify.phylo4

+##' @method fortify linkage

+##' @export

+fortify.linkage <- fortify.phylo4

 ##' @method fortify phylo4d

 ##' @importFrom treeio as.treedata

@@ -139,7 +139,7 @@ fortify.phylo4 <- function(model, data,

         model <- stats::as.hclust(model)

     }

-    if (inherits(model, "hclust") && layout == 'dendrogram') {

+    if (inherits(model, "hclust")) {

         phylo <- as.phylo.hclust2(model, hang = hang)

     } else {

         phylo <- as.phylo(model)

@@ -147,9 +147,14 @@ fortify.phylo4 <- function(model, data,

     df <- fortify.phylo(phylo, data,

                         layout, ladderize, right, mrsd=mrsd, ...)

-    if (!is.null(attr(phylo, 'tip.edge.len'))){

-        attr(df, 'tip.edge.len') <- attr(phylo, 'tip.edge.len')

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

+    df$x <- df$x - mx

+    df$branch <- df$branch - mx

+    tip.edge.len <- attr(phylo, 'tip.edge.len')

+    if (!is.null(tip.edge.len)){

+        df[df$isTip, "x", drop=TRUE] <- tip.edge.len

     }

+    attr(df, 'revts.done') = TRUE

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

 }

@@ -133,19 +133,23 @@ fortify.phylo4 <- function(model, data,

                            ladderize = TRUE,

                            right     = FALSE,

                            mrsd      = NULL,

+                           hang      = .1,

                            ...) {

     if (inherits(model, c("dendrogram", "agnes", "diana", "twins"))) {

         model <- stats::as.hclust(model)

     }

-    if (inherits(model, "hclust")) {

-        phylo <- as.phylo.hclust2(model)

+    if (inherits(model, "hclust") && layout == 'dendrogram') {

+        phylo <- as.phylo.hclust2(model, hang = hang)

     } else {

         phylo <- as.phylo(model)

     }

     df <- fortify.phylo(phylo, data,

                         layout, ladderize, right, mrsd=mrsd, ...)

+    if (!is.null(attr(phylo, 'tip.edge.len'))){

+        attr(df, 'tip.edge.len') <- attr(phylo, 'tip.edge.len')

+    }

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

 }

@@ -134,12 +134,16 @@ fortify.phylo4 <- function(model, data,

                            right     = FALSE,

                            mrsd      = NULL,

                            ...) {

-    if (class(model) %in% c("dendrogram", "agnes", "diana", "twins")) {

+    if (inherits(model, c("dendrogram", "agnes", "diana", "twins"))) {

         model <- stats::as.hclust(model)

     }

-    

-    phylo <- as.phylo(model)

+    if (inherits(model, "hclust")) {

+        phylo <- as.phylo.hclust2(model)

+    } else {

+        phylo <- as.phylo(model)

+    }

+

     df <- fortify.phylo(phylo, data,

                         layout, ladderize, right, mrsd=mrsd, ...)

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

@@ -32,14 +32,20 @@ fortify.phylo <- function(model, data,

     if (layout %in% c("equal_angle", "daylight", "ape")) {

         res <- layout.unrooted(model, layout.method = layout, branch.length = branch.length, ...)

     } else {

+        ypos <- getYcoord(x)

+        N <- Nnode(x, internal.only=FALSE)

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

-            xpos <- getXcoord_no_length(x)

+            if (layout == 'slanted'){

+                sbp <- .convert_tips2ancestors_sbp(x, include.root = TRUE)

+                xpos <- getXcoord_no_length_slanted(sbp)

+                ypos <- getYcoord_no_length_slanted(sbp)  

+            }else{

+                xpos <- getXcoord_no_length(x)

+            }

         } else {

             xpos <- getXcoord(x)

         }

-        ypos <- getYcoord(x)

-        N <- Nnode(x, internal.only=FALSE)

         xypos <- tibble::tibble(node=1:N, x=xpos + root.position, y=ypos)

         df <- as_tibble(model) %>%

@@ -49,7 +49,7 @@ fortify.phylo <- function(model, data,

     }

     ## add branch mid position

-    res <- calculate_branch_mid(res)

+    res <- calculate_branch_mid(res, layout=layout)

     if (!is.null(mrsd)) {

         res <- scaleX_by_time_from_mrsd(res, mrsd, as.Date)

@@ -89,6 +89,10 @@ fortify.multiPhylo <-  function(model, data,

     return(df)

 }

+##' @method fortify treedataList

+##' @export

+fortify.treedataList <- fortify.multiPhylo

+

 ##' @importFrom ggplot2 fortify

 ##' @method fortify treedata

 ##' @export

@@ -182,7 +182,9 @@ fortify.phylo4d <- function(model, data,

     fortify(as.treedata(model), data, layout, yscale, ladderize, right, branch.length, mrsd, ...)

 }

-

+##' @method fortify pvclust

+##' @export

+fortify.pvclust <- fortify.phylo4d

 ##' @method fortify obkData

 ##' @export

@@ -40,7 +40,7 @@ fortify.phylo <- function(model, data,

         ypos <- getYcoord(x)

         N <- Nnode(x, internal.only=FALSE)

-        xypos <- tibble::data_frame(node=1:N, x=xpos + root.position, y=ypos)

+        xypos <- tibble::tibble(node=1:N, x=xpos + root.position, y=ypos)

         df <- as_tibble(model) %>%

             mutate(isTip = ! .data$node %in% .data$parent)

@@ -2,7 +2,7 @@

 ##' @importFrom treeio as.phylo

 ##' @importFrom treeio Nnode

 ##' @importFrom dplyr full_join

-##' @importFrom dplyr mutate_

+##' @importFrom dplyr mutate

 ##' @importFrom tidytree as_tibble

 ##' @method fortify phylo

 ##' @export

@@ -43,7 +43,7 @@ fortify.phylo <- function(model, data,

         xypos <- tibble::data_frame(node=1:N, x=xpos + root.position, y=ypos)

         df <- as_tibble(model) %>%

-            mutate_(isTip = ~(! node %in% parent))

+            mutate(isTip = ! .data$node %in% .data$parent)

         res <- full_join(df, xypos, by = "node")

     }

@@ -63,6 +63,7 @@ fortify.phylo <- function(model, data,

     }

     res <- scaleY(as.phylo(model), res, yscale, layout, ...)

     class(res) <- c("tbl_tree", class(res))

+    attr(res, "layout") <- layout

     return(res)

 }

@@ -84,6 +85,7 @@ fortify.multiPhylo <-  function(model, data,

     df <- do.call("rbind", df.list)

     df$.id <- rep(names(df.list), times=sapply(df.list, nrow))

     df$.id <- factor(df$.id, levels=names(df.list))

+    attr(df, "layout") <- layout

     return(df)

 }

@@ -29,7 +29,7 @@ fortify.phylo <- function(model, data,

         }

     }

-    if (layout %in% c("equal_angle", "daylight")) {

+    if (layout %in% c("equal_angle", "daylight", "ape")) {

         res <- layout.unrooted(model, layout.method = layout, branch.length = branch.length, ...)

     } else {

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

@@ -161,6 +161,11 @@ fortify.twins <- fortify.phylo4

 ##' @export

 fortify.phylog <- fortify.phylo4

+##' @method fortify igraph

+##' @export

+fortify.igraph <- fortify.phylo4

+

+

 ##' @method fortify phylo4d

 ##' @importFrom treeio as.treedata

 ##' @export

@@ -176,6 +181,7 @@ fortify.phylo4d <- function(model, data,

 }

+

 ##' @method fortify obkData

 ##' @export

 fortify.obkData <- function(model, data,

@@ -122,8 +122,8 @@ fortify.phylo4 <- function(model, data,

                            right     = FALSE,

                            mrsd      = NULL,

                            ...) {

-    if (is(model, "dendrogram")) {

-        as.phylo <- phylogram::as.phylo

+    if (class(model) %in% c("dendrogram", "agnes", "diana", "twins")) {

+        model <- stats::as.hclust(model)

     }

@@ -145,6 +145,18 @@ fortify.hclust <- fortify.phylo4

 ##' @export

 fortify.dendrogram <- fortify.phylo4

+##' @method fortify agnes

+##' @export

+fortify.agnes <- fortify.phylo4

+

+##' @method fortify diana

+##' @export

+fortify.diana <- fortify.phylo4

+

+##' @method fortify twins

+##' @export

+fortify.twins <- fortify.phylo4

+

 ##' @method fortify phylog

 ##' @export

 fortify.phylog <- fortify.phylo4

@@ -145,6 +145,10 @@ fortify.hclust <- fortify.phylo4

 ##' @export

 fortify.dendrogram <- fortify.phylo4

+##' @method fortify phylog

+##' @export

+fortify.phylog <- fortify.phylo4

+

 ##' @method fortify phylo4d

 ##' @importFrom treeio as.treedata

 ##' @export

@@ -122,6 +122,11 @@ fortify.phylo4 <- function(model, data,

                            right     = FALSE,

                            mrsd      = NULL,

                            ...) {

+    if (is(model, "dendrogram")) {

+        as.phylo <- phylogram::as.phylo

+    }

+

+    

     phylo <- as.phylo(model)

     df <- fortify.phylo(phylo, data,

                         layout, ladderize, right, mrsd=mrsd, ...)

@@ -128,6 +128,18 @@ fortify.phylo4 <- function(model, data,

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

 }

+## `ape::as.phylo` (for `hclust`)

+

+##' @method fortify hclust

+##' @export

+fortify.hclust <- fortify.phylo4

+

+## `phylogram::as.phylo` (for `dendrogram`).

+

+##' @method fortify dendrogram

+##' @export

+fortify.dendrogram <- fortify.phylo4

+

 ##' @method fortify phylo4d

 ##' @importFrom treeio as.treedata

 ##' @export

@@ -14,6 +14,7 @@ fortify.phylo <- function(model, data,

                           mrsd          = NULL,

                           as.Date       = FALSE,

                           yscale        = "none",

+                          root.position = 0,

                           ...) {

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

@@ -39,7 +40,7 @@ fortify.phylo <- function(model, data,

         ypos <- getYcoord(x)

         N <- Nnode(x, internal.only=FALSE)

-        xypos <- tibble::data_frame(node=1:N, x=xpos, y=ypos)

+        xypos <- tibble::data_frame(node=1:N, x=xpos + root.position, y=ypos)

         df <- as_tibble(model) %>%

             mutate_(isTip = ~(! node %in% parent))

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

 ##' @importFrom ape ladderize

 ##' @importFrom treeio as.phylo

 ##' @importFrom treeio Nnode

-##' @importFrom tibble data_frame

 ##' @importFrom dplyr full_join

 ##' @importFrom dplyr mutate_

 ##' @importFrom tidytree as_tibble

@@ -40,7 +39,7 @@ fortify.phylo <- function(model, data,

         ypos <- getYcoord(x)

         N <- Nnode(x, internal.only=FALSE)

-        xypos <- data_frame(node=1:N, x=xpos, y=ypos)

+        xypos <- tibble::data_frame(node=1:N, x=xpos, y=ypos)

         df <- as_tibble(model) %>%

             mutate_(isTip = ~(! node %in% parent))

@@ -4,7 +4,7 @@

 ##' @importFrom tibble data_frame

 ##' @importFrom dplyr full_join

 ##' @importFrom dplyr mutate_

-##' @importFrom tidytree as_data_frame

+##' @importFrom tidytree as_tibble

 ##' @method fortify phylo

 ##' @export

 fortify.phylo <- function(model, data,

@@ -42,7 +42,7 @@ fortify.phylo <- function(model, data,

         N <- Nnode(x, internal.only=FALSE)

         xypos <- data_frame(node=1:N, x=xpos, y=ypos)

-        df <- as_data_frame(model) %>%

+        df <- as_tibble(model) %>%

             mutate_(isTip = ~(! node %in% parent))

         res <- full_join(df, xypos, by = "node")

@@ -30,7 +30,7 @@ fortify.phylo <- function(model, data,

     }

     if (layout %in% c("equal_angle", "daylight")) {

-        res <- layout.unrooted(x, layout.method = layout, branch.length = branch.length, ...)

+        res <- layout.unrooted(model, layout.method = layout, branch.length = branch.length, ...)

     } else {

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

             xpos <- getXcoord_no_length(x)

@@ -29,20 +29,24 @@ fortify.phylo <- function(model, data,

         }

     }

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

-        xpos <- getXcoord_no_length(x)

+    if (layout %in% c("equal_angle", "daylight")) {

+        res <- layout.unrooted(x, layout.method = layout, branch.length = branch.length, ...)

     } else {

-        xpos <- getXcoord(x)

-    }

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

+            xpos <- getXcoord_no_length(x)

+        } else {

+            xpos <- getXcoord(x)

+        }

-    ypos <- getYcoord(x)

-    N <- Nnode(x, internal.only=FALSE)

-    xypos <- data_frame(node=1:N, x=xpos, y=ypos)

+        ypos <- getYcoord(x)

+        N <- Nnode(x, internal.only=FALSE)

+        xypos <- data_frame(node=1:N, x=xpos, y=ypos)

-    df <- as_data_frame(model) %>%

-        mutate_(isTip = ~(! node %in% parent))

+        df <- as_data_frame(model) %>%

+            mutate_(isTip = ~(! node %in% parent))

-    res <- full_join(df, xypos, by = "node")

+        res <- full_join(df, xypos, by = "node")

+    }

     ## add branch mid position

     res <- calculate_branch_mid(res)

@@ -1,352 +1,111 @@

-##' convert polytomy to binary tree

-##'

-##' as.binary method for \code{phylo} object

-##' @rdname as.binary

-##' @return binary tree

-##' @method as.binary phylo

-##' @importFrom ape is.binary.tree

+##' @importFrom ape ladderize

+##' @importFrom treeio as.phylo

+##' @importFrom treeio Nnode

+##' @importFrom tibble data_frame

+##' @importFrom dplyr full_join

+##' @importFrom dplyr mutate_

+##' @importFrom tidytree as_data_frame

+##' @method fortify phylo

 ##' @export

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

-##' @examples

-##' require(ape)

-##' tr <- read.tree(text="((A, B, C), D);")

-##' is.binary.tree(tr)

-##' tr2 <- as.binary(tr)

-##' is.binary.tree(tr2)

-as.binary.phylo <- function(tree, ...) {

-    if(is.binary.tree(tree)) {

-        message("The input tree is already binary...")

-        invisible(tree)

+fortify.phylo <- function(model, data,

+                          layout        = "rectangular",

+                          ladderize     = TRUE,

+                          right         = FALSE,

+                          branch.length = "branch.length",

+                          mrsd          = NULL,

+                          as.Date       = FALSE,

+                          yscale        = "none",

+                          ...) {

+

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

+    if (ladderize == TRUE) {

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

     }

-    polyNode <- tree$edge[,1] %>% table %>% '>'(2) %>%

-        which %>% names %>% as.numeric

-

-    N <- getNodeNum(tree)

-    ii <- 0

-    for (pn in polyNode) {

-        idx <- which(tree$edge[,1] == pn)

-        while(length(idx) >2) {

-            ii <- ii + 1

-            newNode <- N+ii

-            tree$edge[idx[-1],1] <- newNode

-            newEdge <- matrix(c(tree$edge[idx[1],1], newNode), ncol=2)

-            tree$edge <- rbind(tree$edge, newEdge)

-            idx <- idx[-1]

+    if (! is.null(x$edge.length)) {

+        if (anyNA(x$edge.length)) {

+            warning("'edge.length' contains NA values...\n## setting 'edge.length' to NULL automatically when plotting the tree...")

+            x$edge.length <- NULL

         }

     }

-    tree$Nnode <- tree$Nnode+ii

-    tree$edge.length <- c(tree$edge.length, rep(0, ii))

-    return(tree)

-}

-

-

-##' remove singleton

-##'

-##'

-##' @title rm.singleton.newick

-##' @param nwk newick file

-##' @param outfile output newick file

-##' @return tree text

-##' @importFrom magrittr %<>%

-##' @importFrom magrittr add

-##' @importFrom ape write.tree

-##' @importFrom ape read.tree

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

-rm.singleton.newick <- function(nwk, outfile = NULL) {

-    tree <- readLines(nwk)

-

-    ## remove singleton of tips

-    nodePattern <- "\\w+:[\\.0-9Ee\\+\\-]+"

-    singletonPattern.with.nodename <- paste0(".*(\\(", nodePattern, "\\)\\w+:[\\.0-9Ee\\+\\-]+).*")

-    singletonPattern.wo.nodename <- paste0(".*(\\(", nodePattern, "\\):[\\.0-9Ee\\+\\-]+).*")

-

-    while(length(grep("\\([^,]+\\)", tree)) > 0) {

-        singleton <- gsub(singletonPattern.with.nodename, "\\1", tree)

-        if (singleton == tree) {

-            singleton <- gsub(singletonPattern.wo.nodename, "\\1", tree)

-        }

-        if (singleton == tree) {

-            stop("can't parse singleton node...")

-        }

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

+        xpos <- getXcoord_no_length(x)

+    } else {

+        xpos <- getXcoord(x)

+    }

-        tip <- gsub("\\((\\w+).*", "\\1", singleton)

+    ypos <- getYcoord(x)

+    N <- Nnode(x, internal.only=FALSE)

+    xypos <- data_frame(node=1:N, x=xpos, y=ypos)

-        len1 <- gsub(".*[^\\.0-9Ee\\+\\-]+([\\.0-9Ee\\+\\-]+)", "\\1", singleton)

-        len2 <- gsub(".*:([\\.0-9Ee\\+\\-]+)\\).*", "\\1", singleton)

-        len <- as.numeric(len1) + as.numeric(len2)

+    df <- as_data_frame(model) %>%

+        mutate_(isTip = ~(! node %in% parent))

-        tree <- gsub(singleton, paste0(tip, ":", len), tree, fixed = TRUE)

-    }

+    res <- full_join(df, xypos, by = "node")

-    tree <- read.tree(text=tree)

+    ## add branch mid position

+    res <- calculate_branch_mid(res)

-    ### remove singleton of internal nodes

-    p.singleton <- which(table(tree$edge[,1]) == 1)

-    if (length(p.singleton) > 0) {

-        p.singleton %<>% names %>% as.numeric

-        edge <- tree$edge

-        idx <- which(edge[,1] == p.singleton)

-        sidx <- which(edge[,2] == p.singleton)

-        edge[sidx,2] <- edge[idx, 2]

-        edge <- edge[-idx,]

-        tree$edge <- edge

-        tree$edge.length[sidx] %<>% add(., tree$edge.length[idx])

-        tree$edge.length <- tree$edge.length[-idx]

-        tree$Nnode <- tree$Nnode - 1

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

-            tree$node.label <- tree$node.label[-(p.singleton - Ntip(tree))]

-        }

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

+        res <- scaleX_by_time_from_mrsd(res, mrsd, as.Date)

     }

-    if (!is.null(outfile)) {

-        write.tree(tree, file=outfile)

+    if (layout == "slanted") {

+        res <- add_angle_slanted(res)

+    } else {

+        ## angle for all layout, if 'rectangular', user use coord_polar, can still use angle

+        res <- calculate_angle(res)

     }

-    invisible(tree)

+    res <- scaleY(as.phylo(model), res, yscale, layout, ...)

+    class(res) <- c("tbl_tree", class(res))

+    return(res)

 }

-## ##' @method fortify beast

-## ##' @export

-## fortify.beast <- function(model, data,

-##                           layout        = "rectangular",

-##                           yscale        = "none",

-##                           ladderize     = TRUE,

-##                           right         = FALSE,

-##                           branch.length = "branch.length",

-##                           ndigits       = NULL,

-##                           mrsd = NULL, ...) {

-

-##     model <- set_branch_length(model, branch.length)

-##     phylo <- model@phylo

-##     df    <- fortify(phylo,

-##                      layout = layout,

-##                      branch.length = branch.length,

-##                      ladderize = ladderize,

-##                      right = right,

-##                      mrsd = mrsd, ...)

-

-##     stats <- model@stats

-

-##     scn <- colnames(stats)

-##     scn <- scn[scn != 'node']

-

-##     for (cn in scn) {

-##         if (cn %in% colnames(df)) {

-##             colnames(stats)[colnames(stats) == cn] <- paste0(cn, "_")

-##             msg <- paste("feature", cn, "was renamed to", paste0(cn, "_"), "due to name conflict...")

-##             warning(msg)

-##         }

-##     }

-

-##     idx <- which(colnames(stats) != "node")

-##     for (ii in idx) {

-##         if (is.character_beast(stats, ii)) {

-##             len <- sapply(stats[,ii], length)

-##             if (any(len > 1)) {

-##                 stats[,ii] %<>% sapply(., function(x) {

-##                     y <- unlist(x) %>% as.character %>%

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

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

-##                         return(y)

-##                     } else {

-##                         return(paste0('{', paste0(y, collapse = ','), '}'))

-##                     }

-##                 })

-##             } else {

-##                 stats[,ii] %<>% unlist %>% as.character %>%

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

-##             }

-##             next

-##         }

-

-##         len <- sapply(stats[,ii], length)

-##         if ( all(len == 1) ) {

-##             stats[, ii] %<>% unlist %>% as.character %>% as.numeric

-##             if (!is.null(ndigits)) {

-##                 stats[, ii] %<>% round(., ndigits)

-##             }

-##         } else if (all(len <= 2)) {

-##             stats[, ii] %<>% sapply(., function(x) {

-##                 y <- unlist(x) %>% as.character %>% as.numeric

-##                 if (!is.null(ndigits)) {

-##                     y %<>% round(., ndigits)

-##                 }

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

-##                     return(y)

-##                 } else {

-##                     return(paste0('[', paste0(y, collapse = ','), ']'))

-##                 }

-##             })

-##         } else {

-##             stats[,ii] %<>% sapply(., function(x) {

-##                 y <- unlist(x) %>% as.character %>% as.numeric

-##                 if (!is.null(ndigits)) {

-##                     y %<>% round(., ndigits)

-##                 }

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

-##                     return(y)

-##                 } else {

-##                     return(paste0('{', paste0(y, collapse = ','), '}'))

-##                 }

-##             })

-##         }

-##     }

-

-

-##     cn <- colnames(stats)

-##     lo <- cn[grep("_lower", cn)]

-##     hi <- gsub("lower$", "upper", lo)

-##     rid <- gsub("_lower$", "", lo)

-

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

-##         stats[, rid[i]] <- paste0("[", stats[, lo[i]], ",", stats[, hi[i]], "]")

-##         stats[is.na(stats[, lo[i]]), rid[i]] <- NA

-##     }

-

-##     idx   <- match(df$node, stats$node)

-##     stats <- stats[idx,]

-##     cn_stats <- colnames(stats)

-##     stats <- stats[, cn_stats != "node"]

-

-##     df <- cbind(df, stats)

-##     if (is(stats, "data.frame") == FALSE) {

-##         colnames(df)[colnames(df) == "stats"] <- cn_stats[cn_stats != "node"]

-##     }

-

-##     df <- scaleY(phylo, df, yscale, layout, ...)

-

-##     append_extraInfo(df, model)

-## }

-

-## ##' @method fortify codeml

-## ##' @export

-## fortify.codeml <- function(model, data,

-##                            layout        = "rectangular",

-##                            yscale        = "none",

-##                            ladderize     = TRUE,

-##                            right         = FALSE,

-##                            branch.length = "mlc.branch.length",

-##                            ndigits       = NULL,

-##                            mrsd          = NULL,

-##                            ...) {

-

-##     dNdS <- model@mlc@dNdS

-##     if (branch.length == "branch.length") {

-##         message("branch.length setting to mlc.branch.length by default...")

-##         branch.length <- "mlc.branch.length"

-##     }

-##     length <- match.arg(branch.length,

-##                         c("none",

-##                           "mlc.branch.length",

-##                           "rst.branch.length",

-##                           colnames(dNdS)[-c(1,2)])

-##                         )

-

-##     if (length == "rst.branch.length") {

-##         phylo <- get.tree(model@rst)

-##     } else {

-##         if (length == "mlc.branch.length") {

-##             length <- "branch.length"

-##         }

-##         mlc <- set_branch_length(model@mlc, length)

-##         phylo <- get.tree(mlc)

-##     }

-

-##     df <- fortify(phylo, data, layout, ladderize, right,

-##                   branch.length=length, mrsd=mrsd, ...)

-

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

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

-##     df <- scaleY(phylo, df, yscale, layout, ...)

-

-##     append_extraInfo(df, model)

-## }

-

-

-## ##' @method fortify codeml_mlc

-## ##' @export

-## fortify.codeml_mlc <- function(model, data,

-##                                layout        = "rectangular",

-##                                yscale        = "none",

-##                                ladderize     = TRUE,

-##                                right         = FALSE,

-##                                branch.length = "branch.length",

-##                                ndigits       = NULL,

-##                                mrsd          = NULL,

-##                                ...) {

-

-##     model <- set_branch_length(model, branch.length)

-##     phylo <- get.tree(model)

-##     df <- fortify(phylo, data, layout, ladderize, right,

-##                   branch.length=branch.length, mrsd=mrsd, ...)

-

-##     dNdS <- model@dNdS

-

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

-##     df <- scaleY(phylo, df, yscale, layout, ...)

-

-##     append_extraInfo(df, model)

-## }

-

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

-##     if (!is.null(ndigits)) {

-##         idx <- which(! colnames(dNdS) %in% c("node", "parent"))

-##         for (ii in idx) {

-##             if (is.numeric(dNdS[, ii])) {

-##                 dNdS[, ii] <- round(dNdS[,ii], ndigits)

-##             }

-##         }

-##     }

-

-##     res <- merge(df, dNdS,

-##                  by.x  = c("node", "parent"),

-##                  by.y  = c("node", "parent"),

-##                  all.x = TRUE)

-

-##     res[match(df$node, res$node),]

-## }

-

-

-## ##' @method fortify paml_rst

-## ##' @export

-## fortify.paml_rst <- function(model, data,

-##                              layout    = "rectangular",

-##                              yscale    = "none",

-##                              ladderize = TRUE,

-##                              right     = FALSE,

-##                              mrsd      = NULL,

-##                              ...) {

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

-##     df <- merge_phylo_anno.paml_rst(df, model)

-##     df <- scaleY(model@phylo, df, yscale, layout, ...)

-

-##     append_extraInfo(df, model)

-## }

-

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

-##     types <- get.fields(model)

-##     types <- types[grepl('subs', types)]

-##     for (type in types) {

-##         anno <- get.subs(model, type=type)

-##         colnames(anno)[2] <- type

-##         df <- df %add2% anno

-##     }

-##     return(df)

-## }

-

-

-## ##' @method fortify phangorn

-## ##' @export

-## fortify.phangorn <- fortify.paml_rst

-