zoomClade and geom_zoom_clade

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ggtree
 Type: Package
 Title: an R package for visualization of tree and annotation data
-Version: 2.3.3.993
+Version: 2.3.4
 Authors@R: c(
        person("Guangchuang", "Yu",     email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-6485-8781")),
        person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com",   role = c("aut", "ths")),

NAMESPACE

@@ -31,6 +31,7 @@ S3method(ggplot_add,taxalink)
 S3method(ggplot_add,tiplab)
 S3method(ggplot_add,tiplab_ylab)
 S3method(ggplot_add,tree_inset)
+S3method(ggplot_add,zoom_clade)
 S3method(groupClade,ggtree)
 S3method(groupOTU,ggtree)
 S3method(identify,gg)
@@ -87,6 +88,7 @@ export(geom_tippoint)
 export(geom_tree)
 export(geom_tree2)
 export(geom_treescale)
+export(geom_zoom_clade)
 export(get.path)
 export(get_clade_position)
 export(get_heatmap_column_position)
@@ -139,6 +141,7 @@ export(viewClade)
 export(xlim)
 export(xlim_expand)
 export(xlim_tree)
+export(zoomClade)
 exportMethods(gzoom)
 exportMethods(scale_color)
 importFrom(ape,di2multi)

NEWS.md

@@ -1,5 +1,7 @@
-# ggtree 2.3.3.993
+# ggtree 2.3.4
 
++ `zoomClade` and `geom_zoom_clade` to zoom in selected clade (2020-08-04, Tue)
+  - these two functions are wrapper function of `ggforce::facet_zoom`
 + update `facet_labeller` according to the change of `ggplot2` (2020-07-28, Tue)
 + defunct `set_hilight_legend` as now `geom_hilight` supports aesthetic mapping and can generate legend automotically 
 + remove `annotation_image`, `phylopic` and `subview` as they were defunct for quite a long time. Users should refer to the `ggimage` package if they want to annotate tree with image or subplots.

R/clade-functions.R

@@ -2,8 +2,8 @@
 ##'
 ##'
 ##' @title get_taxa_name
-##' @param tree_view tree view
-##' @param node node
+##' @param tree_view tree view (i.e. the ggtree object). If tree_view is NULL, the last ggplot will be used.
+##' @param node internal node number 
 ##' @return taxa name vector
 ##' @importFrom tidytree offspring
 ##' @export
@@ -29,8 +29,7 @@ get_taxa_name <- function(tree_view=NULL, node=NULL) {
 ##'
 ##'
 ##' @title viewClade
-##' @param tree_view full tree view
-##' @param node internal node number
+##' @inheritParams get_taxa_name
 ##' @param xmax_adjust adjust xmax
 ##' @return clade plot
 ##' @importFrom ggplot2 ggplot_build
@@ -66,8 +65,8 @@ is.viewClade <- function(tree_view) {
 ##'
 ##' @title collapse-ggtree
 ##' @rdname collapse
-##' @param x tree view
-##' @param node clade node
+##' @param x tree view (i.e. the ggtree object). If tree_view is NULL, the last ggplot will be used.
+##' @param node internal node number 
 ##' @param mode one of 'none', 'max', 'min' and 'mixed'
 ##' @param clade_name set clade name. If clade_name = NULL, do nothing
 ##' @param ... additional parameters
@@ -168,8 +167,7 @@ collapse.ggtree <- function(x=NULL, node, mode = "none", clade_name = NULL, ...)
 ##'
 ##'
 ##' @title expand
-##' @param tree_view tree view
-##' @param node clade node
+##' @inheritParams get_taxa_name
 ##' @return tree view
 ##' @export
 ##' @seealso collapse
@@ -226,8 +224,7 @@ expand <- function(tree_view=NULL, node) {
 ##'
 ##'
 ##' @title rotate
-##' @param tree_view tree view
-##' @param node selected node
+##' @inheritParams get_taxa_name
 ##' @return ggplot2 object
 ##' @export
 ##' @author Guangchuang Yu
@@ -268,7 +265,7 @@ rotate <- function(tree_view=NULL, node) {
 ##'
 ##'
 ##' @title flip
-##' @param tree_view tree view
+##' @param tree_view tree view (i.e. the ggtree object). If tree_view is NULL, the last ggplot will be used.
 ##' @param node1 node number of branch 1
 ##' @param node2 node number of branch 2
 ##' @return ggplot2 object
@@ -339,8 +336,7 @@ flip <- function(tree_view=NULL, node1, node2) {
 ##'
 ##'
 ##' @title scaleClade
-##' @param tree_view tree view
-##' @param node clade node
+##' @inheritParams get_taxa_name
 ##' @param scale scale
 ##' @param vertical_only logical. If TRUE, only vertical will be scaled.
 ##' If FALSE, the clade will be scaled vertical and horizontally.
@@ -423,3 +419,25 @@ reassign_y_from_node_to_root <- function(df, node) {
     df[pp, "y"] <- mean(df$y[j])
     return(df)
 }
+
+
+##' zoom selected clade of a tree
+##'
+##' 
+##' @title zoomClade
+##' @inheritParams get_taxa_name
+##' @return full tree with zoom in clade
+##' @author Guangchuang Yu
+##' @export
+zoomClade <- function(tree_view = NULL, node) {
+    p <- get_tree_view(tree_view)
+    sp <- offspring(p, node, self_include=TRUE)
+    xr <- range(sp$x)
+    xr[2] <- xr[2] + diff(xr)/10
+    yr <- range(sp$y)
+    ## nn <- sp$node
+    ## p + ggforce::facet_zoom(y = node %in% nn, ylim = yr)
+    facet_zoom <- getFromNamespace("facet_zoom", "ggforce")
+
+    p + facet_zoom(xlim = xr, ylim=yr)
+}

R/geom-zoom-clade.R

@@ -0,0 +1,14 @@
+
+
+##' zoom selected clade of a tree
+##'
+##'
+##' @title geom_zoom_clade
+##' @param node internal node number
+##' @return updated tree view
+##' @author Guangchuang Yu
+##' @export
+geom_zoom_clade <- function(node) {
+    structure(list(node = node), class = "zoom_clade")
+}
+

R/method-ggplot-add.R

@@ -20,6 +20,11 @@ ggplot_add.facet_xlim <- function(object, plot, object_name) {
     ggplot_add(obj, plot, object_name)
 }
 
+##' @method ggplot_add zoom_clade
+##' @export
+ggplot_add.zoom_clade <- function(object, plot, object_name) {
+    zoomClade(plot, object$node)
+}
 
 ## ##' @method ggplot_add axisAlign
 ## ##' @importFrom ggplot2 scale_x_discrete