@@ -38,6 +38,7 @@ export(flip)

 export(geom_aline)

 export(geom_cladelabel)

 export(geom_hilight)

+export(geom_label2)

 export(geom_nodepoint)

 export(geom_point2)

 export(geom_range)

@@ -156,6 +157,7 @@ importFrom(ape,which.edge)

 importFrom(ape,write.tree)

 importFrom(ggplot2,"%+replace%")

 importFrom(ggplot2,GeomCurve)

+importFrom(ggplot2,GeomLabel)

 importFrom(ggplot2,GeomPoint)

 importFrom(ggplot2,GeomRect)

 importFrom(ggplot2,GeomSegment)

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

 CHANGES IN VERSION 1.3.15

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

+ o geom_tiplab and geom_tiplab2 support using geom_label2 by passing geom="label" <2016-04-07, Thu>

+ o geom_label2 that support subsetting <2016-04-07, Thu>

  o geom_tiplab2 for adding tip label of circular layout <2016-04-06, Wed>

  o use plot$plot_env to access ggplot2 parameter <2016-04-06, Wed>

  o geom_taxalink for connecting related taxa <2016-04-01, Fri> 

new file mode 100644

@@ -0,0 +1,101 @@

+##' geom_text2 support aes(subset) via setup_data

+##'

+##' 

+##' @title geom_text2

+##' @param mapping the aesthetic mapping

+##' @param data A layer specific dataset -

+##'             only needed if you want to override he plot defaults.

+##' @param ... other arguments passed on to 'layer'

+##' @param parse if TRUE, the labels will be passd into expressions

+##' @param nudge_x horizontal adjustment

+##' @param nudge_y vertical adjustment

+##' @param label.padding Amount of padding around label. 

+##' @param label.r Radius of rounded corners.

+##' @param label.size Size of label border, in mm

+##' @param na.rm logical

+##' @param show.legend logical

+##' @param inherit.aes logical

+##' @return label layer

+##' @importFrom ggplot2 layer

+##' @importFrom ggplot2 position_nudge

+##' @export

+##' @seealso

+##' \link[ggplot2]{geom_label}

+##' @author Guangchuang Yu

+geom_label2 <- function(mapping = NULL, data = NULL,

+                        ...,

+                        parse = FALSE,

+                        nudge_x = 0,

+                        nudge_y = 0,

+                        label.padding = unit(0.25, "lines"),

+                        label.r = unit(0.15, "lines"),

+                        label.size = 0.25,

+                        na.rm = TRUE,

+                        show.legend = NA,

+                        inherit.aes = TRUE) {

+

+    position = "identity"

+    

+    if (!missing(nudge_x) || !missing(nudge_y)) {

+        if (!missing(position)) {

+            stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE)

+        }

+        

+        position <- position_nudge(nudge_x, nudge_y)

+    }

+    

+    default_aes <- aes_(node=~node)

+    if (is.null(mapping)) {

+        mapping <- default_aes

+    } else {

+        mapping <- modifyList(mapping, default_aes)

+    }

+    

+    layer(

+        data = data,

+        mapping = mapping,

+        stat = StatTreeData,

+        geom = GeomLabelGGtree,

+        position = position,

+        show.legend = show.legend,

+        inherit.aes = inherit.aes,

+        params = list(

+            parse = parse,

+            label.padding = label.padding,

+            label.r = label.r,

+            label.size = label.size,

+            na.rm = na.rm,

+            ...

+        )

+    )

+}

+

+

+

+##' @importFrom ggplot2 GeomLabel

+GeomLabelGGtree <- ggproto("GeomLabelGGtree", GeomLabel,

+                           setup_data = function(data, params) {

+                               if (is.null(data$subset))

+                                   return(data)

+                               data[data$subset,]

+                           },

+                           draw_panel = function(self, data, panel_scales, coord, parse = FALSE,

+                                                 na.rm = FALSE,

+                                                 label.padding = unit(0.25, "lines"),

+                                                 label.r = unit(0.15, "lines"),

+                                                 label.size = 0.25) {

+                               GeomLabel$draw_panel(data, panel_scales, coord, parse,

+                                                   na.rm, label.padding, label.r, label.size)

+                           },

+                           required_aes = c("node", "x", "y", "label"),

+                           

+                           default_aes = aes(

+                               colour = "black", fill = "white", size = 3.88, angle = 0,

+                               hjust = 0.5, vjust = 0.5, alpha = NA, family = "", fontface = 1,

+                               lineheight = 1.2

+                           ),

+                           

+                           draw_key = draw_key_label

+                           )

+

+

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

 ##' @return tip point layer

 ##' @export

 ##' @author Guangchuang Yu

-geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity",

+geom_tippoint <- function(mapping = NULL, data = NULL, 

                        position = "identity", na.rm = FALSE,

                           show.legend = NA, inherit.aes = TRUE, ...) {

     isTip <- NULL

@@ -17,7 +17,7 @@ geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity",

     } else {

         mapping %<>% modifyList(self_mapping)

     }

-    geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...)    

+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)    

 }

 ##' add node point

@@ -28,7 +28,7 @@ geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity",

 ##' @return node point layer

 ##' @export

 ##' @author Guangchuang Yu

-geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity",

+geom_nodepoint <- function(mapping = NULL, data = NULL, 

                        position = "identity", na.rm = FALSE,

                        show.legend = NA, inherit.aes = TRUE, ...) {

     isTip <- NULL

@@ -38,7 +38,7 @@ geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity",

     } else {

         mapping %<>% modifyList(self_mapping)

     }

-    geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...)    

+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)    

 }

@@ -50,7 +50,7 @@ geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity",

 ##' @return root point layer

 ##' @export

 ##' @author Guangchuang Yu

-geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",

+geom_rootpoint <- function(mapping = NULL, data = NULL, 

                            position = "identity", na.rm = FALSE,

                            show.legend = NA, inherit.aes = TRUE, ...) {

     isTip <- node <- parent <- NULL

@@ -60,7 +60,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",

     } else {

         mapping %<>% modifyList(self_mapping)

     }

-    geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...)

+    geom_point2(mapping, data, position, na.rm, show.legend, inherit.aes, ...)

 }

@@ -70,7 +70,6 @@ geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",

 ##' @title geom_point2

 ##' @param mapping aes mapping

 ##' @param data data

-##' @param stat stat

 ##' @param position position

 ##' @param na.rm logical

 ##' @param show.legend logical

@@ -82,7 +81,7 @@ geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",

 ##' \link[ggplot2]{geom_point}

 ##' @return point layer

 ##' @author Guangchuang Yu

-geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",

+geom_point2 <- function(mapping = NULL, data = NULL,

                        position = "identity", na.rm = FALSE,

                        show.legend = NA, inherit.aes = TRUE, ...) {

@@ -97,7 +96,7 @@ geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",

     layer(

         data = data,

         mapping = mapping,

-        stat = StatTreePoint,

+        stat = StatTreeData,

         geom = GeomPointGGtree,

         position = position,

         show.legend = show.legend,

@@ -130,10 +129,3 @@ GeomPointGGtree <- ggproto("GeomPointGGtree", GeomPoint,

                            ##                   alpha = NA, stroke = 0.5)

                             )

-

-StatTreePoint <-  ggproto("StatTreePoint", Stat,

-                          required_aes = "node",

-                          compute_group = function(data, scales) {

-                              setup_tree_data(data)

-                          }

-                          )

@@ -29,7 +29,6 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {

 ##' @title geom_segment2

 ##' @param mapping aes mapping 

 ##' @param data data

-##' @param stat stat

 ##' @param position position

 ##' @param arrow arrow

 ##' @param lineend lineend

@@ -43,7 +42,7 @@ geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {

 ##' \link[ggplot2]{geom_segment}

 ##' @return add segment layer

 ##' @author Guangchuang Yu

-geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",

+geom_segment2 <- function(mapping = NULL, data = NULL, 

                          position = "identity", arrow = NULL, lineend = "butt",

                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,

                          ...) {

@@ -58,7 +57,7 @@ geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",

     layer(

         data = data,

         mapping = mapping,

-        stat = StatTreeSegment,

+        stat = StatTreeData,

         geom = GeomSegmentGGtree,

         position = position,

         show.legend = show.legend,

@@ -95,11 +94,5 @@ GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,

                              )

-StatTreeSegment <-  ggproto("StatTreeSegment", Stat,

-                          required_aes = "node",

-                          compute_group = function(data, scales) {

-                              setup_tree_data(data)

-                          }

-                          )

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

 ##' @param mapping the aesthetic mapping

 ##' @param data A layer specific dataset -

 ##'             only needed if you want to override he plot defaults.

-##' @param stat The statistical transformation to use on the data for this layer

 ##' @param position The position adjustment to use for overlapping points on this layer

 ##' @param parse if TRUE, the labels will be passd into expressions

 ##' @param na.rm logical

@@ -22,7 +21,7 @@

 ##' @seealso

 ##' \link[ggplot2]{geom_text}

 ##' @author Guangchuang Yu

-geom_text2 <- function(mapping = NULL, data = NULL, stat = "identity",

+geom_text2 <- function(mapping = NULL, data = NULL,

                        position = "identity", parse = FALSE, na.rm=TRUE, show.legend = NA, inherit.aes = TRUE,

                        ..., nudge_x = 0, nudge_y = 0, check_overlap = FALSE) {

@@ -44,7 +43,7 @@ geom_text2 <- function(mapping = NULL, data = NULL, stat = "identity",

     layer(

         data = data,

         mapping = mapping,

-        stat = StatTreeLabel,

+        stat = StatTreeData,

         geom = GeomTextGGtree,

         position = position,

         show.legend = show.legend,

@@ -80,11 +79,11 @@ GeomTextGGtree <- ggproto("GeomTextGGtree", GeomText,

                           draw_key = draw_key_text

                           )

-StatTreeLabel <-  ggproto("StatTreeLabel", Stat,

-                          required_aes = "node",

-                          compute_group = function(data, scales) {

-                              setup_tree_data(data)

-                          }

-                          )

+StatTreeData <-  ggproto("StatTreeLabel", Stat,

+                         required_aes = "node",

+                         compute_group = function(data, scales) {

+                             setup_tree_data(data)

+                         }

+                         )

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

 ##' @param align align tip lab or not, logical

 ##' @param linetype linetype for adding line if align = TRUE

 ##' @param linesize line size of line if align = TRUE

+##' @param geom one of 'text' and 'label'

 ##' @param ... additional parameter

 ##' @return tip label layer

 ##' @importFrom ggplot2 geom_text

@@ -16,7 +17,9 @@

 ##' require(ape)

 ##' tr <- rtree(10)

 ##' ggtree(tr) + geom_tiplab()

-geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dotted", linesize=1, ...) {

+geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dotted", linesize=1, geom="text", ...) {

+    geom <- match.arg(geom, c("text", "label"))

+

     x <- y <- label <- isTip <- NULL

     if (align == TRUE) {

         self_mapping <- aes(x = max(x, na.rm=TRUE) + diff(range(x, na.rm=TRUE))/200, y = y, label = label, subset= isTip)

@@ -40,13 +43,18 @@ geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dott

     } 

     list(

-        geom_text2(mapping=text_mapping, 

-                   hjust = hjust, ...),

+        if (geom == "text") {

+            geom_text2(mapping=text_mapping, 

+                       hjust = hjust, ...)

+        } else {

+            geom_label2(mapping=text_mapping, 

+                        hjust = hjust, ...)

+        },

         if (!is.null(dot_mapping))

             geom_segment2(mapping=dot_mapping,

                           linetype = linetype,

                           size = linesize, ...)

-        )

+    )

 }

new file mode 100644

@@ -0,0 +1,50 @@

+% Generated by roxygen2: do not edit by hand

+% Please edit documentation in R/geom_label.R

+\name{geom_label2}

+\alias{geom_label2}

+\title{geom_text2}

+\usage{

+geom_label2(mapping = NULL, data = NULL, ..., parse = FALSE,

+  nudge_x = 0, nudge_y = 0, label.padding = unit(0.25, "lines"),

+  label.r = unit(0.15, "lines"), label.size = 0.25, na.rm = TRUE,

+  show.legend = NA, inherit.aes = TRUE)

+}

+\arguments{

+\item{mapping}{the aesthetic mapping}

+

+\item{data}{A layer specific dataset -

+only needed if you want to override he plot defaults.}

+

+\item{...}{other arguments passed on to 'layer'}

+

+\item{parse}{if TRUE, the labels will be passd into expressions}

+

+\item{nudge_x}{horizontal adjustment}

+

+\item{nudge_y}{vertical adjustment}

+

+\item{label.padding}{Amount of padding around label.}

+

+\item{label.r}{Radius of rounded corners.}

+

+\item{label.size}{Size of label border, in mm}

+

+\item{na.rm}{logical}

+

+\item{show.legend}{logical}

+

+\item{inherit.aes}{logical}

+}

+\value{

+label layer

+}

+\description{

+geom_text2 support aes(subset) via setup_data

+}

+\author{

+Guangchuang Yu

+}

+\seealso{

+\link[ggplot2]{geom_label}

+}

+

@@ -4,17 +4,14 @@

 \alias{geom_nodepoint}

 \title{geom_nodepoint}

 \usage{

-geom_nodepoint(mapping = NULL, data = NULL, stat = "identity",

-  position = "identity", na.rm = FALSE, show.legend = NA,

-  inherit.aes = TRUE, ...)

+geom_nodepoint(mapping = NULL, data = NULL, position = "identity",

+  na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...)

 }

 \arguments{

 \item{mapping}{aes mapping}

 \item{data}{data}

-\item{stat}{stat}

-

 \item{position}{position}

 \item{na.rm}{logical}

@@ -4,17 +4,14 @@

 \alias{geom_point2}

 \title{geom_point2}

 \usage{

-geom_point2(mapping = NULL, data = NULL, stat = "identity",

-  position = "identity", na.rm = FALSE, show.legend = NA,

-  inherit.aes = TRUE, ...)

+geom_point2(mapping = NULL, data = NULL, position = "identity",

+  na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...)

 }

 \arguments{

 \item{mapping}{aes mapping}

 \item{data}{data}

-\item{stat}{stat}

-

 \item{position}{position}

 \item{na.rm}{logical}

@@ -4,17 +4,14 @@

 \alias{geom_rootpoint}

 \title{geom_rootpoint}

 \usage{

-geom_rootpoint(mapping = NULL, data = NULL, stat = "identity",

-  position = "identity", na.rm = FALSE, show.legend = NA,

-  inherit.aes = TRUE, ...)

+geom_rootpoint(mapping = NULL, data = NULL, position = "identity",

+  na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...)

 }

 \arguments{

 \item{mapping}{aes mapping}

 \item{data}{data}

-\item{stat}{stat}

-

 \item{position}{position}

 \item{na.rm}{logical}

@@ -4,17 +4,15 @@

 \alias{geom_segment2}

 \title{geom_segment2}

 \usage{

-geom_segment2(mapping = NULL, data = NULL, stat = "identity",

-  position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE,

-  show.legend = NA, inherit.aes = TRUE, ...)

+geom_segment2(mapping = NULL, data = NULL, position = "identity",

+  arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA,

+  inherit.aes = TRUE, ...)

 }

 \arguments{

 \item{mapping}{aes mapping}

 \item{data}{data}

-\item{stat}{stat}

-

 \item{position}{position}

 \item{arrow}{arrow}

@@ -4,10 +4,9 @@

 \alias{geom_text2}

 \title{geom_text2}

 \usage{

-geom_text2(mapping = NULL, data = NULL, stat = "identity",

-  position = "identity", parse = FALSE, na.rm = TRUE, show.legend = NA,

-  inherit.aes = TRUE, ..., nudge_x = 0, nudge_y = 0,

-  check_overlap = FALSE)

+geom_text2(mapping = NULL, data = NULL, position = "identity",

+  parse = FALSE, na.rm = TRUE, show.legend = NA, inherit.aes = TRUE,

+  ..., nudge_x = 0, nudge_y = 0, check_overlap = FALSE)

 }

 \arguments{

 \item{mapping}{the aesthetic mapping}

@@ -15,8 +14,6 @@ geom_text2(mapping = NULL, data = NULL, stat = "identity",

 \item{data}{A layer specific dataset -

 only needed if you want to override he plot defaults.}

-\item{stat}{The statistical transformation to use on the data for this layer}

-

 \item{position}{The position adjustment to use for overlapping points on this layer}

 \item{parse}{if TRUE, the labels will be passd into expressions}

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

 \title{geom_tiplab}

 \usage{

 geom_tiplab(mapping = NULL, hjust = 0, align = FALSE,

-  linetype = "dotted", linesize = 1, ...)

+  linetype = "dotted", linesize = 1, geom = "text", ...)

 }

 \arguments{

 \item{mapping}{aes mapping}

@@ -18,6 +18,8 @@ geom_tiplab(mapping = NULL, hjust = 0, align = FALSE,

 \item{linesize}{line size of line if align = TRUE}

+\item{geom}{one of 'text' and 'label'}

+

 \item{...}{additional parameter}

 }

 \value{

@@ -4,17 +4,14 @@

 \alias{geom_tippoint}

 \title{geom_tippoint}

 \usage{

-geom_tippoint(mapping = NULL, data = NULL, stat = "identity",

-  position = "identity", na.rm = FALSE, show.legend = NA,

-  inherit.aes = TRUE, ...)

+geom_tippoint(mapping = NULL, data = NULL, position = "identity",

+  na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...)

 }

 \arguments{

 \item{mapping}{aes mapping}

 \item{data}{data}

-\item{stat}{stat}

-

 \item{position}{position}

 \item{na.rm}{logical}