Merge pull request #61 from xiangpin/as.phylo_as.treedata

As.phylo as.treedata

Author: GuangchuangYu

R/method-as-phylo.R

@@ -20,6 +20,11 @@ as.phylo.tbl_df <- function(x, length, ...) {
     }
 
     edge <- check_edgelist(x)
+    indx <- attr(edge, "indx")
+    if (!is.null(indx) && !is.null(edge.length)){
+        edge.length <- edge.length[indx]
+        attr(edge, "indx") <- NULL
+    }
     phylo <- read.tree(text = .write.tree4(edge,
                                            id_as_label=TRUE,
                                            edge.length = edge.length),

R/method-as-treedata.R

@@ -57,7 +57,12 @@ as.treedata.ggtree <- function(tree, ...) {
 ##' @export
 as.treedata.tbl_df <- function(tree, ...) {
     edgelist <- as_tibble(tree)
-
+    edge <- check_edgelist(edgelist)
+    indx <- attr(edge, "indx")
+    if (!is.null(indx)){
+        edgelist <- edgelist[indx,]
+        attr(edge, "indx") <- NULL
+    }
     phylo <- as.phylo.tbl_df(edgelist, ...)
 
     res <- new("treedata",
@@ -74,7 +79,7 @@ as.treedata.tbl_df <- function(tree, ...) {
 
         lab <- c(phylo$tip.label, phylo$node.label)
 
-        edge <- check_edgelist(edgelist)
+        #edge <- check_edgelist(edgelist)
         children <- edge[,2]
 
         d$node <- match(children, lab)

R/utilities.R

@@ -9,11 +9,20 @@ check_edgelist <- function(edgelist) {
         children <- edgelist[[2]]
         parents <- edgelist[[1]]
     }
-    root <- unique(parents[!(parents %in% children)])
-    if (length(root) != 1)
+    root1 <- unique(parents[!(parents %in% children)])
+    root2 <- unique(parents[parents == children])
+    if (length(root1) != 1 && length(root2) != 1)
         stop("Cannot find root. network is not a tree!")
-
-    matrix(c(parents, children), ncol=2)
+    if (length(root1) != 1 && length(root2) == 1){
+        indx <- parents != children
+        parents <- parents[indx]
+        children <- children[indx]
+        edge <- matrix(c(parents, children), ncol=2)
+        attr(edge, "indx") <- indx
+    }else{
+        edge <- matrix(c(parents, children), ncol=2)
+    }
+    return (edge)
 }