Pull from fork of ggtree.

Merge branch 'master' of https://github.com/JustGitting/ggtree

# Conflicts:
#	.Rbuildignore

.Rbuildignore

@@ -11,5 +11,9 @@ mkdocs
 docs
 logo.png.github
 .github
+<<<<<<< HEAD
 ^.*\.Rproj$
 ^\.Rproj\.user$
+=======
+ggtree_sticker.R
+>>>>>>> 6c3d0a213ebba123a58af768ef6d7b4ec93b85d1

.github/issue_template.md

@@ -7,7 +7,7 @@
 
 ### Describe you issue
 
-* [ ] Make a reproducible example (*e.g.* [1](https://gist.github.com/talonsensei/e1fad082657054207f249ec98f0920eb]))
+* [ ] Make a reproducible example (*e.g.* [1](https://gist.github.com/talonsensei/e1fad082657054207f249ec98f0920eb))
 * [ ] your code should contain comments to describe the problem (*e.g.* what expected and actually happened?)
 
 

DESCRIPTION

@@ -1,16 +1,18 @@
 Package: ggtree
 Type: Package
-Title: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
-Version: 1.7.9
+Title: an R package for visualization and annotation of phylogenetic trees with
+    their covariates and other associated data
+Version: 1.7.10
 Authors@R: c(
 	   person("Guangchuang", "Yu", email = "[email protected]", role = c("aut", "cre", "cph")),
 	   person("Tommy Tsan-Yuk", "Lam", email = "[email protected]", rol = c("aut", "ths")),
 	   person("Justin", "Silverman", email = "[email protected]", rol = "ctb"),
 	   person("Hugo", "Gruson", email = "[email protected]", rol = "ctb")
 	   )
 Maintainer: Guangchuang Yu <[email protected]>
-Description: 'ggtree' extends the 'ggplot2' plotting system which implemented the grammar of graphics.
-	     'ggtree' is designed for visualization and annotation of phylogenetic trees with their covariates and other associated data.
+Description: 'ggtree' extends the 'ggplot2' plotting system which implemented
+    the grammar of graphics. 'ggtree' is designed for visualization and annotation
+    of phylogenetic trees with their covariates and other associated data.
 Depends:
     R (>= 3.3.2),
     ggplot2 (>= 2.2.0),
@@ -21,6 +23,7 @@ Imports:
     grid,
     magrittr,
     methods,
+    rvcheck,
     tidyr,
     utils
 Suggests:

Makefile

@@ -12,6 +12,10 @@ rd:
 readme:
 	Rscript -e 'rmarkdown::render("README.Rmd")'
 
+sticker:
+	Rscript -e 'source("ggtree_sticker.R")';
+	rm Rplots.pdf
+
 build:
 	cd ..;\
 	R CMD build $(PKGSRC)
@@ -47,17 +51,11 @@ mkdocs: mdfiles
 	mkdocs build;\
 	cd ../docs;\
 	rm -rf fonts;\
-	rm -rf css/font-awesome*;\
-	Rscript -e 'library(ypages); add_biobabble("index.html")'
-
+	rm -rf css/font-awesome*
 
 mdfiles:
 	cd mkdocs;\
-	Rscript -e 'library(ypages); gendoc("src/index.md", "blue", "docs/index.md")';\
-	Rscript -e 'library(ypages); gendoc("src/documentation.md", "blue", "docs/documentation.md")';\
-	Rscript -e 'library(ypages); gendoc("src/featuredArticles.md", "blue", "docs/featuredArticles.md")';\
-	Rscript -e 'library(ypages); gendoc("src/gallery.md", "blue", "docs/gallery.md")';\
-	Rscript -e 'library(ypages); gendoc("src/faq.md", "blue", "docs/faq.md")';\
+	Rscript -e 'source("render.R")';\
 	cd docs;\
 	ln -f -s ../mysoftware/* ./
 

NAMESPACE

@@ -181,6 +181,7 @@ importFrom(magrittr,add)
 importFrom(magrittr,equals)
 importFrom(methods,is)
 importFrom(methods,missingArg)
+importFrom(rvcheck,get_fun_from_pkg)
 importFrom(tidyr,gather)
 importFrom(treeio,as.phylo)
 importFrom(treeio,as.treedata)

NEWS

@@ -1,3 +1,10 @@
+CHANGES IN VERSION 1.7.10
+------------------------
+ o add message for subview, inset, phylopic, theme_transparent and theme_inset <2017-03-23, Thu>
+   + will be defunct in version >= 1.9.0
+   + user should use ggimage package to annotate tree with graphic object or image file
+ o update subview to support mainview produced by `ggplot() + layers` <2017-03-13, Mon>
+
 CHANGES IN VERSION 1.7.9
 ------------------------
  o fixed geom_range to support height_0.95_HPD <2017-03-03, Fri>

R/inset.R

@@ -17,6 +17,8 @@
 inset <- function(tree_view, insets, width=0.1, height=0.1, hjust=0, vjust=0,
                   x="node", reverse_x=FALSE, reverse_y=FALSE) {
 
+    message("The inset function will be defunct in next release, please use ggimage::geom_subview() instead.")
+
     df <- tree_view$data[as.numeric(names(insets)),]
     x <- match.arg(x, c("node", "branch", "edge"))
 

R/method-fortify.R

@@ -336,7 +336,9 @@ fortify.paml_rst <- function(model, data,
 }
 
 merge_phylo_anno.paml_rst <- function(df, model) {
-    for (type in get.fields(model)) {
+    types <- get.fields(model)
+    types <- types[grepl('subs', types)]
+    for (type in types) {
         anno <- get.subs(model, type=type)
         colnames(anno)[2] <- type
         df <- df %add2% anno

R/phylopic.R

@@ -1,6 +1,6 @@
 ##' download phylopic and convert to grob object
 ##'
-##' 
+##'
 ##' @title get.phylopic
 ##' @param id phylopic id
 ##' @param size size of the phylopic
@@ -34,17 +34,17 @@ download.phylopic <- function(id, size=512, color="black", alpha=1) {
 
     channel <- get_fun_from_pkg("EBImage", "channel")
     readImage <- get_fun_from_pkg("EBImage", "readImage")
-    
+
     img <- readImage(imgfile)
-       
+
     color <- col2rgb(color) / 255
 
     img <- channel(img, 'rgb')
     img[,,1] <- color[1]
     img[,,2] <- color[2]
     img[,,3] <- color[3]
     img[,,4] <- img[,,4]*alpha
-    
+
     return(img)
 }
 
@@ -59,13 +59,13 @@ download.phylopic_internal <- function(id, size=512, outfile=NULL) {
         outfile <- sub(".*/", "", imgurl)
     }
     ## mode = "wb" for Windows platform
-    download.file(imgurl, outfile, mode="wb", quiet = TRUE) 
+    download.file(imgurl, outfile, mode="wb", quiet = TRUE)
 }
 
 
 ##' add phylopic layer
 ##'
-##' 
+##'
 ##' @title phylopic
 ##' @param tree_view tree view
 ##' @param phylopic_id phylopic id
@@ -84,6 +84,9 @@ download.phylopic_internal <- function(id, size=512, outfile=NULL) {
 phylopic <- function(tree_view, phylopic_id,
                      size=512, color="black", alpha=0.5,
                      node=NULL, x=NULL, y=NULL, width=.1) {
+
+    message("The phylopic function will be defunct in next release, please use ggimage::geom_phylopic() instead.")
+
     width <- diff(range(tree_view$data$x)) * width
     img <- download.phylopic(phylopic_id, size, color, alpha)
     if ( is.null(node) ) {
@@ -104,7 +107,7 @@ phylopic <- function(tree_view, phylopic_id,
         ymin <- y - AR * width/2
         ymax <- y + AR * width/2
     }
-    
+
     tree_view + annotation_custom(xmin=xmin, ymin=ymin,
                                   xmax=xmax, ymax=ymax,
                                   rasterGrob(img))
@@ -118,7 +121,7 @@ getAR <- function(img) {
 
 ##' annotation taxa with images
 ##'
-##' 
+##'
 ##' @title annotation_image
 ##' @param tree_view tree view
 ##' @param img_info data.frame with first column of taxa name and second column of image names
@@ -149,7 +152,7 @@ annotation_image <- function(tree_view, img_info, width=0.1, align=TRUE, linetyp
         xmin <- x - width/2 + offset
     }
     xmax <- xmin + width
-    
+
     ymin <- y - ARs * width/2
     ymax <- y + ARs * width/2
     image_layers <- lapply(1:length(xmin), function(i) {

R/subview.R

@@ -1,6 +1,6 @@
 ##' add subview to mainview for ggplot2 objects
 ##'
-##' 
+##'
 ##' @title subview
 ##' @param mainview main view
 ##' @param subview a ggplot or grob object
@@ -11,15 +11,24 @@
 ##' @return ggplot object
 ##' @importFrom ggplot2 annotation_custom
 ##' @importFrom ggplot2 ggplotGrob
+##' @importFrom ggplot2 ggplot_build
 ##' @export
 ##' @author Guangchuang Yu
 subview <- function(mainview, subview, x, y, width=.1, height=.1) {
+    message("The subview function will be defunct in next release, please use ggimage::geom_subview() instead.")
+
     mapping <- mainview$mapping %>% as.character
     aes_x <- mapping["x"]
     aes_y <- mapping["y"]
-
-    xrng <- mainview$data[, aes_x] %>% range 
-    yrng <- mainview$data[, aes_y] %>% range
+
+    if (is.na(aes_x) || is.na(aes_y)) {
+        obj <- ggplot_build(mainview)
+        xrng <- obj$layout$panel_ranges[[1]]$x.range
+        yrng <- obj$layout$panel_ranges[[1]]$y.range
+    } else {
+        xrng <- mainview$data[, aes_x] %>% range
+        yrng <- mainview$data[, aes_y] %>% range
+    }
 
     for (i in seq_along(mainview$layers)) {
         layer <- mainview$layers[[i]]
@@ -58,13 +67,15 @@ subview <- function(mainview, subview, x, y, width=.1, height=.1) {
 
     xrng <- diff(xrng)
     yrng <- diff(yrng)
-    
-    if (!any(class(subview) %in% c("ggplot", "grob", "character"))) {
+
+    if (!any(class(subview) %in% c("ggplot", "trellis", "grob", "character"))) {
         stop("subview should be a ggplot or grob object, or an image file...")
     }
-    
+
     if (is(subview, "ggplot")) {
         sv <- ggplotGrob(subview)
+    } else if (is(subview, "trellis")) {
+        sv <- grid::grid.grabExpr(print(subview))
     } else if (is(subview, "grob")) {
         sv <- subview
     } else if (file.exists(subview)) {
@@ -76,7 +87,7 @@ subview <- function(mainview, subview, x, y, width=.1, height=.1) {
 
     width <- width/2
     height <- height/2
-    
+
     mainview + annotation_custom(
         sv,
         xmin = x - width*xrng,

R/theme.R

@@ -20,7 +20,7 @@
 theme_tree <- function(bgcolor="white", fgcolor="black", ...) {
     list(xlab(NULL),
          ylab(NULL),
-	 theme_tree2_internal() + 
+	 theme_tree2_internal() +
          theme(panel.background=element_rect(fill=bgcolor, colour=bgcolor),
                axis.line.x = element_blank(),
                axis.text.x = element_blank(),
@@ -63,7 +63,7 @@ theme_tree2_internal <- function(bgcolor="white", fgcolor="black",
                                  axis.line.y=element_blank(),
                                  axis.ticks.y=element_blank(),
                                  axis.text.y=element_blank(),...) {
-    theme_bw() + 
+    theme_bw() +
         theme(legend.position=legend.position,
               panel.grid.minor=panel.grid.minor,
               panel.grid.major=panel.grid.major,
@@ -88,17 +88,19 @@ theme_tree2_internal <- function(bgcolor="white", fgcolor="black",
 ##' @export
 ##' @author Guangchuang Yu
 theme_transparent <- function(...) {
+    message("this theme was moved to ggimage::theme_transparent and will be removed in next release")
+
     theme(panel.background = element_rect(
               fill = "transparent",
               colour = NA),
           plot.background = element_rect(
               fill = "transparent",
               colour = NA),
           legend.key = element_rect(
-              fill = "transparent", 
+              fill = "transparent",
               colour = NA),
           legend.background = element_rect(
-              fill = "transparent", 
+              fill = "transparent",
               colour = NA), ...)
 }
 
@@ -111,6 +113,7 @@ theme_transparent <- function(...) {
 ##' @export
 ##' @author Guangchuang Yu
 theme_inset <- function(...) {
+    message("this theme will be removed in next release")
     list(xlab(NULL),
          ylab(NULL),
          theme_tree(...),

R/utilities.R

@@ -349,7 +349,8 @@ is.tree <- function(x) {
                         "codeml_mlc",
                         "codeml",
                         "hyphy",
-                        "beast")
+                        "beast",
+                        "phangorn")
         ) {
         return(TRUE)
     }
@@ -459,14 +460,7 @@ getCols <- function (n) {
     colorRampPalette(col3)(n)
 }
 
-
-get_fun_from_pkg <- function(pkg, fun) {
-    ## requireNamespace(pkg)
-    ## eval(parse(text=paste0(pkg, "::", fun)))
-    require(pkg, character.only = TRUE)
-    eval(parse(text = fun))
-}
-
+##' @importFrom rvcheck get_fun_from_pkg
 hist <- get_fun_from_pkg("graphics", "hist")
 
 

README.Rmd

@@ -15,14 +15,14 @@ library("txtplot")
 library("ypages")
 ```
 
-<img src="https://raw.githubusercontent.com/jotsetung/BioC-stickers/master/ggtree/ggtree.png" height="128", align="right" />
+<img src="https://raw.githubusercontent.com/Bioconductor/BiocStickers/master/ggtree/ggtree.png" height="200" align="right" />
 
 
-`r badge_release("ggtree", "green")`
-`r badge_devel("ggtree", "green")`
+`r badge_bioc_release("ggtree", "green")`
+`r badge_devel("guangchuangyu/ggtree", "green")`
 [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since)
-`r badge_download("ggtree", "total", "blue")`
-`r badge_download("ggtree", "month", "blue")`
+`r badge_bioc_download("ggtree", "total", "blue")`
+`r badge_bioc_download("ggtree", "month", "blue")`
 
 
 [![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)
@@ -77,8 +77,8 @@ txtplot(d$year, d$cites)
 ### Download stats
 
 `r badge_download_bioc("ggtree")`
-`r badge_download("ggtree", "total", "blue")`
-`r badge_download("ggtree", "month", "blue")`
+`r badge_bioc_download("ggtree", "total", "blue")`
+`r badge_bioc_download("ggtree", "month", "blue")`
 
 
 ```{r echo=F, comment=NA}