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

 Package: ggtree

 Type: Package

 Title: a phylogenetic tree viewer for different types of tree annotations

-Version: 1.1.7

+Version: 1.1.8

 Author: Guangchuang Yu and Tommy Tsan-Yuk Lam

 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>

 Description: ggtree extends the ggplot2 plotting system which implemented the

@@ -47,6 +47,7 @@ export(groupClade)

 export(groupOTU)

 export(gzoom)

 export(hilight)

+export(mask)

 export(merge_tree)

 export(msaplot)

 export(phylopic)

@@ -62,7 +63,7 @@ export(read.tree)

 export(rtree)

 export(scaleClade)

 export(scale_color)

-export(scale_x_heatmap)

+export(scale_x_ggtree)

 export(theme_tree)

 export(theme_tree2)

 export(write.jplace)

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

+CHANGES IN VERSION 1.1.8

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

+ o mv scale_x_gheatmap to scale_x_ggtree, which also support msaplot <2015-06-02, Tue>

+ o add mask function <2015-06-02, Tue>

+ 

 CHANGES IN VERSION 1.1.7

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

  o add example of msaplot in vignette <2015-05-22, Fri>

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

 ##' @param p tree view

 ##' @param data matrix or data.frame

 ##' @param offset offset of heatmap to tree

-##' @param width width of each cell in heatmap

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

 ##' @param low color of lowest value

 ##' @param high color of highest value

 ##' @param color color of heatmap cell border

@@ -15,13 +15,20 @@

 ##' @importFrom reshape2 melt

 ##' @importFrom ggplot2 geom_tile

 ##' @importFrom ggplot2 geom_text

+##' @importFrom ggplot2 theme

+##' @importFrom ggplot2 element_blank

+##' @importFrom ggplot2 guides

+##' @importFrom ggplot2 guide_legend

 ##' @export

 ##' @author Guangchuang Yu

-gheatmap <- function(p, data, offset=0, width=NULL, low="green", high="red",

+gheatmap <- function(p, data, offset=0, width=1, low="green", high="red",

                      color="white", colnames=TRUE, font.size=4) {

-    if (is.null(width)) {

-        width <- (p$data$x %>% range %>% diff)/30

-    }

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

+    ##     width <- (p$data$x %>% range %>% diff)/30

+    ## }

+

+    ## convert width to width of each cell

+    width <- width * (p$data$x %>% range %>% diff) / ncol(data)

     isTip <- x <- y <- variable <- value <- from <- to <- NULL

@@ -56,6 +63,9 @@ gheatmap <- function(p, data, offset=0, width=NULL, low="green", high="red",

     if (colnames) {

         p2 <- p2 + geom_text(data=mapping, aes(x=to, label=from), y=0, size=font.size)

     }

+

+    p2 <- p2 + theme(legend.position="right", legend.title=element_blank())

+    p2 <- p2 + guides(fill = guide_legend(override.aes = list(colour = NULL)))

     attr(p2, "mapping") <- mapping

     return(p2)

@@ -68,7 +78,7 @@ gheatmap <- function(p, data, offset=0, width=NULL, low="green", high="red",

 ##' @param p tree view

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

 ##' @param offset offset of MSA to tree

-##' @param width width of each character

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

 ##' @param color color 

 ##' @param window specific a slice to display

 ##' @return tree view

@@ -80,7 +90,7 @@ gheatmap <- function(p, data, offset=0, width=NULL, low="green", high="red",

 ##' @importFrom ggplot2 geom_rect

 ##' @importFrom ggplot2 scale_fill_manual

 ##' @author Guangchuang Yu

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

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

     aln <- readBStringSet(fasta)

     if (is.null(window)) {

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

@@ -101,16 +111,20 @@ msaplot <- function(p, fasta, offset=0, width=NULL, color=NULL, window=NULL){

     if(is.null(color)) {

         alphabet <- unlist(seqs) %>% unique

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

-        color <- rainbow_hcl(length(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

-    }

+    ## 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

@@ -119,7 +133,7 @@ msaplot <- function(p, fasta, offset=0, width=NULL, color=NULL, window=NULL){

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

     xmax <- start + seq_along(slice) * width

-    xmin <- xmax -width

+    xmin <- xmax - width

     y <- sort(df$y)

     ymin <- y - 0.4 *h

     ymax <- y + 0.4 *h

@@ -145,13 +159,18 @@ msaplot <- function(p, fasta, offset=0, width=NULL, color=NULL, window=NULL){

                            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

 ##'

 ##' 

-##' @title scale_x_heatmap

+##' @title scale_x_ggtree

 ##' @param p tree view

 ##' @param breaks breaks for tree

 ##' @param labels lables for corresponding breaks

@@ -159,12 +178,16 @@ msaplot <- function(p, fasta, offset=0, width=NULL, color=NULL, window=NULL){

 ##' @importFrom ggplot2 scale_x_continuous

 ##' @export

 ##' @author Guangchuang Yu

-scale_x_heatmap <- function(p, breaks, labels=NULL) {

+scale_x_ggtree <- function(p, breaks=NULL, labels=NULL) {

+    if (is.null(breaks)) {

+        breaks <- hist(p$data$x, breaks=5, plot=FALSE)$breaks

+    }

     m <- attr(p, "mapping")

     if (is.null(labels)) {

         labels <- breaks

     }

-    p + scale_x_continuous(breaks=c(breaks, m$to), labels=c(labels, as.character(m$from)))

+    breaks <- c(breaks, m$to)

+    p + scale_x_continuous(breaks=breaks, labels=c(labels, as.character(m$from)))

 }

@@ -1,3 +1,70 @@

+##' site mask

+##'

+##' 

+##' @title mask

+##' @param tree_object tree object 

+##' @param field selected field

+##' @param site site

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

+##'                  if FALSE, selected site will not be masked, while other sites will be masked.

+##' @return updated tree object

+##' @export

+##' @author Guangchuang Yu

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

+    has_field <- has.field(tree_object, field)

+    if (has_field == FALSE) {

+        stop("'field' is not available in 'tree_object'...")

+    }

+

+    has_slot <- attr(has_field, "has_slot")

+    is_codeml <- attr(has_field, "is_codeml")

+

+    if (has_slot) {

+        if (is_codeml) {

+            field_info <- slot(tree_object@rst, field)

+        } else {

+            field_info <- slot(tree_object, field)

+        }

+        field_data <- field_info[,2]

+    } else {

+        field_data <- tree_object@extraInfo[, field]

+    }

+

+    field_data <- sapply(field_data, gsub, pattern="\n", replacement="/")

+    

+    if (mask_site == FALSE) {

+        x <- field_data[field_data != ""]

+        x <- x[!is.na(x)]

+        pos <- strsplit(x, " / ") %>% unlist %>%

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

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

+                    as.numeric

+        pos2 <- 1:max(pos)

+        pos2 <- pos2[-site]

+        site <- pos2

+    }

+    

+    for (i in seq_along(field_data)) {

+        for (j in seq_along(site)) {

+            pattern <- paste0("/*\\s*[a-zA-Z]", site[j], "[a-zA-Z]\\s*")

+            field_data[i] <- gsub(pattern, "",  field_data[i])

+        }

+        field_data[i] <- gsub("^/\\s", "", field_data[i]) %>% .add_new_line

+    }

+

+    if (has_slot) {

+        field_info[,2] <- field_data

+        if (is_codeml) {

+            slot(tree_object@rst, field) <- field_info

+        } else {

+            slot(tree_object, field) <- field_info

+        }

+    } else {

+        tree_object@extraInfo[, field] <- field_data

+    }

+    tree_object

+}

+

 read.tip_seq_mlc <- function(mlcfile) {

     info <- getPhyInfo(mlcfile)

@@ -2,9 +2,47 @@ 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)

+}

+

+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

+    } else {

+        is_codeml <- FALSE

+        tree <- tree_object

+    }

+    

+    if (.hasSlot(tree, field)) {

+        has_slot <- TRUE

+    } else {

+        has_slot <- FALSE

+    }

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

-    ! is.null(slot)

+    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)

+        }

+    }

+    res <- TRUE

+    attr(res, "has_slot") <- has_slot

+    attr(res, "is_codeml") <- is_codeml

+    return(res)

 }

 has.extraInfo <- function(object) {

@@ -12,7 +50,7 @@ has.extraInfo <- function(object) {

         return(FALSE)

     }

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

+    if (! .hasSlot(object, "extraInfo")) {

         return(FALSE)

     }

@@ -108,6 +146,15 @@ plot.subs <- function(x, layout, show.tip.label,

     p + theme_tree2()

 }

+.add_new_line <- function(res) {

+    if (nchar(res) > 50) {

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

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

+        res <- paste0(substring(res, 1, i-1), "\n", substring(res, i+1))

+    }

+    return(res)

+}

+

 get.subs_ <- function(tree, fasta, translate=TRUE, removeGap=TRUE) {

     N <- getNodeNum(tree)

     node <- 1:N

@@ -121,13 +168,7 @@ get.subs_ <- function(tree, fasta, translate=TRUE, removeGap=TRUE) {

         if (is.null(res)) {

             return('')

         }

-        if (nchar(res) > 50) {

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

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

-            res <- paste0(substring(res, 1, i-1), "\n", substring(res, i+1))

-        }

-        

-        return(res)

+        .add_new_line(res)

     })

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

@@ -407,3 +448,16 @@ roundDigit <- function(d) {

 NULL

+## from ChIPseeker

+getCols <- function (n) {

+    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", 

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

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

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

+              "#ffff99", "#b15928")

+    colorRampPalette(col3)(n)

+}

@@ -1,14 +1,12 @@

 #  ggtree: a phylogenetic tree viewer for different types of tree annotations

 [![platform](http://www.bioconductor.org/shields/availability/devel/ggtree.svg)](http://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#archives)

-[![Build Status](https://travis-ci.org/GuangchuangYu/ggtree.svg?branch=master)](https://travis-ci.org/GuangchuangYu/ggtree)

-[![Build Status](https://ci.appveyor.com/api/projects/status/github/GuangchuangYu/ggtree?svg=true)](https://ci.appveyor.com/project/GuangchuangYu/ggtree/branch/master)

+<!--[![Build Status](https://travis-ci.org/GuangchuangYu/ggtree.svg?branch=master)](https://travis-ci.org/GuangchuangYu/ggtree)

+[![Build Status](https://ci.appveyor.com/api/projects/status/github/GuangchuangYu/ggtree?svg=true)](https://ci.appveyor.com/project/GuangchuangYu/ggtree/branch/master)-->

 [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/ggtree.svg)](http://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/)

 [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](http://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since)

-

-

-[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](http://bioconductor.org/packages/stats/bioc/ggtree.html)

 [![commit](http://www.bioconductor.org/shields/commits/bioc/ggtree.svg)](http://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#svn_source)

+[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](http://bioconductor.org/packages/stats/bioc/ggtree.html)

 [![post](http://www.bioconductor.org/shields/posts/ggtree.svg)](https://support.bioconductor.org/t/ggtree/)

new file mode 100644

@@ -0,0 +1,82 @@

+65

+66

+69

+70

+78

+79

+91

+94

+95

+96

+97

+98

+99

+107

+108

+110

+137

+138

+139

+140

+141

+142

+143

+145

+147

+148

+149

+150

+151

+152

+153

+154

+156

+158

+159

+160

+161

+162

+171

+172

+173

+174

+175

+176

+183

+202

+204

+205

+206

+208

+209

+210

+212

+213

+214

+215

+217

+218

+219

+220

+221

+222

+223

+230

+232

+233

+234

+235

+236

+238

+239

+241

+242

+243

+258

+262

+263

+287

+289

+291

+292

+294

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

 \alias{gheatmap}

 \title{gheatmap}

 \usage{

-gheatmap(p, data, offset = 0, width = NULL, low = "green", high = "red",

+gheatmap(p, data, offset = 0, width = 1, low = "green", high = "red",

   color = "white", colnames = TRUE, font.size = 4)

 }

 \arguments{

@@ -14,7 +14,7 @@ gheatmap(p, data, offset = 0, width = NULL, low = "green", high = "red",

 \item{offset}{offset of heatmap to tree}

-\item{width}{width of each cell in heatmap}

+\item{width}{total width of heatmap, compare to width of tree}

 \item{low}{color of lowest value}

new file mode 100644

@@ -0,0 +1,28 @@

+% Generated by roxygen2 (4.1.1): do not edit by hand

+% Please edit documentation in R/paml.R

+\name{mask}

+\alias{mask}

+\title{mask}

+\usage{

+mask(tree_object, field, site, mask_site = FALSE)

+}

+\arguments{

+\item{tree_object}{tree object}

+

+\item{field}{selected field}

+

+\item{site}{site}

+

+\item{mask_site}{if TRUE, site will be masked.

+if FALSE, selected site will not be masked, while other sites will be masked.}

+}

+\value{

+updated tree object

+}

+\description{

+site mask

+}

+\author{

+Guangchuang Yu

+}

+

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

 \alias{msaplot}

 \title{msaplot}

 \usage{

-msaplot(p, fasta, offset = 0, width = NULL, color = NULL, window = NULL)

+msaplot(p, fasta, offset = 0, width = 1, color = NULL, window = NULL)

 }

 \arguments{

 \item{p}{tree view}

@@ -13,7 +13,7 @@ msaplot(p, fasta, offset = 0, width = NULL, color = NULL, window = NULL)

 \item{offset}{offset of MSA to tree}

-\item{width}{width of each character}

+\item{width}{total width of alignment, compare to width of tree}

 \item{color}{color}

similarity index 72%

rename from man/scale_x_heatmap.Rd

rename to man/scale_x_ggtree.Rd

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

 % Generated by roxygen2 (4.1.1): do not edit by hand

 % Please edit documentation in R/gplot.R

-\name{scale_x_heatmap}

-\alias{scale_x_heatmap}

-\title{scale_x_heatmap}

+\name{scale_x_ggtree}

+\alias{scale_x_ggtree}

+\title{scale_x_ggtree}

 \usage{

-scale_x_heatmap(p, breaks, labels = NULL)

+scale_x_ggtree(p, breaks = NULL, labels = NULL)

 }

 \arguments{

 \item{p}{tree view}

@@ -763,13 +763,13 @@ The _width_ parameter is to control the width of each cell in the heatmap. It su

 gheatmap(p+geom_tiplab(size=3), genotype, offset = 2, width=0.5)

 ```

-For time scaled tree, as in this example, it's more often to use x axis by using `theme_tree2`. But with this solution, the heatmap is just another layer and will change the x axis. To over come this issue, we implemented `scale_x_heatmap` to set the x axis more reasonable. User can also use `gplot` and tweak the positions of two plot to align properly.

+For time scaled tree, as in this example, it's more often to use x axis by using `theme_tree2`. But with this solution, the heatmap is just another layer and will change the x axis. To over come this issue, we implemented `scale_x_ggtree` to set the x axis more reasonable. User can also use `gplot` and tweak the positions of two plot to align properly.

 ```{r fig.width=20, fig.height=16, fig.align="center"}

 p <- ggtree(beast_tree, time_scale=TRUE) + geom_tiplab(size=3, align=TRUE) + theme_tree2()

 pp <- (p + scale_y_continuous(expand=c(0, 0.3))) %>%

     gheatmap(genotype, offset=4, width=0.5, colnames=FALSE) %>%

-        scale_x_heatmap(breaks=seq(1992, 2013, by=5))

+        scale_x_ggtree()

 pp + theme(legend.position="right")

 ```

@@ -789,6 +789,11 @@ A specific slice of the alignment can also be displayed by specific _window_ par

 + [updating a tree view using %<% operator](http://ygc.name/2015/02/10/ggtree-updating-a-tree-view/)

 + [an example of drawing beast tree using ggtree](http://ygc.name/2015/04/01/an-example-of-drawing-beast-tree-using-ggtree/)

+# Bugs/Feature requests

+

+If you have any, [let me know](https://github.com/GuangchuangYu/ggtree/issues). Thx!

+

+

 # Session info

 Here is the output of `sessionInfo()` on the system on which this document was compiled:

 ```{r echo=FALSE}