@@ -82,6 +82,7 @@ export(msaplot)

 export(multiplot)

 export(nodebar)

 export(nodepie)

+export(open_tree)

 export(phyPML)

 export(phylopic)

 export(plot)

@@ -102,6 +103,7 @@ export(read.tree)

 export(reroot)

 export(rescale_tree)

 export(rotate)

+export(rotate_tree)

 export(rtree)

 export(scaleClade)

 export(scale_color)

@@ -1,5 +1,7 @@

 CHANGES IN VERSION 1.5.3

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

+ o add angle in ggtree function, fan layout supported <2016-05-12, Thu>

+ o rotate_tree and open_tree function <2016-05-12, Thu> 

  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

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

+

+

 ##' return a data.frame that contains position information 

 ##' for labeling column names of heatmap produced by `gheatmap` function

 ##'

@@ -25,120 +27,6 @@ get_heatmap_column_position <- function(treeview, by="bottom") {

     return(mapping)

 }

-##' multiple sequence alignment with phylogenetic tree

-##'

-##' 

-##' @title msaplot

-##' @param p tree view

-##' @param fasta fasta file, multiple sequence alignment

-##' @param offset offset of MSA to tree

-##' @param width total width of alignment, compare to width of tree

-##' @param color color 

-##' @param window specific a slice to display

-##' @return tree view

-##' @export

-##' @importFrom Biostrings readBStringSet

-##' @importMethodsFrom Biostrings width

-## @importFrom colorspace rainbow_hcl

-##' @importFrom ggplot2 geom_segment

-##' @importFrom ggplot2 geom_rect

-##' @importFrom ggplot2 scale_fill_manual

-##' @author Guangchuang Yu

-msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL){

-    if (missingArg(fasta)) {

-        aln <- NULL

-    } else if (is(fasta, "BStringSet")) {

-        aln <- fasta

-    } else if (is(fasta, "character")) {

-        aln <- readBStringSet(fasta)

-    } else {

-        aln <- NULL

-    }

-        

-    if (is(p, "phylip")) {

-        aln <- p@sequence

-        p <- ggtree(p) + geom_tiplab()

-    }

-

-    if (is.null(aln)) {

-        stop("multiple sequence alignment is not available...\n-> check the parameter 'fasta'...")

-    }

-    

-    if (is.null(window)) {

-        window <- c(1, width(aln)[1])

-    }

-    slice <- seq(window[1], window[2], by=1)

-    

-    seqs <- lapply(1:length(aln), function(i) {

-        x <- toString(aln[i])

-        seq <- substring(x, slice, slice)

-

-        seq[seq == '?'] <- '-'

-        seq[seq == '*'] <- '-'

-        seq[seq == ' '] <- '-'

-        return(seq)

-    })

-    names(seqs) <- names(aln)

-    

-    if(is.null(color)) {

-        alphabet <- unlist(seqs) %>% unique

-        alphabet <- alphabet[alphabet != '-']

-        ## color <- rainbow_hcl(length(alphabet))

-        color <- getCols(length(alphabet))

-        names(color) <- alphabet

-        color <- c(color, '-'=NA)

-    }

-

-    df <- p$data

-    ## if (is.null(width)) {

-    ##     width <- (df$x %>% range %>% diff)/500

-    ## }

-

-    ## convert width to width of each cell

-    width <- width * (df$x %>% range %>% diff) / diff(window)

-    

-    df=df[df$isTip,]

-    start <- max(df$x) * 1.02 + offset

-

-    seqs <- seqs[df$label[order(df$y)]]

-    ## seqs.df <- do.call("rbind", seqs)

-

-    h <- ceiling(diff(range(df$y))/length(df$y))

-    xmax <- start + seq_along(slice) * width

-    xmin <- xmax - width

-    y <- sort(df$y)

-    ymin <- y - 0.4 *h

-    ymax <- y + 0.4 *h

-

-    from <- to <- NULL

-    

-    lines.df <- data.frame(from=min(xmin), to=max(xmax), y = y)

-

-    p <- p + geom_segment(data=lines.df, aes(x=from, xend=to, y=y, yend=y))

-    msa <- lapply(1:length(y), function(i) {

-        data.frame(name=names(seqs)[i],

-                   xmin=xmin,

-                   xmax=xmax,

-                   ymin=ymin[i],

-                   ymax=ymax[i],

-                   seq=seqs[[i]])

-    })

-

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

-

-    p <- p + geom_rect(data=msa.df, aes(x=xmin, y=ymin, 

-                           xmin=xmin, xmax=xmax,

-                           ymin=ymin, ymax=ymax, fill=seq)) +

-                               scale_fill_manual(values=color)

-

-    breaks <- hist(seq_along(slice), breaks=10, plot=FALSE)$breaks

-    pos <- start + breaks * width

-    mapping <- data.frame(from=breaks+1, to=pos)

-    attr(p, "mapping") <- mapping

-    

-    return(p)

-}

-

 ##' scale x for tree with heatmap

 ##'

 ##' 

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

 ##' @title ggtree

 ##' @param tr phylo object

 ##' @param mapping aes mapping

-##' @param layout one of 'rectangular', 'slanted', 'fan'/'circular', 'radial' or 'unrooted'

+##' @param layout one of 'rectangular', 'slanted', 'fan', 'circular', 'radial' or 'unrooted'

+##' @param open.angle open angle, only for 'fan' layout

 ##' @param mrsd most recent sampling date

 ##' @param as.Date logical whether using Date class in time tree

 ##' @param yscale y scale

@@ -32,6 +33,7 @@

 ggtree <- function(tr,

                    mapping        = NULL,

                    layout         = "rectangular",

+                   open.angle     = 0,

                    mrsd           = NULL,

                    as.Date        = FALSE,

                    yscale         = "none",

@@ -52,15 +54,7 @@ ggtree <- function(tr,

         ## for 2d tree

         layout <- "slanted"

     }

-    if (layout == "fan" || layout == "circular") {

-        layout <- "circular"

-        type <- "circular"

-    } else if (layout == "radial") {

-        layout <- "slanted"

-        type <- "radial"

-    } else {

-        type <- "none"

-    }

+

     if (is.null(mapping)) {

         mapping <- aes_(~x, ~y)

     } else {

@@ -88,12 +82,14 @@ ggtree <- function(tr,

     p <- p + theme_tree()

-    if (type == "circular" || type == "radial") {

-        p <- p + coord_polar(theta = "y")

+    if (layout == "circular" || layout == "radial") {

+        p <- layout_circular(p)

         ## refer to: https://github.com/GuangchuangYu/ggtree/issues/6

         ## and also have some space for tree scale (legend)

         p <- p + scale_y_continuous(limits=c(0, max(p$data$y)+1))

-    } 

-

+    } else if (layout == "fan") {

+        p <- layout_fan(p, open.angle)

+    }

+    

     return(p)

 }

new file mode 100644

@@ -0,0 +1,46 @@

+##' rotate circular tree

+##'

+##' 

+##' @title rotate_tree

+##' @param treeview tree view

+##' @param angle angle

+##' @return updated tree view

+##' @export

+##' @author Guangchuang Yu

+rotate_tree <- function(treeview, angle) {

+    treeview <- treeview + coord_polar(theta='y', start=(angle-90)/180*pi, -1)

+    treeview$data$angle <- treeview$data$angle + angle

+    return(treeview)

+}

+

+

+layout_circular <- function(treeview) {

+    treeview + coord_polar(theta='y', start=-pi/2, -1)

+}

+

+##' open tree with specific angle

+##'

+##' 

+##' @title open_tree

+##' @param treeview tree view

+##' @param angle angle

+##' @return updated tree view

+##' @export

+##' @author Guangchuang Yu

+open_tree <- function(treeview, angle) {

+    p <- layout_circular(treeview)

+    ymax <- max(range(p$data$y))

+    p <- p + scale_y_continuous(limits = c(0,

+                                           max(c(ymax * (1+angle/(360-angle)), ymax+1))

+                                           ))

+    N <- nrow(p$data)

+    idx <- match(1:N, order(p$data$y))

+    NN <- N *(1+angle/(360-angle))

+    angle <- 360/(3+NN) * (1:N+1)

+    angle <- angle[idx]

+    p$data$angle <- angle

+    return(p)

+}

+

+layout_fan <- open_tree

+    

@@ -584,9 +584,11 @@ as.data.frame.phylo_ <- function(x, layout="rectangular",

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

     ## if (layout == "circular") {

     idx <- match(1:N, order(res$y))

-    angle <- -360/(3+N) * (1:N+1)

+    ## angle <- -360/(3+N) * (1:N+1)

+    angle <- 360/(3+N) * (1:N+1)

     angle <- angle[idx]

-    res$angle <- angle + 90

+    ## res$angle <- angle + 90

+    res$angle <- angle

     ## } 

     return(res)

new file mode 100644

@@ -0,0 +1,114 @@

+##' multiple sequence alignment with phylogenetic tree

+##'

+##' 

+##' @title msaplot

+##' @param p tree view

+##' @param fasta fasta file, multiple sequence alignment

+##' @param offset offset of MSA to tree

+##' @param width total width of alignment, compare to width of tree

+##' @param color color 

+##' @param window specific a slice to display

+##' @return tree view

+##' @export

+##' @importFrom Biostrings readBStringSet

+##' @importMethodsFrom Biostrings width

+## @importFrom colorspace rainbow_hcl

+##' @importFrom ggplot2 geom_segment

+##' @importFrom ggplot2 geom_rect

+##' @importFrom ggplot2 scale_fill_manual

+##' @author Guangchuang Yu

+msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL){

+    if (missingArg(fasta)) {

+        aln <- NULL

+    } else if (is(fasta, "BStringSet")) {

+        aln <- fasta

+    } else if (is(fasta, "character")) {

+        aln <- readBStringSet(fasta)

+    } else {

+        aln <- NULL

+    }

+        

+    if (is(p, "phylip")) {

+        aln <- p@sequence

+        p <- ggtree(p) + geom_tiplab()

+    }

+

+    if (is.null(aln)) {

+        stop("multiple sequence alignment is not available...\n-> check the parameter 'fasta'...")

+    }

+    

+    if (is.null(window)) {

+        window <- c(1, width(aln)[1])

+    }

+    slice <- seq(window[1], window[2], by=1)

+    

+    seqs <- lapply(1:length(aln), function(i) {

+        x <- toString(aln[i])

+        seq <- substring(x, slice, slice)

+

+        seq[seq == '?'] <- '-'

+        seq[seq == '*'] <- '-'

+        seq[seq == ' '] <- '-'

+        return(seq)

+    })

+    names(seqs) <- names(aln)

+    

+    if(is.null(color)) {

+        alphabet <- unlist(seqs) %>% unique

+        alphabet <- alphabet[alphabet != '-']

+        ## color <- rainbow_hcl(length(alphabet))

+        color <- getCols(length(alphabet))

+        names(color) <- alphabet

+        color <- c(color, '-'=NA)

+    }

+

+    df <- p$data

+    ## if (is.null(width)) {

+    ##     width <- (df$x %>% range %>% diff)/500

+    ## }

+

+    ## convert width to width of each cell

+    width <- width * (df$x %>% range %>% diff) / diff(window)

+    

+    df=df[df$isTip,]

+    start <- max(df$x) * 1.02 + offset

+

+    seqs <- seqs[df$label[order(df$y)]]

+    ## seqs.df <- do.call("rbind", seqs)

+

+    h <- ceiling(diff(range(df$y))/length(df$y))

+    xmax <- start + seq_along(slice) * width

+    xmin <- xmax - width

+    y <- sort(df$y)

+    ymin <- y - 0.4 *h

+    ymax <- y + 0.4 *h

+

+    from <- to <- NULL

+    

+    lines.df <- data.frame(from=min(xmin), to=max(xmax), y = y)

+

+    p <- p + geom_segment(data=lines.df, aes(x=from, xend=to, y=y, yend=y))

+    msa <- lapply(1:length(y), function(i) {

+        data.frame(name=names(seqs)[i],

+                   xmin=xmin,

+                   xmax=xmax,

+                   ymin=ymin[i],

+                   ymax=ymax[i],

+                   seq=seqs[[i]])

+    })

+

+    msa.df <- do.call("rbind", msa)

+

+    p <- p + geom_rect(data=msa.df, aes(x=xmin, y=ymin, 

+                           xmin=xmin, xmax=xmax,

+                           ymin=ymin, ymax=ymax, fill=seq)) +

+                               scale_fill_manual(values=color)

+

+    breaks <- hist(seq_along(slice), breaks=10, plot=FALSE)$breaks

+    pos <- start + breaks * width

+    mapping <- data.frame(from=breaks+1, to=pos)

+    attr(p, "mapping") <- mapping

+    

+    return(p)

+}

+

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

 \title{visualizing phylogenetic tree and heterogenous associated data based on grammar of graphics

 \code{ggtree} provides functions for visualizing phylogenetic tree and its associated data in R.}

 \usage{

-ggtree(tr, mapping = NULL, layout = "rectangular", mrsd = NULL,

-  as.Date = FALSE, yscale = "none", yscale_mapping = NULL,

+ggtree(tr, mapping = NULL, layout = "rectangular", open.angle = 0,

+  mrsd = NULL, as.Date = FALSE, yscale = "none", yscale_mapping = NULL,

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

   ndigits = NULL, ...)

 }

@@ -18,7 +18,9 @@ ggtree(tr, mapping = NULL, layout = "rectangular", mrsd = NULL,

 \item{mapping}{aes mapping}

-\item{layout}{one of 'rectangular', 'slanted', 'fan'/'circular', 'radial' or 'unrooted'}

+\item{layout}{one of 'rectangular', 'slanted', 'fan', 'circular', 'radial' or 'unrooted'}

+

+\item{open.angle}{open angle, only for 'fan' layout}

 \item{mrsd}{most recent sampling date}

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

 % Generated by roxygen2: do not edit by hand

-% Please edit documentation in R/experimental_function.R

+% Please edit documentation in R/msaplot.R

 \name{msaplot}

 \alias{msaplot}

 \title{msaplot}

new file mode 100644

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

+% Generated by roxygen2: do not edit by hand

+% Please edit documentation in R/layout.R

+\name{open_tree}

+\alias{open_tree}

+\title{open_tree}

+\usage{

+open_tree(treeview, angle)

+}

+\arguments{

+\item{treeview}{tree view}

+

+\item{angle}{angle}

+}

+\value{

+updated tree view

+}

+\description{

+open tree with specific angle

+}

+\author{

+Guangchuang Yu

+}

+

new file mode 100644

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

+% Generated by roxygen2: do not edit by hand

+% Please edit documentation in R/layout.R

+\name{rotate_tree}

+\alias{rotate_tree}

+\title{rotate_tree}

+\usage{

+rotate_tree(treeview, angle)

+}

+\arguments{

+\item{treeview}{tree view}

+

+\item{angle}{angle}

+}

+\value{

+updated tree view

+}

+\description{

+rotate circular tree

+}

+\author{

+Guangchuang Yu

+}

+