@@ -7,8 +7,7 @@ Authors@R: c(

 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com", rol = c("aut", "ths")),

 	   person("Justin", "Silverman", email = "jsilve24@gmail.com", rol = "ctb", comment = "geom_balance"),

 	   person("Casey", "Dunn", email = "casey_dunn@brown.edu", rol = "ctb",

-	          comment = c("propose using txtConnection so that parser functions can use tree strings as input",

-		  "modified nhx parsing to retain tip node numbers"))

+	          comment = c("NHX"))

 	   )

 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>

 Description: 'ggtree' extends the 'ggplot2' plotting system which implemented the grammar of graphics.

@@ -157,10 +157,7 @@ exportMethods(plot)

 exportMethods(reroot)

 exportMethods(scale_color)

 exportMethods(show)

-importFrom(ape,Nnode)

-importFrom(ape,Ntip)

 importFrom(ape,di2multi)

-importFrom(ape,drop.tip)

 importFrom(ape,extract.clade)

 importFrom(ape,getMRCA)

 importFrom(ape,is.binary.tree)

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

 CHANGES IN VERSION 1.7.3

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

+ o drop.tip method for NHX object <2016-11-11, Fri>

  o update startup message <2016-11-09, Wed>

  o reverse timescale x-axis <2016-11-07, Mon>

    + https://github.com/GuangchuangYu/ggtree/issues/87

@@ -164,3 +164,19 @@ setGeneric("scale_color", function(object, by, ...) standardGeneric("scale_color

 ##' @return figure

 ##' @export

 setGeneric("gzoom", function(object, focus, subtree=FALSE, widths=c(.3, .7), ...) standardGeneric("gzoom"))

+

+

+##' @docType methods

+##' @name drop.tip

+##' @rdname drop.tip-methods

+##' @title drop.tip method

+##' @param object An nhx or phylo object

+##' @param tip a vector of mode numeric or character specifying the tips to delete

+##' @param ... additional parameters

+##' @return updated object

+##' @export

+setGeneric (

+	name = "drop.tip",

+	def = function( object, tip, ... )

+		{ standardGeneric("drop.tip") }

+)

@@ -28,12 +28,11 @@ rtree <- ape::rtree

 ##' merge phylo and output of boot.phylo to 'apeBootstrap' object

 ##'

-##' 

+##'

 ##' @title apeBoot

 ##' @param phylo phylo

 ##' @param boot bootstrap values

 ##' @return an instance of 'apeBootstrap'

-##' @importFrom ape Nnode

 ##' @export

 ##' @author Guangchuang Yu

 apeBoot <- function(phylo, boot) {

@@ -53,7 +52,7 @@ setMethod("show", signature(object = "apeBootstrap"),

           function(object) {

               cat("'apeBoot' S4 object that stored bootstrap value generated by 'ape::boot.phylo'", ".\n\n")

               cat("...@ tree: ")

-              print.phylo(get.tree(object))                  

+              print.phylo(get.tree(object))

           })

@@ -1,24 +1,23 @@

 ##' collapse binary tree to polytomy by applying 'fun' to 'feature'

 ##'

-##' 

+##'

 ##' @title as.polytomy

 ##' @param tree tree object

 ##' @param feature selected feature

 ##' @param fun function to select nodes to collapse

 ##' @return polytomy tree

 ##' @author Guangchuang

-##' @importFrom ape Ntip

 ##' @importFrom ape di2multi

 ##' @export

 as.polytomy <- function(tree, feature, fun) {

     if (!is(tree, 'phylo')) {

         stop("currently only 'phylo' object is supported...")

     }

-    

+

     df <- fortify(tree)

     phylo <- get.tree(tree)

-    

+

     if (feature == 'node.label') {

         feat <- df[!df$isTip, 'label']

     } else if (feature == 'tip.label') {

@@ -26,7 +25,7 @@ as.polytomy <- function(tree, feature, fun) {

     } else {

         feat <- df[, feature]

     }

-    

+

     idx <- which(fun(feat))

     if (feature == 'node.label') {

         nodes <- Ntip(phylo) + df$node[idx]

@@ -36,7 +35,7 @@ as.polytomy <- function(tree, feature, fun) {

     edge_idx <- match(nodes, phylo$edge[,2])

     phylo$edge.length[edge_idx] <- 0

     poly_tree <- di2multi(phylo)

-    ## 

+    ##

     ## map stats to poly_tree and update tree object

     ##

     return(poly_tree)

@@ -1,12 +1,11 @@

 ##' merge two tree object

 ##'

-##' 

+##'

 ##' @title merge_tree

 ##' @param obj1 tree object 1

 ##' @param obj2 tree object 2

 ##' @return tree object

 ##' @importFrom magrittr %<>%

-##' @importFrom ape Ntip

 ##' @export

 ##' @author Guangchuang Yu

 merge_tree <- function(obj1, obj2) {

@@ -14,11 +13,11 @@ merge_tree <- function(obj1, obj2) {

     ## INFO:

     ## ape::all.equal.phylo can be used to test equal phylo topology.

     ##

-    

+

     if (has.slot(obj1, "extraInfo") == FALSE) {

         stop("input tree object is not supported...")

     }

-    

+

     if ((is.tree(obj1) & is.tree(obj2)) == FALSE) {

         stop("input should be tree objects...")

     }

@@ -33,7 +32,7 @@ merge_tree <- function(obj1, obj2) {

     if (Ntip(tr1) != Ntip(tr2)) {

         stop("number of tips not equals...")

     }

-    

+

     if (all(tr1$tip.label %in% tr2$tip.label) == FALSE) {

         stop("tip names not match...")

     }

@@ -56,7 +55,7 @@ merge_tree <- function(obj1, obj2) {

     node_map$from %<>% c(root.2)

     node_map$to %<>% c(root)

-    

+

     currentNode <- 1:Ntip(tr1)

     while(length(currentNode)) {

         p1 <- sapply(currentNode, getParent, tr=tr1)

@@ -75,7 +74,7 @@ merge_tree <- function(obj1, obj2) {

             tr2$edge[jj,1] <- p1[notNA]

         }

-        

+

         ii <- match(p2, tr2$edge[,2])

         if (length(ii)) {

             notNA <- which(!is.na(ii))

@@ -87,7 +86,7 @@ merge_tree <- function(obj1, obj2) {

         node_map$from %<>% c(p2)

         node_map$to %<>% c(p1)

-        

+

         ## parent of root will return 0, which is in-valid node ID

         currentNode <- unique(p1[p1 != 0])

     }

@@ -95,7 +94,7 @@ merge_tree <- function(obj1, obj2) {

     if ( any(tr2$edge != tr2$edge) ) {

         stop("trees are not identical...")

     }

-    

+

     node_map.df <- do.call("cbind", node_map)

     node_map.df <- unique(node_map.df)

     node_map.df <- node_map.df[node_map.df[,1] != 0,]

@@ -118,6 +117,6 @@ merge_tree <- function(obj1, obj2) {

         info <- merge(extraInfo, info2, by.x =c("node", "parent"), by.y = c("node", "parent"))

         obj1@extraInfo <- info

     }

-    

+

     return(obj1)

 }

@@ -1,57 +1,69 @@

-#' Drop a tip

-#' 

-#' @param object An nhx object

-#' @return An nhx object

-#' @export

-setGeneric (

-	name = "drop.tip", 

-	def = function( object, ... ) 

-		{ standardGeneric("drop.tip") }

-)

-

-

 ##' drop.tip method

 ##'

 ##'

-##' @docType methods

-##' @name drop.tip

 ##' @rdname drop.tip-methods

 ##' @aliases drop.tip,nhx

 ##' @exportMethod drop.tip

-##' @author Casey Dunn \url{http://dunnlab.org}

-##' @usage drop.tip(object, tip...)

+##' @author Casey Dunn \url{http://dunnlab.org}  and Guangchuang Yu \url{https://guangchuangyu.github.io}

+##' @usage drop.tip(object, tip, ...)

 setMethod("drop.tip", signature(object="nhx"),

-		function(object, tip) {

+          function(object, tip, ...) {

+

+              ## label the internal tree nodes by their number

+              no_node_label <- FALSE

+              if (is.null(object@phylo$node.label)) {

+                  object@phylo$node.label <- Ntip(object) + (1:Nnode(object))

+                  no_node_label <- TRUE

+              }

+

+              ## Prepare the nhx object for subsampling

+              object@nhx_tags$node <- as.numeric(object@nhx_tags$node)

+              object@nhx_tags <- object@nhx_tags[order(object@nhx_tags$node),]

+

+              ## add a colmn that has labels for both tips and internal nodes

+              object@nhx_tags$node.label <- c(object@phylo$tip.label, as.character(object@phylo$node.label))

-			# label the internal tree nodes by their number

-			object@phylo$node.label = NULL

-			object@phylo$node.label = (length(object@phylo$tip.label)+1):max(object@phylo$edge)

+              ## Will need to take different approaches for subsampling tips

+              ## and internal nodes, add a column to make it easy to tell them apart

+              object@nhx_tags$is_tip <- object@nhx_tags$node <= Ntip(object)

-			# Prepare the nhx object for subsampling

-			object@nhx_tags$node = as.numeric(object@nhx_tags$node)

-			object@nhx_tags = object@nhx_tags[order(object@nhx_tags$node),]

+              ## Remove tips

+              object@phylo = ape::drop.tip( object@phylo, tip )

-			# add a colmn that has labels for both tips and internal nodes

-			object@nhx_tags$node.label = c(object@phylo$tip.label, as.character(object@phylo$node.label))

+              ## Subsample the tags

+              object@nhx_tags = object@nhx_tags[object@nhx_tags$node.label %in% (c(object@phylo$tip.label, as.character(object@phylo$node.label))),]

-			# Will need to take different approaches for subsampling tips 

-			# and internal nodes, add a column to make it easy to tell them apart

-			object@nhx_tags$is_tip = object@nhx_tags$node <= length(object@phylo$tip.label)

+              ## Update tip node numbers

+              tip_nodes <- object@nhx_tags$node.label[ object@nhx_tags$is_tip ]

+              internal_nodes <- object@nhx_tags$node.label[ !object@nhx_tags$is_tip ]

+              object@nhx_tags$node[ object@nhx_tags$is_tip ] = match(object@phylo$tip.label, tip_nodes)

+              object@nhx_tags$node[ !object@nhx_tags$is_tip ] = match(object@phylo$node.label, internal_nodes)

-			# Remove tips

-			object@phylo = ape::drop.tip( object@phylo, tip )

+              ## Clean up

+              object@nhx_tags$node.label = NULL

+              object@nhx_tags$is_tip = NULL

+              if (no_node_label) {

+                  object@phylo$node.label <- NULL

+              }

-			# Subsample the tags

-			object@nhx_tags = object@nhx_tags[object@nhx_tags$node.label %in% (c(object@phylo$tip.label, as.character(object@phylo$node.label))),]

+              return(object)

+          })

-			# Update tip node numbers

-			tip_nodes = object@nhx_tags$node.label[ object@nhx_tags$is_tip ]

-			object@nhx_tags$node[ object@nhx_tags$is_tip ] = match(object@phylo$tip.label, tip_nodes)

-			# Clean up

-			object@nhx_tags$node.label = NULL

-			object@nhx_tags$is_tip = NULL

-            return(object)

-		})

+

+##' @rdname drop.tip-methods

+##' @exportMethod drop.tip

+##' @aliases drop.tip,phylo

+##' @source

+##' drop.tip for phylo object is a wrapper method of ape::drop.tip

+##' from the ape package. The documentation you should

+##' read for the drop.tip function can be found here: \link[ape]{drop.tip}

+##'

+##' @seealso

+##' \link[ape]{drop.tip}

+setMethod("drop.tip", signature(object="phylo"),

+          function(object, tip, ...){

+              ape::drop.tip(object, tip, ...)

+          })

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

-##' plots simultaneously a whole phylogenetic tree and a portion of it. 

+##' plots simultaneously a whole phylogenetic tree and a portion of it.

+##'

 ##'

-##' 

 ##' @title gzoom

 ##' @param phy phylo object

 ##' @param focus selected tips

@@ -9,7 +9,6 @@

 ##' @return a list of ggplot object

 ##' @importFrom ggplot2 xlim

 ##' @importFrom ggplot2 scale_color_manual

-##' @importFrom ape drop.tip

 ##' @author ygc

 ##' @examples

 ##' require(ape)

@@ -28,14 +27,14 @@ gzoom.phylo <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) {

     cols <- c("black", "red")[foc+1]

     p1 <- ggtree(phy, color=cols)

-    

+

     subtr <- drop.tip(phy, phy$tip.label[-focus],

                       subtree=subtree, rooted=TRUE)

-    

+

     p2 <- ggtree(subtr, color="red") + geom_tiplab(hjust=-0.05)

     p2 <- p2 + xlim(0, max(p2$data$x)*1.2)

-    multiplot(p1, p2, ncol=2, widths=widths) 

-    

+    multiplot(p1, p2, ncol=2, widths=widths)

+

     invisible(list(p1=p1, p2=p2))

 }

@@ -68,7 +67,7 @@ setMethod("gzoom", signature(object="apeBootstrap"),

 ##' zoom selected subtree

 ##'

-##' 

+##'

 ##' @rdname gzoom-methods

 ##' @exportMethod gzoom

 setMethod("gzoom", signature(object="beast"),

@@ -1,8 +1,8 @@

 ##' site mask

 ##'

-##' 

+##'

 ##' @title mask

-##' @param tree_object tree object 

+##' @param tree_object tree object

 ##' @param field selected field

 ##' @param site site

 ##' @param mask_site if TRUE, site will be masked.

@@ -38,15 +38,15 @@ mask <- function(tree_object, field, site, mask_site=FALSE) {

         gsub("^[a-zA-Z]+", "", . ) %>%

         gsub("[a-zA-Z]\\s*$", "", .) %>%

         as.numeric

-    

+

     if (mask_site == FALSE) {

         pos2 <- 1:max(pos)

         pos2 <- pos2[-site]

         site <- pos2

     }

-    

+

     site <- site[site %in% pos]

-    

+

     for (i in seq_along(field_data)) {

         if (is.na(field_data[i]))

             next

@@ -95,7 +95,7 @@ read.dnds_mlc <- function(mlcfile) {

     mlc <- readLines(mlcfile)

     i <- grep("dN & dS for each branch", mlc)

     j <- grep("tree length for dN", mlc)

-    

+

     mlc <- mlc[i:j]

     hi <- grep("dN/dS", mlc)

     cn <- strsplit(mlc[hi], " ") %>% unlist %>% `[`(nzchar(.))

@@ -110,14 +110,14 @@ read.dnds_mlc <- function(mlcfile) {

         yy <- c(edge, y[-1])

         as.numeric(yy)

     }))

-             

+

     row.names(res) <- NULL

     colnames(res) <- c("parent", "node", cn[-1])

     colnames(res) <- gsub("\\*", "_x_", colnames(res))

     colnames(res) <- gsub("\\/", "_vs_", colnames(res))

     return(res)

 }

-    

+

 read.treetext_paml_mlc <- function(mlcfile) {

     read.treetext_paml(mlcfile, "mlc")

 }

@@ -138,14 +138,13 @@ read.treetext_paml <- function(file, by) {

     } else {

         stop("_by_ should be one of 'rst' or 'mlc'")

     }

-        

+

     return(x[tr.idx][ii])

 }

-##' @importFrom ape Ntip

 read.phylo_paml_mlc <- function(mlcfile) {

     parent <- node <- label <- NULL

-    

+

     mlc <- readLines(mlcfile)

     edge <- get_tree_edge_paml(mlc)

@@ -189,7 +188,7 @@ read.phylo_paml_mlc <- function(mlcfile) {

                 }

                 treeinfo[ii, "visited"] <- TRUE

             }

-            

+

         }

         currentNode <- unique(pNode)

     }

@@ -211,7 +210,7 @@ read.phylo_paml_mlc <- function(mlcfile) {

 ##' @importFrom ape reorder.phylo

 read.phylo_paml_rst <- function(rstfile) {

     parent <- node <- label <- NULL

-    

+

     ## works fine with baseml and codeml

     rst <- readLines(rstfile)

     tr.idx <- get_tree_index_paml(rst)

@@ -220,7 +219,7 @@ read.phylo_paml_rst <- function(rstfile) {

     tr3 <- read.tree(text=rst[tr.idx][3])

     edge <- get_tree_edge_paml(rst)

-    

+

     label=c(tr3$tip.label, tr3$node.label)

     root <- getRoot(tr3)

     label %<>% `[`(. != root)

@@ -231,14 +230,14 @@ read.phylo_paml_rst <- function(rstfile) {

     ## node.length$node <- sub("_\\w+", "", node.length$label

     node.length$node <- gsub("^(\\d+)_.*", "\\1", node.length$label)

     node.length$label %<>% sub("\\d+_", "", .)

-    

+

     edge <- as.data.frame(edge)

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

     treeinfo <- merge(edge, node.length, by.x="node", by.y="node")

     edge2 <- treeinfo[, c("parent", "node")]

     edge2 %<>% as.matrix

-    

+

     ntip <- Ntip(tr3)

     phylo <- with(treeinfo,

@@ -253,7 +252,7 @@ read.phylo_paml_rst <- function(rstfile) {

     class(phylo) <- "phylo"

     phylo <- reorder.phylo(phylo, "cladewise")

-    

+

     return(phylo)

 }

@@ -262,10 +261,10 @@ read.ancseq_paml_rst <- function(rstfile, by="Marginal") {

     rst <- readLines(rstfile)

     by <- match.arg(by, c("Marginal", "Joint"))

-    query <- paste(by, "reconstruction of ancestral sequences") 

+    query <- paste(by, "reconstruction of ancestral sequences")

     idx <- grep(query, rst)

     if(length(idx) == 0) {

-        ## in some paml setting, joint_ancseq are not available. 

+        ## in some paml setting, joint_ancseq are not available.

         return("")

     }

     si <- grep("reconstructed sequences", rst)

@@ -323,13 +322,13 @@ set.paml_rst_ <- function(object) {

     if (length(object@tip_seq) == 0) {

         return(object)

     }

-    

+

     types <- get.fields(object)

     for (type in types) {

         value <- subs_paml_rst(object, type)

         if (all(is.na(value)))

             next

-        

+

         if (type == "marginal_subs") {

             object@marginal_subs <- value

         } else if (type == "marginal_AA_subs") {

@@ -1,3 +1,16 @@

+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

+}

+

 filename <- function(file) {

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

@@ -12,7 +25,7 @@ filename <- function(file) {

 ##' @importFrom ggplot2 last_plot

 get_tree_view <- function(tree_view) {

-    if (is.null(tree_view)) 

+    if (is.null(tree_view))

         tree_view <- last_plot()

     return(tree_view)

@@ -33,7 +46,7 @@ has.field <- function(tree_object, field) {

     if ( ! field %in% get.fields(tree_object) ) {

         return(FALSE)

     }

-    

+

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

         is_codeml <- TRUE

         tree <- tree_object@rst

@@ -41,22 +54,22 @@ has.field <- function(tree_object, field) {

         is_codeml <- FALSE

         tree <- tree_object

     }

-    

+

     if (.hasSlot(tree, field)) {

         has_slot <- TRUE

     } else {

         has_slot <- FALSE

     }

-    

+

     if (has_slot == FALSE) {

         if (has.extraInfo(tree_object) == FALSE) {

             return(FALSE)

         }

-        

+

         if (nrow(tree_object@extraInfo) == 0) {

             return(FALSE)

         }

-        

+

         if (!field %in% colnames(tree_object@extraInfo)) {

             return(FALSE)

         }

@@ -82,7 +95,7 @@ has.extraInfo <- function(object) {

         return(TRUE)

     }

-    return(FALSE)        

+    return(FALSE)

 }

 append_extraInfo <- function(df, object) {

@@ -110,7 +123,7 @@ get.fields.tree <- function(object) {

     } else {

         fields <- object@fields

     }

-    

+

     if (has.slot(object, "extraInfo")) {

         extraInfo <- object@extraInfo

         if (nrow(extraInfo) > 0) {

@@ -124,7 +137,7 @@ get.fields.tree <- function(object) {

 }

 print_fields <- function(object, len=5) {

-    fields <- get.fields(object)    

+    fields <- get.fields(object)

     n <- length(fields)

     i <- floor(n/len)

     for (j in 0:i) {

@@ -158,7 +171,7 @@ plot.subs <- function(x, layout, show.tip.label,

                       position, annotation,

                       annotation.color = "black",

                       annotation.size=3, ...) {

-    

+

     p <- ggtree(x, layout=layout, ...)

     if (show.tip.label) {

         p <- p + geom_tiplab(hjust = tip.label.hjust,

@@ -174,7 +187,7 @@ plot.subs <- function(x, layout, show.tip.label,

 .add_new_line <- function(res) {

     ## res <- paste0(strwrap(res, 50), collapse="\n")

-    ## res %<>% gsub("\\s/\n", "\n", .) %>% gsub("\n/\\s", "\n", .) 

+    ## res %<>% gsub("\\s/\n", "\n", .) %>% gsub("\n/\\s", "\n", .)

     if (nchar(res) > 50) {

         idx <- gregexpr("/", res)[[1]]

         i <- idx[floor(length(idx)/2)]

@@ -198,7 +211,7 @@ get.subs_ <- function(tree, fasta, translate=TRUE, removeGap=TRUE) {

         }

         .add_new_line(res)

     })

-    

+

     dd <- data.frame(node=node, parent=parent, label=label, subs=subs)

     dd <- dd[dd$parent != 0,]

     dd <- dd[, -c(1,2)]

@@ -214,7 +227,7 @@ getSubsLabel <- function(seqs, A, B, translate, removeGap) {

     if (nchar(seqA) != nchar(seqB)) {

         stop("seqA should have equal length to seqB")

     }

-    

+

     if (translate == TRUE) {

         AA <- seqA %>% seq2codon %>% codon2AA

         BB <- seqB %>% seq2codon %>% codon2AA

@@ -227,7 +240,7 @@ getSubsLabel <- function(seqs, A, B, translate, removeGap) {

         AA <- strsplit(seqA, split="") %>% unlist

         BB <- strsplit(seqB, split="") %>% unlist

     }

-    

+

     ii <- which(AA != BB)

     if (removeGap == TRUE) {

@@ -239,11 +252,11 @@ getSubsLabel <- function(seqs, A, B, translate, removeGap) {

             ii <- ii[AA[ii] != "-" & BB[ii] != "-"]

         }

     }

-    

+

     if (length(ii) == 0) {

         return(NULL)

     }

-    

+

     res <- paste(AA[ii], ii, BB[ii], sep="", collapse=" / ")

     return(res)

 }

@@ -255,7 +268,7 @@ seq2codon <- function(x) {

 ## @importFrom Biostrings GENETIC_CODE

 codon2AA <- function(codon) {

     ## a genetic code name vector

-    GENETIC_CODE <- get_fun_from_pkg("Biostrings", "GENETIC_CODE") 

+    GENETIC_CODE <- get_fun_from_pkg("Biostrings", "GENETIC_CODE")

     aa <- GENETIC_CODE[codon]

     aa[is.na(aa)] <- "X"

     return(aa)

@@ -327,22 +340,22 @@ jplace_treetext_to_phylo <- function(tree.text) {

     ##                         edgeNum = as.numeric(gsub(".+\\{", "", edgeLN)))

     ## xx <- merge(edgeLN.df, edgeNum.df, by.x="node", by.y="node")

-    

+

     return(phylo)

 }

 extract.treeinfo.jplace <- function(object, layout="phylogram", ladderize=TRUE, right=FALSE, ...) {

     tree <- get.tree(object)

-    

+

     df <- fortify.phylo(tree, layout=layout, ladderize=ladderize, right=right, ...)

     edgeNum.df <- attr(tree, "edgeNum")

     if (!is.null(edgeNum.df)) {

-        df2 <- merge(df, edgeNum.df, by.x="node", by.y="node", all.x=TRUE) 

+        df2 <- merge(df, edgeNum.df, by.x="node", by.y="node", all.x=TRUE)

         df <- df2[match(df[, "node"], df2[, "node"]),]

     }

-    

+

     attr(df, "ladderize") <- ladderize

     attr(df, "right") <- right

     return(df)

@@ -356,7 +369,7 @@ edgeNum2nodeNum <- function(jp, edgeNum) {

     if (length(idx) == 0) {

         return(NA)

     }

-    

+

     edges[idx, "node"]

 }

@@ -427,7 +440,7 @@ is.tree_attribute <- function(df, var) {

        !is.null(var)    &&

        var %in% colnames(df)) {

         return(TRUE)

-    } 

+    }

     return(FALSE)

 }

@@ -483,14 +496,14 @@ roundDigit <- function(d) {

 ## from ChIPseeker

 ##' @importFrom grDevices colorRampPalette

 getCols <- function (n) {

-    col <- c("#8dd3c7", "#ffffb3", "#bebada", "#fb8072", "#80b1d3", 

-             "#fdb462", "#b3de69", "#fccde5", "#d9d9d9", "#bc80bd", 

+    col <- c("#8dd3c7", "#ffffb3", "#bebada", "#fb8072", "#80b1d3",

+             "#fdb462", "#b3de69", "#fccde5", "#d9d9d9", "#bc80bd",

              "#ccebc5", "#ffed6f")

-    col2 <- c("#1f78b4", "#ffff33", "#c2a5cf", "#ff7f00", "#810f7c", 

-              "#a6cee3", "#006d2c", "#4d4d4d", "#8c510a", "#d73027", 

+    col2 <- c("#1f78b4", "#ffff33", "#c2a5cf", "#ff7f00", "#810f7c",

+              "#a6cee3", "#006d2c", "#4d4d4d", "#8c510a", "#d73027",

               "#78c679", "#7f0000", "#41b6c4", "#e7298a", "#54278f")

-    col3 <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99", 

-              "#e31a1c", "#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a", 

+    col3 <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99",

+              "#e31a1c", "#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a",

               "#ffff99", "#b15928")

     colorRampPalette(col3)(n)

 }

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

 [![releaseVersion](https://img.shields.io/badge/release%20version-1.6.2-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![develVersion](https://img.shields.io/badge/devel%20version-1.7.3-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-16443/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)

-[![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--11--10-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--11--11-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)

@@ -1,17 +1,42 @@

 % Generated by roxygen2: do not edit by hand

-% Please edit documentation in R/method-drop-tip.R

+% Please edit documentation in R/AllGenerics.R, R/method-drop-tip.R

 \docType{methods}

 \name{drop.tip}

 \alias{drop.tip}

 \alias{drop.tip,nhx}

+\alias{drop.tip,nhx-method}

+\alias{drop.tip,phylo}

+\alias{drop.tip,phylo-method}

 \title{drop.tip method}

+\source{

+drop.tip for phylo object is a wrapper method of ape::drop.tip

+from the ape package. The documentation you should

+read for the drop.tip function can be found here: \link[ape]{drop.tip}

+}

 \usage{

-drop.tip(object, tip...)

+drop.tip(object, tip, ...)

+

+drop.tip(object, tip, ...)

+

+\S4method{drop.tip}{phylo}(object, tip, ...)

+}

+\arguments{

+\item{object}{An nhx or phylo object}

+

+\item{tip}{a vector of mode numeric or character specifying the tips to delete}

+

+\item{...}{additional parameters}

+}

+\value{

+updated object

 }

 \description{

 drop.tip method

 }

 \author{

-Casey Dunn \url{http://dunnlab.org}

+Casey Dunn \url{http://dunnlab.org}  and Guangchuang Yu \url{https://guangchuangyu.github.io}

+}

+\seealso{

+\link[ape]{drop.tip}

 }

deleted file mode 100644

@@ -1,18 +0,0 @@

-% Generated by roxygen2: do not edit by hand

-% Please edit documentation in R/method-drop-tip.R

-\name{drop.tip}

-\alias{drop.tip}

-\title{Drop a tip}

-\usage{

-drop.tip(object, ...)

-}

-\arguments{

-\item{object}{An nhx object}

-}

-\value{

-An nhx object

-}

-\description{

-Drop a tip

-}

-

@@ -7,16 +7,16 @@ test_phyldog_nhx_text = "(((Prayidae_D27SS7@2825365:0.0682841[&&NHX:Ev=S:S=58:ND

 test_notung_nhx_text = "((((Rhizophysa_filiformis@2564549:0.09666991738603078[&&NHX:S=Rhizophysa_filiformis],((Marrus_claudanielis@2027078:0.03368582974818837[&&NHX:S=Marrus_claudanielis],((Erenna_richardi@1434201:0.014306889954561298[&&NHX:S=Erenna_richardi],Marrus_claudanielis@2027079:0.010842363778569869[&&NHX:S=Marrus_claudanielis])n5940011:0.01779384958849464[&&NHX:S=n57:D=N],(((Agalma_elegans@88626:0.05872379503260147[&&NHX:S=Agalma_elegans],Lychnagalma_utricularia@1828459:0.04211137470826968[&&NHX:S=Lychnagalma_utricularia])n5940018:0.02375590664436535[&&NHX:S=n47:D=N],(((Bargmannia_amoena@3459111:0.19058396964770352[&&NHX:S=Bargmannia_amoena],Bargmannia_elongata@469437:1.00000050002909E-6[&&NHX:S=Bargmannia_elongata])n5939974:0.11560220708003867[&&NHX:S=n22:D=N],Cordagalma_sp_@1115328:0.04829417133033771[&&NHX:S=Cordagalma_sp_])n5939976:0.011316847557531757[&&NHX:S=n62:D=N],Forskalia_asymmetrica@1220430:0.01667566952752948[&&NHX:S=Forskalia_asymmetrica])n5939978:0.0063213422810751655[&&NHX:S=n62:D=Y])n5940014:0.017792661031819083[&&NHX:S=n62:D=Y],(Resomia_ornicephala@2657185:0.004262563771468986[&&NHX:S=Resomia_ornicephala],Frillagalma_vityazi@663744:0.028441637105547157[&&NHX:S=Frillagalma_vityazi])n5939981:0.006136291467151878[&&NHX:S=n51:D=N])n5940013:0.013546839136761205[&&NHX:S=n62:D=Y])n5940012:0.011839606018978143[&&NHX:S=n62:D=Y])n5940008:0.013840645450221475[&&NHX:S=n62:D=Y],(((Chelophyes_appendiculata@1615707:0.007647023552225329[&&NHX:S=Chelophyes_appendiculata],Clytia_hemisphaerica@756642:0.643907456299178[&&NHX:S=Clytia_hemisphaerica])n5939984:0.08603691877960613[&&NHX:S=n67:D=N],(Chuniphyes_multidentata@930929:0.01248550133310033[&&NHX:S=Chuniphyes_multidentata],Kephyes_ovata@1966030:0.014671165587181996[&&NHX:S=Kephyes_ovata])n5939987:0.013285803501636162[&&NHX:S=n27:D=N])n5939988:0.008000411801689693[&&NHX:S=n67:D=Y],(((Hippopodius_hippopus@1084434:0.0505718831943577[&&NHX:S=Hippopodius_hippopus],Prayidae_D27D2@2878798:0.00905875758406546[&&NHX:S=Prayidae_D27D2])n5939991:0.021772123626769023[&&NHX:S=n38:D=N],Prayidae_D27SS7@2181711:0.029009000260863272[&&NHX:S=Prayidae_D27SS7])n5939993:1.00000050002909E-6[&&NHX:S=n38:D=Y],Prayidae_D27D2@2878801:1.00000050002909E-6[&&NHX:S=Prayidae_D27D2])n5939995:0.00916688375355408[&&NHX:S=n38:D=Y])n5939996:0.05191099091093772[&&NHX:S=n67:D=Y])n5940006:0.03953811931719265[&&NHX:S=n67:D=Y])n5940005:0.10134081070615458[&&NHX:S=n67:D=Y],(Podocoryna_carnea@3033951:0.11270255504816476[&&NHX:S=Podocoryna_carnea],Hydractinia_symbiolongicarpus@1679508:0.030168043235021993[&&NHX:S=Hydractinia_symbiolongicarpus])n5939999:0.17223048099362362[&&NHX:S=n11:D=N])n5940003:0.16233679521228994[&&NHX:S=n67:D=Y],Hydra_magnipapillata@801936:0.585696573276294[&&NHX:S=Hydra_magnipapillata])n5940002:0.4403044529817829[&&NHX:S=n68:D=N],Aegina_citrea@825314:0.4403044529817829[&&NHX:S=Aegina_citrea])n5942419[&&NHX:S=n70:D=N];"

-# A function to simplify NHX text so that it can be parsed by 

-# ape::read.tree(). Discards much useful information. Intent is to 

+# A function to simplify NHX text so that it can be parsed by

+# ape::read.tree(). Discards much useful information. Intent is to

 # be able to compare node annotations that have been independently

-# parsed with different methods. 

+# parsed with different methods.

 simplify_nhx_string <- function( text ){

 	# Remove branch lengths so NHX tags are adjacent to nodes

 	# Accommodate lengths in scientific notation, eg 1e-6

 	text = gsub( "\\:[\\d\\.]+e[\\d\\-]+","", text, perl=TRUE )

 	text = gsub( "\\:[\\d\\.]+","", text, perl=TRUE )

-	

+

 	# Remove NHX tags at tips

 	text = gsub( "([^\\)])\\[.+?\\]","\\1", text, perl=TRUE )

@@ -27,7 +27,7 @@ simplify_nhx_string <- function( text ){

 	# Replace NHX tag formatting characters that aren't allowed

 	text = gsub( ":","_", text, perl=TRUE )

 	text = gsub( "=","-", text, perl=TRUE )

-	

+

 	return(text)

 }

@@ -78,8 +78,9 @@ test_that("can parse phyldog nhx tree string", {

 test_that("can drop tips", {

 	nhx <- read.nhx( textConnection(test_phyldog_nhx_text) )

-		to_drop = c("Physonect_sp_@2066767", "Lychnagalma_utricularia@2253871", "Kephyes_ovata@2606431")

-	

+        to_drop = c("Physonect_sp_@2066767", "Lychnagalma_utricularia@2253871", "Kephyes_ovata@2606431")

+

 	nhx_reduced = drop.tip(nhx, to_drop)

 	expect_equal( length(nhx_reduced@phylo$tip.label), 13 )

-})

\ No newline at end of file

+        expect_true( all(nhx_reduced@nhx_tags$node %in% fortify(nhx_reduced)$node) )

+})