@@ -20,6 +20,7 @@ S3method(fortify,phylo4d)

 S3method(fortify,phyloseq)

 S3method(fortify,r8s)

 S3method(fortify,raxml)

+S3method(print,beastList)

 export("%<%")

 export("%<+%")

 export("%>%")

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

+CHANGES IN VERSION 1.5.3

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

+ o support reading BEAST MCC trees (multiple trees in one file) via the read.beast function <2016-05-12, Thu>

+ 

 CHANGES IN VERSION 1.5.2

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

  o add multiplot in ggtreeUtilities vignette <2016-05-12, Thu>

@@ -12,32 +12,53 @@

 ##' file <- system.file("extdata/BEAST", "beast_mcc.tree", package="ggtree")

 ##' read.beast(file)

 read.beast <- function(file) {

+    translation <- read.trans_beast(file)

+    treetext <- read.treetext_beast(file)

     stats <- read.stats_beast(file)

+    phylo <- read.nexus(file)

+    

+    if (length(treetext) == 1) {

+        obj <- BEAST(file, treetext, translation, stats, phylo)

+    } else {

+        obj <- lapply(seq_along(treetext), function(i) {

+            BEAST(file, treetext[i], translation, stats[[i]], phylo[[i]])

+        })

+        class(obj) <- "beastList"

+    }

+    return(obj)

+}

+

+

+BEAST <- function(file, treetext, translation, stats, phylo) {

     stats$node %<>% gsub("\"*'*", "", .)

     fields <- sub("_lower|_upper", "", names(stats)) %>% unique

     fields %<>% `[`(.!="node")

+        

+    phylo <- remove_quote_in_tree_label(phylo)

+        

+    obj <- new("beast",

+               fields      = fields,

+               treetext    = treetext,

+               phylo       = phylo,

+               translation = translation,

+               stats       = stats,

+               file        = filename(file)

+               )

+    return(obj)

+}

-    phylo <- read.nexus(file)

+remove_quote_in_tree_label <- function(phylo) {

     if (!is.null(phylo$node.label)) {

         phylo$node.label %<>% gsub("\"*'*", "", .)

     }

     if ( !is.null(phylo$tip.label)) {

         phylo$tip.label %<>% gsub("\"*'*", "", .) 

     }

-    

-    new("beast",

-        fields      = fields,

-        treetext    = read.treetext_beast(file),

-        phylo       = phylo,

-        translation = read.trans_beast(file),

-        stats       = stats,

-        file        = filename(file)

-        )

+    return(phylo)

 }

-

 ##' @rdname get.fields-methods

 ##' @exportMethod get.fields

 setMethod("get.fields", signature(object="beast"),

@@ -49,24 +70,33 @@ setMethod("get.fields", signature(object="beast"),

 read.treetext_beast <- function(file) {

     beast <- readLines(file)

-    ii <- grep("tree TREE1\\s+=", beast)

+    ## ii <- grep("^tree TREE1\\s+=", beast)

+    ii <- grep("^tree ", beast)

     if (length(ii) == 0) {

-        ii <- grep("begin trees;", beast)

+        ii <- grep("[Bb]egin trees;", beast)

     }

     jj <- grep("[Ee]nd;", beast)

-    jj <- jj[jj > ii][1]

-    tree <- beast[ii:(jj-1)]

-    if (length(tree) > 1) {

-        tree <- paste0(tree)

-    }

-    ## tree %<>% sub("tree TREE1\\s+=\\s+\\[&R\\]\\s+", "", .)

-    ## tree %<>% sub("[^(]*", "", .)

-    tree %<>% sub("[^=]+=", "", .) %>%

-        sub("\\s+\\[&R\\]\\s+", "", .) %>%

-            sub("[^(]*", "", .)

+    jj <- jj[jj > max(ii)][1]

+

+    ## tree <- beast[ii:(jj-1)]

+    ## if (length(tree) > 1) {

+    ##     tree <- paste0(tree)

+    ## }

+    ## tree %<>% sub("[^=]+=", "", .) %>%

+    ##     sub("\\s+\\[&R\\]\\s+", "", .) %>%

+    ##         sub("[^(]*", "", .)

+    

+    jj <- c(ii[-1], jj)

+    trees <- sapply(seq_along(ii), function(i) {

+        tree <- beast[ii[i]:(jj[i]-1)]

+        if (length(tree) > 1) {

+            tree <- paste0(tree)

+        }

+        sub("[^(]*", "", tree)

+    })

-    return(tree)

+    return(trees)

 }

 read.trans_beast <- function(file) {

@@ -89,20 +119,22 @@ read.trans_beast <- function(file) {

     return(trans)

 }

+

 read.stats_beast <- function(file) {

     beast <- readLines(file)

-    tree <- read.treetext_beast(file)

+    trees <- read.treetext_beast(file)

+    if (length(trees) == 1) {

+        return(read.stats_beast_internal(beast, trees))

+    }

+    lapply(trees, read.stats_beast_internal, beast=beast)

+}

+read.stats_beast_internal <- function(beast, tree) {

     tree2 <- gsub("\\[[^\\[]*\\]", "", tree)

     phylo <- read.tree(text = tree2)

-    if(is.null(phylo$node.label)) {

-        nnode <- phylo$Nnode

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

-        for (i in 1:nnode) {

-            tree2 <- sub("\\)([:;])", paste0("\\)", nlab[i], "\\1"), tree2)

-        }

-    }

+    tree2 <- add_pseudo_nodelabel(phylo, tree2)

+    

     ## node name corresponding to stats

     nn <- strsplit(tree2, split=",") %>% unlist %>%

         strsplit(., split="\\)") %>% unlist %>%

@@ -244,6 +276,18 @@ read.stats_beast <- function(file) {

     return(stats3)

 }

+add_pseudo_nodelabel <- function(phylo, treetext) {

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

+        nnode <- phylo$Nnode

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

+        for (i in 1:nnode) {

+            treetext <- sub("\\)([:;])", paste0("\\)", nlab[i], "\\1"), treetext)

+        }

+    }

+

+   return(treetext)

+}

+

 ##' @rdname reroot-methods

 ##' @exportMethod reroot

@@ -65,7 +65,7 @@ geom_hilight <- function(node, fill="steelblue", alpha=.5, extend=0, extendto=NU

 stat_hilight <- function(mapping=NULL, data=NULL, geom="rect",

                          position="identity",  node, 

                          show.legend=NA, inherit.aes=FALSE,

-                        fill, alpha, extend=0, xmax=NULL,

+                         fill, alpha, extend=0, extendto=NULL,

                          ...) {

     default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)

     if (is.null(mapping)) {

@@ -83,8 +83,10 @@ stat_hilight <- function(mapping=NULL, data=NULL, geom="rect",

         show.legend=show.legend,

         inherit.aes = inherit.aes,

         params = list(node=node,

-                      fill=fill, alpha=alpha,

-                      extend=extend, extendto=extendto,

+                      fill=fill,

+                      alpha=alpha,

+                      extend=extend,

+                      extendto=extendto,

                       ...)

         )

 }

@@ -24,7 +24,9 @@ read.hyphy <- function(nwk, ancseq, tip.fasfile=NULL) {

     seq       <- anc[(seq.start+1):(seq.end-1)]

     seq       <- seq[seq != ";"]

     seq       <- seq[seq != ""]

-

+    seq       <- gsub(" ", "", seq)

+    seq       <- gsub(";", "", seq)

+    

     ## some files may only contains sequences (should have TAXALABELS block that contains seq names).

     ## some may contains sequence name like phylip format in MATRIX block (no need to have TAXALABELS block).

     ##

new file mode 100644

@@ -0,0 +1,14 @@

+##' print information of a list of beast trees

+##'

+##' 

+##' @title print

+##' @param x a list of beast object

+##' @param ... no used

+##' @return message

+##' @method print beastList

+##' @export

+##' @author Guangchuang Yu

+print.beastList <- function(x, ...) {

+    msg <- paste(length(x), "beast trees")

+    cat(msg, "\n")

+}

@@ -1,5 +1,3 @@

-

-

 ##' @rdname show-methods

 ##' @importFrom ape print.phylo

 ##' @exportMethod show

@@ -209,6 +209,10 @@ getSubsLabel <- function(seqs, A, B, translate, removeGap) {

     seqA <- seqs[A]

     seqB <- seqs[B]

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

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

+    }

+    

     if (translate == TRUE) {

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

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

new file mode 100644

@@ -0,0 +1,23 @@

+% Generated by roxygen2: do not edit by hand

+% Please edit documentation in R/method-print.R

+\name{print.beastList}

+\alias{print.beastList}

+\title{print}

+\usage{

+\method{print}{beastList}(x, ...)

+}

+\arguments{

+\item{x}{a list of beast object}

+

+\item{...}{no used}

+}

+\value{

+message

+}

+\description{

+print information of a list of beast trees

+}

+\author{

+Guangchuang Yu

+}

+

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

 \usage{

 stat_hilight(mapping = NULL, data = NULL, geom = "rect",

   position = "identity", node, show.legend = NA, inherit.aes = FALSE,

-  fill, alpha, extend = 0, xmax = NULL, ...)

+  fill, alpha, extend = 0, extendto = NULL, ...)

 }

 \arguments{

 \item{mapping}{aes mapping}

@@ -29,9 +29,9 @@ stat_hilight(mapping = NULL, data = NULL, geom = "rect",

 \item{extend}{extend xmax of the rectangle}

-\item{...}{additional parameter}

-

 \item{extendto}{extend xmax to extendto}

+

+\item{...}{additional parameter}

 }

 \value{

 layer

@@ -33,6 +33,7 @@ collapse <- ggtree::collapse

 expand <- ggtree::expand

 rotate <- ggtree::rotate

 flip <- ggtree::flip

+MRCA <- ggtree::MRCA

 ```

 # Internal node number