@@ -184,6 +184,7 @@ importFrom(magrittr,equals)

 importFrom(methods,is)

 importFrom(methods,missingArg)

 importFrom(tidyr,gather)

+importFrom(treeio,as.phylo)

 importFrom(treeio,as.treedata)

 importFrom(treeio,get.placements)

 importFrom(treeio,groupClade)

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

 CHANGES IN VERSION 1.7.5

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

+ o fortify.phylo4d via converting phylo4d to treedata object <2016-12-28, Wed>

  o improve viewClade function, use coord_cartesian instead of xlim <2016-12-28, Wed>

  o remove codes that move to treeio and now ggtree depends treeio <2016-12-20, Tue>

@@ -389,10 +389,11 @@ scaleY <- function(phylo, df, yscale, layout, ...) {

 ##' @method fortify phylo4

+##' @importFrom treeio as.phylo

 ##' @export

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

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

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

+    phylo <- as.phylo(model)

     df <- fortify.phylo(phylo, data,

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

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

@@ -403,36 +404,17 @@ fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none",

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

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

                             mrsd=NULL, ...) {

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

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

-    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, ...)

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

+    ## phylo <- as.phylo.phylo4(model)

+    ## 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, ...)

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

 }

-as.phylo.phylo4 <- function(phylo4) {

-    edge <- phylo4@edge

-    edge <- edge[edge[,1] != 0, ]

-    edge.length <- phylo4@edge.length

-    edge.length <- edge.length[!is.na(edge.length)]

-    tip.id <- sort(setdiff(edge[,2], edge[,1]))

-    tip.label <- phylo4@label[tip.id]

-    phylo <- list(edge = edge,

-                  edge.length = edge.length,

-                  tip.label = tip.label)

-

-    node.id <- sort(unique(edge[,1]))

-    node.id <- node.id[node.id != 0]

-    node.label <- phylo4@label[node.id]

-    if (!all(is.na(node.label))) {

-        phylo$node.label <- node.label

-    }

-    phylo$Nnode <- length(node.id)

-    class(phylo) <- "phylo"

-    return(phylo)

-}

+

 ##' fortify a phylo to data.frame

 ##'

@@ -1,10 +1,12 @@

 ##' @importFrom ggplot2 fortify

 ##' @method fortify treedata

 ##' @export

-fortify.treedata <- function(model, data, layout="rectangular", branch.length ="branch.length",

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

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

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

+                             mrsd=NULL, ...) {

+

     model <- set_branch_length(model, branch.length)

-    

+

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

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

         xpos <- getXcoord_no_length(x)

@@ -27,7 +29,7 @@ fortify.treedata <- function(model, data, layout="rectangular", branch.length ="

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

     res <- calculate_angle(res)

-    res

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

 }

 ##' @method as.data.frame treedata

@@ -824,11 +826,7 @@ set_branch_length <- function(tree_object, branch.length) {

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

         return(tree_object)

     } else if (branch.length == "none") {

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

-            tree_object@edge.length <- NULL

-        } else { 

-            tree_object@phylo$edge.length <- NULL

-        }

+        tree_object@phylo$edge.length <- NULL

         return(tree_object)

     }

@@ -836,11 +834,7 @@ set_branch_length <- function(tree_object, branch.length) {

         return(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 if (is(tree_object, "codeml")) {

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

         tree_anno <- tree_object@mlc@dNdS

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

         tree_anno <- tree_object@dNdS

@@ -850,10 +844,8 @@ set_branch_length <- function(tree_object, branch.length) {

         tree_anno <- get_tree_data(tree_object)

     }

-    if (!is(tree_object, "phylo4d")) {

-        phylo <- get.tree(tree_object)

-    }

-    

+    phylo <- get.tree(tree_object)

+

     cn <- colnames(tree_anno)

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

@@ -876,11 +868,7 @@ set_branch_length <- function(tree_object, branch.length) {

     phylo$edge.length <- len

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

-        tree_object@edge.length <- phylo$edge.length

-    } else {

-        tree_object@phylo <- phylo

-    }

+    tree_object@phylo <- phylo

     return(tree_object)

 }

@@ -12,163 +12,3 @@ get.tree <- treeio::get.tree

 drop.tip <- treeio::drop.tip

 get.fields <- treeio::get.fields

-

-## filename <- function(file) {

-##     ## textConnection(text_string) will work just like a file

-##     ## in this case, just set the filename as ""

-##     file_name <- ""

-##     if (is.character(file)) {

-##         file_name <- file

-##     }

-##     return(file_name)

-## }

-

-## ##' read nhx tree file

-## ##'

-## ##'

-## ##' @title read.nhx

-## ##' @param file nhx file

-## ##' @return nhx object

-## ##' @export

-## ##' @author Guangchuang Yu \url{https://guangchuangyu.github.io}

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

-##     treetext <- suppressWarnings(readLines(file))

-##     treetext <- treetext[treetext != ""]

-##     treetext <- treetext[treetext != " "]

-

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

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

-##     }

-##     treetext %<>% gsub(" ", "",. )

-

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

-##     nnode <- phylo$Nnode + Ntip(phylo)

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

-##     tree2 <- treetext

-

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

-##         tree2 <- sub("(\\w+)?(:?\\d*\\.?\\d*[Ee]?[\\+\\-]?\\d*)?\\[&&NHX.*?\\]", paste0("\\", nlab[i], "\\2"), tree2)

-##     }

-

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

-##     treeinfo <- fortify(phylo2)

-##     node <- treeinfo$node[match(nlab, sub(".+(X\\d+)$","\\1",treeinfo$label))] # as.character

-

-##     nhx.matches <- gregexpr("(\\w+)?(:?\\d*\\.?\\d*[Ee]?[\\+\\-]?\\d*)?\\[&&NHX.*?\\]", treetext)

-##     matches <- nhx.matches[[1]]

-##     match.pos <- as.numeric(matches)

-##     if (length(match.pos) == 1 && (match.pos == -1)) {

-##         nhx_tags <- data.frame(node = as.numeric(treeinfo$node))

-##     } else {

-##         match.len <- attr(matches, 'match.length')

-

-##         nhx_str <- substring(treetext, match.pos, match.pos+match.len-1)

-

-##         ## nhx_features <- gsub("^(\\w+)?:?\\d*\\.?\\d*[Ee]?[\\+\\-]?\\d*", "", nhx_str) %>%

-##         nhx_features <- gsub("^[^\\[]*", "", nhx_str) %>%

-##             gsub("\\[&&NHX:", "", .) %>%

-##             gsub("\\]", "", .)

-

-##         nhx_tags <- get_nhx_feature(nhx_features)

-##         fields <- names(nhx_tags)

-##         for (i in ncol(nhx_tags)) {

-##             if(any(grepl("\\D+", nhx_tags[,i])) == FALSE) {

-##                 ## should be numerical varialbe

-##                 nhx_tags[,i] <- as.numeric(nhx_tags[,i])

-##             }

-##         }

-##         nhx_tags$node <- as.numeric(node)

-##     }

-

-##     # Order rows by row number to facilitate downstream manipulations

-##     nhx_tags=nhx_tags[order(nhx_tags$node),]

-

-##     new("nhx",

-##         file = filename(file),

-##         fields = fields,

-##         phylo = phylo,

-##         nhx_tags = nhx_tags

-##         )

-## }

-

-

-## get_nhx_feature <- function(nhx_features) {

-##     nameSET <- strsplit(nhx_features, split=":") %>% unlist %>%

-##         gsub("=.*", "", .) %>% unique

-##     lapply(nhx_features, get_nhx_feature_internal, nameSET=nameSET) %>%

-##         do.call(rbind, .) %>% as.data.frame(., stringsAsFactors = FALSE)

-## }

-

-## get_nhx_feature_internal <- function(feature, nameSET) {

-##     x <- strsplit(feature, ":") %>% unlist

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

-##     val <- gsub(".*=", "", x)

-

-##     names(val) <- name

-##     y <- character(length(nameSET))

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

-##         if (nameSET[i] %in% name) {

-##             y[i] <- val[nameSET[i]]

-##         } else {

-##             y[i] <- NA

-##         }

-##     }

-##     names(y) <- nameSET

-##     return(y)

-## }

-

-

-

-

-

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

-## ##' @exportMethod get.fields

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

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

-##               get.fields.tree(object)

-##           }

-##           )

-

-

-## Ntip <- function(tree) {

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

-##     length(phylo$tip.label)

-## }

-

-## Nnode <- function(tree, internal.only=TRUE) {

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

-##     if (internal.only)

-##         return(phylo$Nnode)

-

-##     Ntip(phylo) + phylo$Nnode

-## }

-

-

-## has.extraInfo <- function(object) {

-##     if (!is.tree(object)) {

-##         return(FALSE)

-##     }

-

-##     if (! .hasSlot(object, "extraInfo")) {

-##         return(FALSE)

-##     }

-

-##     extraInfo <- object@extraInfo

-

-##     if (nrow(extraInfo) > 0) {

-##         return(TRUE)

-##     }

-

-##     return(FALSE)

-## }

-

-## ##' @importFrom methods .hasSlot is missingArg new slot slot<-

-## has.slot <- function(object, slotName) {

-##     if (!isS4(object)) {

-##         return(FALSE)

-##     }

-##     .hasSlot(object, slotName)

-##     ## slot <- tryCatch(slot(object, slotName), error=function(e) NULL)

-##     ## ! is.null(slot)

-## }

-