@@ -444,10 +444,12 @@ get_clade_position_ <- function(data, node, reverse=FALSE) {

         xmin <- min(sp.df$branch, na.rm=TRUE)

         xmax <- max(x, na.rm=TRUE)

     }

+

+    w <- getOption("clade_width_extend", default = 0.5)

     data.frame(xmin=xmin,

                xmax=xmax,

-               ymin=min(y, na.rm=TRUE) - 0.5,

-               ymax=max(y, na.rm=TRUE) + 0.5)

+               ymin=min(y, na.rm=TRUE) - w,

+               ymax=max(y, na.rm=TRUE) + w)

 }

 build_align_data <- function(data, align){

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

 #'        \item \code{extend} extend xmax of the rectangle, defaults to 0.

 #'        \item \code{extendto} specify a value, meaning the rectangle extend to, defaults to NULL.

 #'        \item \code{linetype} the line type of margin, defaults to 1.

-#'        \item \code{size} the width of line of margin, defaults to 0.5.

+#'        \item \code{linewidth} the width of line of margin, defaults to 0.5.

 #'     }

 #' \code{geom_hilight()} understands the following aesthethics for encircle layer (required 

 #' aesthetics are in bold):

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

 #'        \item \code{alpha} the transparency of fill, defaults to 0.5.

 #'        \item \code{expand} expands the xspline clade region, defaults to 0.

 #'        \item \code{spread} control the size, when only one point.

-#'        \item \code{size} the width of line of margin, defaults to 0.5.

+#'        \item \code{linewidth} the width of line of margin, defaults to 0.5.

 #'        \item \code{linetype} the line type of margin, defaults to 1.

 #'        \item \code{s_shape} the shape of the spline relative to the control points, defaults to 0.5.

 #'        \item \code{s_open}  whether the spline is a line or a closed shape, defaults to FALSE.

@@ -125,10 +125,11 @@ geom_hilight_rect2 <- function(data=NULL,

 #' @importFrom grid rectGrob gpar grobTree

 GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                            default_aes = aes(colour = NA, fill = "steelblue", 

-                                             size = 0.5, linetype = 1, alpha = 0.5,

+                                             linewidth = 0.5, linetype = 1, alpha = 0.5,

                                              extend=0, extendto=NULL),

                            required_aes = c("xmin", "xmax", "ymin", "ymax", "clade_root_node"),

                            draw_key = draw_key_polygon,

+                           rename_size = TRUE,

                            draw_panel = function(self, data, panel_params, coord, 

                                                  linejoin = "mitre", align="none", 

                                                  gradient = FALSE, 

@@ -195,7 +196,7 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                    #data <- data %>% dplyr::left_join(df, by="clade_root_node")

                                    polys <- lapply(split(data, seq_len(nrow(data))), function(row) {

                                                  poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax)

-                                                 aes <- new_data_frame(row[aesthetics])[rep(1,5), ]

+                                                 aes <- row[rep(1,5), aesthetics] 

                                                  #draw_panel_polar(data = cbind(poly, aes), 

                                                  #                 panel_params = panel_params, 

                                                  #                 coord = coord, 

@@ -203,7 +204,7 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                                  #                 gradient.direction = gradient.direction,

                                                  #                 gradient.length.out = gradient.length.out

                                                  #   )

-                                                 GeomPolygon$draw_panel(cbind(poly, aes), panel_params, coord)

+                                                 GeomPolygon$draw_panel(vctrs::vec_cbind(poly, aes), panel_params, coord)

                                                  })

                                    ggname("geom_hilight_rect2", do.call("grobTree", polys))

                                }else{

@@ -235,7 +236,7 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                                          just = c("left", "top"),

                                                          gp = gpar(col = row$colour,

                                                                    fill = fill,

-                                                                   lwd = row$size * ggplot2:::.pt,

+                                                                   lwd = row$linewidth * ggplot2:::.pt,

                                                                    lty = row$linetype,

                                                                    linejoin = linejoin,

                                                                    lineend = if (identical(linejoin, "round")) "round" else "square")

@@ -255,7 +256,7 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                                             gp = grid::gpar(

                                                               col = row$colour,

                                                               fill = alpha(row$fill, row$alpha),

-                                                              lwd = row$size * ggplot2::.pt,

+                                                              lwd = row$linewidth * ggplot2::.pt,

                                                               lty = row$linetype,

                                                               lineend = "butt"

                                                             )

@@ -271,7 +272,7 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                                   just = c("left", "top"),

                                                   gp = gpar(col = coords$colour,

                                                             fill = alpha(coords$fill, coords$alpha),

-                                                            lwd = coords$size * ggplot2:::.pt,

+                                                            lwd = coords$linewidth * ggplot2:::.pt,

                                                             lty = coords$linetype,

                                                             linejoin = linejoin,

                                                             lineend = if (identical(linejoin, "round")) "round" else "square")

@@ -306,9 +307,10 @@ geom_hilight_encircle2 <- function(data=NULL,

 GeomHilightEncircle <- ggproto("GeomHilightEncircle", Geom,

                                 required_aes = c("x", "y", "clade_root_node"),

                                 default_aes = aes(colour="black", fill="steelblue", alpha = 0.5,

-                                                  expand=0, spread=0.1, linetype=1, size=0.5,

+                                                  expand=0, spread=0.1, linetype=1, linewidth = 0.5,

                                                   s_shape=0.5, s_open=FALSE),

                                 draw_key = draw_key_polygon,

+                                rename_size = TRUE,

                                 draw_panel = function(data, panel_scales, coord){

                                     globs <- lapply(split(data, data$clade_root_node), function(i)

                                                    get_glob_encircle(i, panel_scales, coord))

@@ -475,9 +477,14 @@ build_align_data <- function(data, align){

 #' @importFrom utils getFromNamespace

-warning_wrap <- getFromNamespace("warning_wrap", "ggplot2")

+#warning_wrap <- getFromNamespace("warning_wrap", "ggplot2")

+warning_wrap <- function(...){

+    x = paste0(...)

+    x = paste(strwrap(x), collapse = "\n")

+    warning(x, call. = FALSE)

+}

 rect_to_poly <- getFromNamespace("rect_to_poly", "ggplot2")

-new_data_frame <- getFromNamespace("new_data_frame", "ggplot2")

+#new_data_frame <- getFromNamespace("new_data_frame", "ggplot2")

 ## ##' layer of hilight clade with rectangle

 ## ##'

@@ -13,6 +13,8 @@

 #' unrooted and daylight layout tree use will use encircle layer. You can specify this parameter to

 #' `rect` (rectangular layer) or `encircle` (encircle layer), 'gradient' (gradient color), 

 #' 'roundrect' (round rectangular layer).

+#' @param to.bottom logical, whether set the high light layer to the bottom in all layers of 'ggtree'

+#' object, default is FALSE.

 #' @param ... additional parameters, see also the below and Aesthetics section.

 #'     \itemize{

 #'        \item \code{align} control the align direction of the edge of high light rectangular.

@@ -82,12 +84,14 @@ geom_hilight <- function(data=NULL,

                          mapping=NULL,

                          node=NULL,

                          type="auto",

+                         to.bottom=FALSE,

                           ...){

     params <- list(...)

     structure(list(data    = data,

                    mapping = mapping,

                    node    = node,

                    type    = type,

+                   to.bottom = to.bottom,

                    params  = params),

               class = 'hilight')

 }

@@ -5,10 +5,10 @@

 #'

 #' @title geom_hilight 

 #' @rdname geom-hilight

-#' @param data data.frame, The data to be displayed in this layer, default is NULL.

-#' @param mapping Set of aesthetic mappings, default is NULL.

+#' @param data data.frame, The data to be displayed in this layer, defaults to NULL.

+#' @param mapping Set of aesthetic mappings, defaults to NULL.

 #' @param node selected node to hilight, when data and mapping is NULL, it is required.

-#' @param type the type of layer, default is `auto`, meaning rectangular, circular,

+#' @param type the type of layer, defaults to `auto`, meaning rectangular, circular,

 #' slanted, fan, inward_circular, radial, equal_angle, ape layout tree will use rectangular layer,

 #' unrooted and daylight layout tree use will use encircle layer. You can specify this parameter to

 #' `rect` (rectangular layer) or `encircle` (encircle layer), 'gradient' (gradient color), 

@@ -18,39 +18,39 @@

 #'        \item \code{align} control the align direction of the edge of high light rectangular.

 #'          Options is 'none' (default), 'left', 'right', 'both'. This argument only work when the

 #'          'geom_hilight' is plotting using geom_hilight(mapping=aes(...)).

-#'        \item \code{gradient.direction} character, the direction of gradient color, default is 'rt'

+#'        \item \code{gradient.direction} character, the direction of gradient color, defaults to 'rt'

 #'          meaning the locations of gradient color is from root to tip, options are 'rt' and 'tr'.

 #'        \item \code{gradient.length.out} integer, desired length of the sequence of gradient color,

-#'          default is 2.

+#'          defaults to 2.

 #'        \item \code{roundrect.r} numeric, the radius of the rounded corners, when \code{roundrect=TRUE},

-#'          default is 0.05.

+#'          defaults to 0.05.

 #'     }

 #' @section Aesthetics:

 #' \code{geom_hilight()} understands the following aesthetics for rectangular layer (required 

 #' aesthetics are in bold):

 #'     \itemize{

 #'        \item \strong{\code{node}} selected node to hight light, it is required.

-#'        \item \code{colour} the colour of margin, default is NA.

-#'        \item \code{fill} the colour of fill, default is 'steelblue'.

-#'        \item \code{alpha} the transparency of fill, default is 0.5.

-#'        \item \code{extend} extend xmax of the rectangle, default is 0.

-#'        \item \code{extendto} specify a value, meaning the rectangle extend to, default is NULL.

-#'        \item \code{linetype} the line type of margin, default is 1.

-#'        \item \code{size} the width of line of margin, default is 0.5.

+#'        \item \code{colour} the colour of margin, defaults to NA.

+#'        \item \code{fill} the colour of fill, defaults to 'steelblue'.

+#'        \item \code{alpha} the transparency of fill, defaults to 0.5.

+#'        \item \code{extend} extend xmax of the rectangle, defaults to 0.

+#'        \item \code{extendto} specify a value, meaning the rectangle extend to, defaults to NULL.

+#'        \item \code{linetype} the line type of margin, defaults to 1.

+#'        \item \code{size} the width of line of margin, defaults to 0.5.

 #'     }

 #' \code{geom_hilight()} understands the following aesthethics for encircle layer (required 

 #' aesthetics are in bold):

 #'     \itemize{

 #'        \item \strong{\code{node}} selected node to hight light, it is required.

-#'        \item \code{colour} the colour of margin, default is 'black'.

-#'        \item \code{fill} the colour of fill, default is 'steelblue'.

-#'        \item \code{alpha} the transparency of fill, default is 0.5.

-#'        \item \code{expand} expands the xspline clade region, default is 0.

+#'        \item \code{colour} the colour of margin, defaults to 'black'.

+#'        \item \code{fill} the colour of fill, defaults to 'steelblue'.

+#'        \item \code{alpha} the transparency of fill, defaults to 0.5.

+#'        \item \code{expand} expands the xspline clade region, defaults to 0.

 #'        \item \code{spread} control the size, when only one point.

-#'        \item \code{size} the width of line of margin, default is 0.5.

-#'        \item \code{linetype} the line type of margin, default is 1.

-#'        \item \code{s_shape} the shape of the spline relative to the control points, default is 0.5.

-#'        \item \code{s_open}  whether the spline is a line or a closed shape, default is FALSE.

+#'        \item \code{size} the width of line of margin, defaults to 0.5.

+#'        \item \code{linetype} the line type of margin, defaults to 1.

+#'        \item \code{s_shape} the shape of the spline relative to the control points, defaults to 0.5.

+#'        \item \code{s_open}  whether the spline is a line or a closed shape, defaults to FALSE.

 #'     }

 #' @return a list object.

 #' @author Guangchuang Yu and Shuangbin Xu

@@ -74,6 +74,10 @@

 #' # display the high light layer with round rectangular.

 #' p8 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), type = "roundrect", alpha=0.68)

 #' p2/ p3/ p4/ p5 / p6/ p7/ p8

+#' @references  

+#' For more detailed demonstration, please refer to chapter 5.2.2 of 

+#' *Data Integration, Manipulation and Visualization of Phylogenetic Trees*

+#' <http://yulab-smu.top/treedata-book/index.html> by Guangchuang Yu.

 geom_hilight <- function(data=NULL,

                          mapping=NULL,

                          node=NULL,

@@ -18,15 +18,10 @@

 #'        \item \code{align} control the align direction of the edge of high light rectangular.

 #'          Options is 'none' (default), 'left', 'right', 'both'. This argument only work when the

 #'          'geom_hilight' is plotting using geom_hilight(mapping=aes(...)).

-#'        \item \code{gradient} logical, whether to set the color of hight light layer to gradient,

-#'          default is FALSE, it only work for rectangular, ellipse, roundrect layouts.

 #'        \item \code{gradient.direction} character, the direction of gradient color, default is 'rt'

 #'          meaning the locations of gradient color is from root to tip, options are 'rt' and 'tr'.

 #'        \item \code{gradient.length.out} integer, desired length of the sequence of gradient color,

 #'          default is 2.

-#'        \item \code{roundrect} logical, whether to use the round rectangular layer, default is FALSE,

-#'          it can not be used with \code{gradient=TRUE}, and it only work for rectangular, ellipse,

-#'          roundrect layouts

 #'        \item \code{roundrect.r} numeric, the radius of the rounded corners, when \code{roundrect=TRUE},

 #'          default is 0.05.

 #'     }

@@ -73,9 +68,11 @@

 #' p3 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), align="left")

 #' p4 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), align="right")

 #' p5 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), align="both")

-#' p6 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), gradient = TRUE, alpha=0.68)

-#' p7 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), gradient = TRUE, gradient.direction="tr", alpha=0.68)

-#' p8 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), roundrect = TRUE, alpha=0.68)

+#' # display the high light layer with gradiental color rectangular.

+#' p6 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), type = "gradient", alpha=0.68)

+#' p7 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), type = "gradient", gradient.direction="tr", alpha=0.68)

+#' # display the high light layer with round rectangular.

+#' p8 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), type = "roundrect", alpha=0.68)

 #' p2/ p3/ p4/ p5 / p6/ p7/ p8

 geom_hilight <- function(data=NULL,

                          mapping=NULL,

@@ -11,20 +11,10 @@

 #' @param type the type of layer, default is `auto`, meaning rectangular, circular,

 #' slanted, fan, inward_circular, radial, equal_angle, ape layout tree will use rectangular layer,

 #' unrooted and daylight layout tree use will use encircle layer. You can specify this parameter to

-#' `rect` (rectangular layer) or `encircle` (encircle layer).

-#' @param ... additional parameters, see also Aesthetics section.

-#' @section Aesthetics:

-#' \code{geom_hilight()} understands the following aesthetics for rectangular layer (required 

-#' aesthetics are in bold):

+#' `rect` (rectangular layer) or `encircle` (encircle layer), 'gradient' (gradient color), 

+#' 'roundrect' (round rectangular layer).

+#' @param ... additional parameters, see also the below and Aesthetics section.

 #'     \itemize{

-#'        \item \strong{\code{node}} selected node to hight light, it is required.

-#'        \item \code{colour} the colour of margin, default is NA.

-#'        \item \code{fill} the colour of fill, default is 'steelblue'.

-#'        \item \code{alpha} the transparency of fill, default is 0.5.

-#'        \item \code{extend} extend xmax of the rectangle, default is 0.

-#'        \item \code{extendto} specify a value, meaning the rectangle extend to, default is NULL.

-#'        \item \code{linetype} the line type of margin, default is 1.

-#'        \item \code{size} the width of line of margin, default is 0.5.

 #'        \item \code{align} control the align direction of the edge of high light rectangular.

 #'          Options is 'none' (default), 'left', 'right', 'both'. This argument only work when the

 #'          'geom_hilight' is plotting using geom_hilight(mapping=aes(...)).

@@ -35,11 +25,24 @@

 #'        \item \code{gradient.length.out} integer, desired length of the sequence of gradient color,

 #'          default is 2.

 #'        \item \code{roundrect} logical, whether to use the round rectangular layer, default is FALSE,

-#'          it can not be used with \code{gradient=TRUE}, and it only work for rectangular, ellipse, 

+#'          it can not be used with \code{gradient=TRUE}, and it only work for rectangular, ellipse,

 #'          roundrect layouts

 #'        \item \code{roundrect.r} numeric, the radius of the rounded corners, when \code{roundrect=TRUE},

 #'          default is 0.05.

 #'     }

+#' @section Aesthetics:

+#' \code{geom_hilight()} understands the following aesthetics for rectangular layer (required 

+#' aesthetics are in bold):

+#'     \itemize{

+#'        \item \strong{\code{node}} selected node to hight light, it is required.

+#'        \item \code{colour} the colour of margin, default is NA.

+#'        \item \code{fill} the colour of fill, default is 'steelblue'.

+#'        \item \code{alpha} the transparency of fill, default is 0.5.

+#'        \item \code{extend} extend xmax of the rectangle, default is 0.

+#'        \item \code{extendto} specify a value, meaning the rectangle extend to, default is NULL.

+#'        \item \code{linetype} the line type of margin, default is 1.

+#'        \item \code{size} the width of line of margin, default is 0.5.

+#'     }

 #' \code{geom_hilight()} understands the following aesthethics for encircle layer (required 

 #' aesthetics are in bold):

 #'     \itemize{

@@ -28,6 +28,17 @@

 #'        \item \code{align} control the align direction of the edge of high light rectangular.

 #'          Options is 'none' (default), 'left', 'right', 'both'. This argument only work when the

 #'          'geom_hilight' is plotting using geom_hilight(mapping=aes(...)).

+#'        \item \code{gradient} logical, whether to set the color of hight light layer to gradient,

+#'          default is FALSE, it only work for rectangular, ellipse, roundrect layouts.

+#'        \item \code{gradient.direction} character, the direction of gradient color, default is 'rt'

+#'          meaning the locations of gradient color is from root to tip, options are 'rt' and 'tr'.

+#'        \item \code{gradient.length.out} integer, desired length of the sequence of gradient color,

+#'          default is 2.

+#'        \item \code{roundrect} logical, whether to use the round rectangular layer, default is FALSE,

+#'          it can not be used with \code{gradient=TRUE}, and it only work for rectangular, ellipse, 

+#'          roundrect layouts

+#'        \item \code{roundrect.r} numeric, the radius of the rounded corners, when \code{roundrect=TRUE},

+#'          default is 0.05.

 #'     }

 #' \code{geom_hilight()} understands the following aesthethics for encircle layer (required 

 #' aesthetics are in bold):

@@ -59,7 +70,10 @@

 #' p3 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), align="left")

 #' p4 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), align="right")

 #' p5 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), align="both")

-#' p2/ p3/ p4/ p5

+#' p6 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), gradient = TRUE, alpha=0.68)

+#' p7 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), gradient = TRUE, gradient.direction="tr", alpha=0.68)

+#' p8 <- p + geom_hilight(data=dat, mapping=aes(node=id, fill=type), roundrect = TRUE, alpha=0.68)

+#' p2/ p3/ p4/ p5 / p6/ p7/ p8

 geom_hilight <- function(data=NULL,

                          mapping=NULL,

                          node=NULL,

@@ -111,7 +125,9 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                                  linejoin = "mitre", align="none", 

                                                  gradient = FALSE, 

                                                  gradient.direction = "rt",

-                                                 gradient.length.out = 2

+                                                 gradient.length.out = 2,

+                                                 roundrect = FALSE,

+                                                 roundrect.r = 0.05

                                                  ){

                                data$xmax <- data$xmax + data$extend

                                if (!any(is.null(data$extendto)) && !any(is.na(data$extendto))){

@@ -140,45 +156,55 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                }

                                data <- build_align_data(data=data, align=align) 

                                if (!coord$is_linear()) {

-                                   aesthetics <- setdiff(c(names(data), "x.start", "y.start", "x.stop", "y.stop"), 

+                                   if (gradient){

+                                       warning_wrap("The gradient color hight light layer only presents in rectangular, ellipse, roundrect layouts")

+                                   }

+                                   if (roundrect){

+                                       warning_wrap("The round rectangular hight light layer only presents in rectangular, ellipse, roundrect layouts")

+                                   }

+                                   aesthetics <- setdiff(colnames(data), #"x.start", "y.start", "x.stop", "y.stop"), 

                                                          c("xmin", "xmax", "ymin", "ymax", "clade_root_node"))

-                                   df.start <- lapply(split(data, data$clade_root_node), function(node){

-                                                    dplyr::mutate(node, x=.data$xmin, y=(.data$ymax-.data$ymin)/2)

-                                                    }) %>%

-                                               dplyr::bind_rows() %>%

-                                               dplyr::select(!c("xmin", "xmax", "ymin", "ymax"))

-                                   df.stop <- lapply(split(data, data$clade_root_node), function(node){

-                                                    dplyr::mutate(node, x=.data$xmax, y=(.data$ymax-.data$ymin)/2)

-                                                    }) %>% 

-                                              dplyr::bind_rows() %>%

-                                              dplyr::select(!c("xmin", "xmax", "ymin", "ymax"))

-                                   

-                                   df.start <- ggplot2::coord_munch(coord, data = df.start, panel_params) %>% 

-                                               dplyr::select(c("x", "y", "clade_root_node")) %>%

-                                               dplyr::rename(x.start="x", y.start="y")

+                                   #df.start <- lapply(split(data, data$clade_root_node), function(node){

+                                   #                 dplyr::mutate(node, x=.data$xmin, y=(.data$ymax-.data$ymin)/2)

+                                   #                 }) %>%

+                                   #            dplyr::bind_rows() %>%

+                                   #            dplyr::select(!c("xmin", "xmax", "ymin", "ymax"))

+                                   #df.stop <- lapply(split(data, data$clade_root_node), function(node){

+                                   #                 dplyr::mutate(node, x=.data$xmax, y=(.data$ymax-.data$ymin)/2)

+                                   #                 }) %>% 

+                                   #           dplyr::bind_rows() %>%

+                                   #           dplyr::select(!c("xmin", "xmax", "ymin", "ymax"))

+                                   #

+                                   #df.start <- ggplot2::coord_munch(coord, data = df.start, panel_params) %>% 

+                                   #            dplyr::select(c("x", "y", "clade_root_node")) %>%

+                                   #            dplyr::rename(x.start="x", y.start="y")

-                                   df.stop <- ggplot2::coord_munch(coord, data = df.stop, panel_params) %>%

-                                              dplyr::select(c("x", "y", "clade_root_node")) %>%

-                                              dplyr::rename(x.stop="x", y.stop="y")

+                                   #df.stop <- ggplot2::coord_munch(coord, data = df.stop, panel_params) %>%

+                                   #           dplyr::select(c("x", "y", "clade_root_node")) %>%

+                                   #           dplyr::rename(x.stop="x", y.stop="y")

-                                   df <- df.start %>% left_join(df.stop, by="clade_root_node")

-                                   data <- data %>% dplyr::left_join(df, by="clade_root_node")

-                                   print(data)

+                                   #df <- df.start %>% left_join(df.stop, by="clade_root_node")

+                                   #data <- data %>% dplyr::left_join(df, by="clade_root_node")

                                    polys <- lapply(split(data, seq_len(nrow(data))), function(row) {

                                                  poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax)

                                                  aes <- new_data_frame(row[aesthetics])[rep(1,5), ]

-                                                 draw_panel_polar(data = cbind(poly, aes), 

-                                                                  panel_params = panel_params, 

-                                                                  coord = coord, 

-                                                                  gradient = gradient, 

-                                                                  gradient.direction = gradient.direction,

-                                                                  gradient.length.out = gradient.length.out

-                                                    )

+                                                 #draw_panel_polar(data = cbind(poly, aes), 

+                                                 #                 panel_params = panel_params, 

+                                                 #                 coord = coord, 

+                                                 #                 gradient = gradient, 

+                                                 #                 gradient.direction = gradient.direction,

+                                                 #                 gradient.length.out = gradient.length.out

+                                                 #   )

+                                                 GeomPolygon$draw_panel(cbind(poly, aes), panel_params, coord)

                                                  })

                                    ggname("geom_hilight_rect2", do.call("grobTree", polys))

                                }else{

                                    coords <- coord$transform(data, panel_params)

+                                   hilightGrob <- ifelse(roundrect, grid::roundrectGrob, grid::rectGrob)

                                    if (gradient){

+                                       if (roundrect){

+                                           warning_wrap("The round rectangular and gradient are not applied simultaneously")

+                                       }

                                        gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

                                        rects <- lapply(split(coords, seq_len(nrow(coords))), function(row){

                                                      fill <- grid::linearGradient(

@@ -194,7 +220,9 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                                                  stops = seq(0, 1, length.out = gradient.length.out)

                                                              )

                                                      rectGrob(

-                                                         row$xmin, row$ymax, width = row$xmax - row$xmin, height = row$ymax - row$ymin,

+                                                         x = row$xmin, y = row$ymax, 

+                                                         width = row$xmax - row$xmin, 

+                                                         height = row$ymax - row$ymin,

                                                          default.units = "native",

                                                          just = c("left", "top"),

                                                          gp = gpar(col = row$colour,

@@ -207,19 +235,40 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                                  })

                                        ggname("geom_hilight_rect2", do.call("grobTree", rects))

                                    }else{

-                                       ggname("geom_hilight_rect2", rectGrob(

-                                              coords$xmin, coords$ymax,

-                                              width = coords$xmax - coords$xmin,

-                                              height = coords$ymax - coords$ymin,

-                                              default.units = "native",

-                                              just = c("left", "top"),

-                                              gp = gpar(col = coords$colour,

-                                                        fill = alpha(coords$fill, coords$alpha),

-                                                        lwd = coords$size * ggplot2:::.pt,

-                                                        lty = coords$linetype,

-                                                        linejoin = linejoin,

-                                                        lineend = if (identical(linejoin, "round")) "round" else "square")

-                                         ))

+                                       if (roundrect){

+                                           rects <- lapply(split(coords, seq_len(nrow(coords))), function(row) 

+                                                        grid::roundrectGrob(

+                                                            row$xmin, row$ymax,

+                                                            width = row$xmax - row$xmin,

+                                                            height = row$ymax - row$ymin,

+                                                            r = grid::unit(roundrect.r, "snpc"),

+                                                            default.units = "native",

+                                                            just = c("left", "top"),

+                                                            gp = grid::gpar(

+                                                              col = row$colour,

+                                                              fill = alpha(row$fill, row$alpha),

+                                                              lwd = row$size * ggplot2::.pt,

+                                                              lty = row$linetype,

+                                                              lineend = "butt"

+                                                            )

+                                                        )

+                                                    )

+                                           ggname("geom_hilight_rect2", do.call("grobTree", rects)) 

+                                       }else{

+                                           ggname("geom_hilight_rect2", rectGrob(

+                                                  coords$xmin, coords$ymax,

+                                                  width = coords$xmax - coords$xmin,

+                                                  height = coords$ymax - coords$ymin,

+                                                  default.units = "native",

+                                                  just = c("left", "top"),

+                                                  gp = gpar(col = coords$colour,

+                                                            fill = alpha(coords$fill, coords$alpha),

+                                                            lwd = coords$size * ggplot2:::.pt,

+                                                            lty = coords$linetype,

+                                                            linejoin = linejoin,

+                                                            lineend = if (identical(linejoin, "round")) "round" else "square")

+                                             ))

+                                       }

                                    }

                                }

                            }

@@ -261,92 +310,92 @@ GeomHilightEncircle <- ggproto("GeomHilightEncircle", Geom,

                         )

-draw_panel_polar <- function (data, panel_params, coord, rule = "evenodd", gradient, gradient.direction, gradient.length.out){

-    n <- nrow(data)

-    if (n == 1)

-        return(zeroGrob())

-    munched <- ggplot2::coord_munch(coord, data, panel_params)

-    if (is.null(munched$subgroup)) {

-        munched <- munched[order(munched$group), ]

-        first_idx <- !duplicated(munched$group)

-        first_rows <- munched[first_idx, ]

-        if (gradient){

-            gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

-            rects <- lapply(split(munched, munched$group), function(row){

-                            fill <- grid::linearGradient(

-                                        x1 = unique(row$x.start), 

-                                        x2 = unique(row$x.stop),

-                                        y1 = unique(row$y.start),

-                                        y2 = unique(row$y.stop),

-                                        default.units = "native",

-                                        colours = if (gradient.direction=="rt"){

-                                                     alpha(c(first_rows$fill, "white"), first_rows$alpha) 

-                                                  }else{

-                                                     rev(alpha(c(first_rows$fill, "white"), first_rows$alpha))

-                                                  },

-                                        stops = seq(0, 1, length.out = gradient.length.out)

-                                    )

-                            grid::polygonGrob(

-                                row$x, row$y, id = row$group,

-                                default.units = "native",

-                                gp = gpar(col = first_rows$colour,

-                                          fill = fill,

-                                          lwd = first_rows$size * ggplot2:::.pt,

-                                          lty = first_rows$linetype)

-                            )

-                     })

-            ggname("geom_polygon2", do.call("grobTree", rects))   

-        }else{

-            ggname("geom_polygon2", grid::polygonGrob(munched$x, munched$y,

-               default.units = "native", id = munched$group, gp = gpar(col = first_rows$colour,

-               fill = alpha(first_rows$fill, first_rows$alpha),

-               lwd = first_rows$size * ggplot2::.pt, lty = first_rows$linetype)))

-        }

-    }

-    else {

-        if (utils::packageVersion("grid") < "3.6") {

-            abort("Polygons with holes requires R 3.6 or above")

-        }

-        munched <- munched[order(munched$group, munched$subgroup), ]

-        id <- match(munched$subgroup, unique(munched$subgroup))

-        first_idx <- !duplicated(munched$group)

-        first_rows <- munched[first_idx, ]

-        if (gradient){

-            gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

-            rects <- lapply(split(munched, munched$group), function(row){

-                            fill <- grid::linearGradient(

-                                        x1 = first_rows$x.start,

-                                        x2 = first_rows$x.stop,

-                                        y1 = first_rows$y.start,

-                                        y2 = first_rows$y.stop,

-                                        default.units = "native",

-                                        colours = if (gradient.direction=="rt"){

-                                                     alpha(c(first_rows$fill, "white"), first_rows$alpha)

-                                                  }else{

-                                                     rev(alpha(c(first_rows$fill, "white"), first_rows$alpha))

-                                                  },

-                                        stops = seq(0, 1, length.out = gradient.length.out)

-                                    )

-                            grid::pathGrob(

-                                row$x, row$y, id = match(row$subgroup, unique(row$group)), 

-                                pathId = munched$group,

-                                rule = rule, default.units = "native",

-                                gp = gpar(col = first_rows$colour,

-                                          fill = fill,

-                                          lwd = first_rows$size * ggplot2:::.pt,

-                                          lty = first_rows$linetype)

-                            )

-                     })

-            ggname("geom_polygon2", do.call("grobTree", rects)) 

-        }else{

-            ggname("geom_polygon2", grid::pathGrob(munched$x, munched$y,

-                default.units = "native", id = id, pathId = munched$group,

-                rule = rule, gp = gpar(col = first_rows$colour, fill = alpha(first_rows$fill,

-                first_rows$alpha), lwd = first_rows$size * ggplot2::.pt,

-                lty = first_rows$linetype)))

-        }

-    }

-}

+#draw_panel_polar <- function (data, panel_params, coord, rule = "evenodd", gradient, gradient.direction, gradient.length.out){

+#    n <- nrow(data)

+#    if (n == 1)

+#        return(zeroGrob())

+#    munched <- ggplot2::coord_munch(coord, data, panel_params)

+#    if (is.null(munched$subgroup)) {

+#        munched <- munched[order(munched$group), ]

+#        first_idx <- !duplicated(munched$group)

+#        first_rows <- munched[first_idx, ]

+#        if (gradient){

+#            gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

+#            rects <- lapply(split(munched, munched$group), function(row){

+#                            fill <- grid::linearGradient(

+#                                        x1 = unique(row$x.start), 

+#                                        x2 = unique(row$x.stop),

+#                                        y1 = 0,

+#                                        y2 = 1,

+#                                        default.units = "native",

+#                                        colours = if (gradient.direction=="rt"){

+#                                                     alpha(c(first_rows$fill, "white"), first_rows$alpha) 

+#                                                  }else{

+#                                                     rev(alpha(c(first_rows$fill, "white"), first_rows$alpha))

+#                                                  },

+#                                        stops = seq(0, 1, length.out = gradient.length.out)

+#                                    )

+#                            grid::polygonGrob(

+#                                row$x, row$y, id = row$group,

+#                                default.units = "native",

+#                                gp = gpar(col = first_rows$colour,

+#                                          fill = fill,

+#                                          lwd = first_rows$size * ggplot2:::.pt,

+#                                          lty = first_rows$linetype)

+#                            )

+#                     })

+#            ggname("geom_polygon2", do.call("grobTree", rects))   

+#        }else{

+#            ggname("geom_polygon2", grid::polygonGrob(munched$x, munched$y,

+#               default.units = "native", id = munched$group, gp = gpar(col = first_rows$colour,

+#               fill = alpha(first_rows$fill, first_rows$alpha),

+#               lwd = first_rows$size * ggplot2::.pt, lty = first_rows$linetype)))

+#        }

+#    }

+#    else {

+#        if (utils::packageVersion("grid") < "3.6") {

+#            abort("Polygons with holes requires R 3.6 or above")

+#        }

+#        munched <- munched[order(munched$group, munched$subgroup), ]

+#        id <- match(munched$subgroup, unique(munched$subgroup))

+#        first_idx <- !duplicated(munched$group)

+#        first_rows <- munched[first_idx, ]

+#        if (gradient){

+#            gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

+#            rects <- lapply(split(munched, munched$group), function(row){

+#                            fill <- grid::linearGradient(

+#                                        x1 = first_rows$x.start,

+#                                        x2 = first_rows$x.stop,

+#                                        y1 = first_rows$y.start,

+#                                        y2 = first_rows$y.stop,

+#                                        default.units = "native",

+#                                        colours = if (gradient.direction=="rt"){

+#                                                     alpha(c(first_rows$fill, "white"), first_rows$alpha)

+#                                                  }else{

+#                                                     rev(alpha(c(first_rows$fill, "white"), first_rows$alpha))

+#                                                  },

+#                                        stops = seq(0, 1, length.out = gradient.length.out)

+#                                    )

+#                            grid::pathGrob(

+#                                row$x, row$y, id = match(row$subgroup, unique(row$group)), 

+#                                pathId = munched$group,

+#                                rule = rule, default.units = "native",

+#                                gp = gpar(col = first_rows$colour,

+#                                          fill = fill,

+#                                          lwd = first_rows$size * ggplot2:::.pt,

+#                                          lty = first_rows$linetype)

+#                            )

+#                     })

+#            ggname("geom_polygon2", do.call("grobTree", rects)) 

+#        }else{

+#            ggname("geom_polygon2", grid::pathGrob(munched$x, munched$y,

+#                default.units = "native", id = id, pathId = munched$group,

+#                rule = rule, gp = gpar(col = first_rows$colour, fill = alpha(first_rows$fill,

+#                first_rows$alpha), lwd = first_rows$size * ggplot2::.pt,

+#                lty = first_rows$linetype)))

+#        }

+#    }

+#}

 ##' get position of clade (xmin, xmax, ymin, ymax)

 ##'

@@ -107,7 +107,12 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                              extend=0, extendto=NULL),

                            required_aes = c("xmin", "xmax", "ymin", "ymax", "clade_root_node"),

                            draw_key = draw_key_polygon,

-                           draw_panel = function(self, data, panel_params, coord, linejoin = "mitre", align="none") {

+                           draw_panel = function(self, data, panel_params, coord, 

+                                                 linejoin = "mitre", align="none", 

+                                                 gradient = FALSE, 

+                                                 gradient.direction = "rt",

+                                                 gradient.length.out = 2

+                                                 ){

                                data$xmax <- data$xmax + data$extend

                                if (!any(is.null(data$extendto)) && !any(is.na(data$extendto))){

                                    # check whether the x of tree is reversed.

@@ -135,28 +140,87 @@ GeomHilightRect <- ggproto("GeomHilightRect", Geom,

                                }

                                data <- build_align_data(data=data, align=align) 

                                if (!coord$is_linear()) {

-                                   aesthetics <- setdiff(names(data), c("xmin", "xmax", "ymin", "ymax", "clade_root_node"))

+                                   aesthetics <- setdiff(c(names(data), "x.start", "y.start", "x.stop", "y.stop"), 

+                                                         c("xmin", "xmax", "ymin", "ymax", "clade_root_node"))

+                                   df.start <- lapply(split(data, data$clade_root_node), function(node){

+                                                    dplyr::mutate(node, x=.data$xmin, y=(.data$ymax-.data$ymin)/2)

+                                                    }) %>%

+                                               dplyr::bind_rows() %>%

+                                               dplyr::select(!c("xmin", "xmax", "ymin", "ymax"))

+                                   df.stop <- lapply(split(data, data$clade_root_node), function(node){

+                                                    dplyr::mutate(node, x=.data$xmax, y=(.data$ymax-.data$ymin)/2)

+                                                    }) %>% 

+                                              dplyr::bind_rows() %>%

+                                              dplyr::select(!c("xmin", "xmax", "ymin", "ymax"))

+                                   

+                                   df.start <- ggplot2::coord_munch(coord, data = df.start, panel_params) %>% 

+                                               dplyr::select(c("x", "y", "clade_root_node")) %>%

+                                               dplyr::rename(x.start="x", y.start="y")

+

+                                   df.stop <- ggplot2::coord_munch(coord, data = df.stop, panel_params) %>%

+                                              dplyr::select(c("x", "y", "clade_root_node")) %>%

+                                              dplyr::rename(x.stop="x", y.stop="y")

+

+                                   df <- df.start %>% left_join(df.stop, by="clade_root_node")

+                                   data <- data %>% dplyr::left_join(df, by="clade_root_node")

+                                   print(data)

                                    polys <- lapply(split(data, seq_len(nrow(data))), function(row) {

                                                  poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax)

                                                  aes <- new_data_frame(row[aesthetics])[rep(1,5), ]

-                                                 GeomPolygon$draw_panel(cbind(poly, aes), panel_params, coord)

+                                                 draw_panel_polar(data = cbind(poly, aes), 

+                                                                  panel_params = panel_params, 

+                                                                  coord = coord, 

+                                                                  gradient = gradient, 

+                                                                  gradient.direction = gradient.direction,

+                                                                  gradient.length.out = gradient.length.out

+                                                    )

                                                  })

-                                   ggname("bar", do.call("grobTree", polys))

+                                   ggname("geom_hilight_rect2", do.call("grobTree", polys))

                                }else{

                                    coords <- coord$transform(data, panel_params)

-                                   ggname("geom_hilight_rect2", rectGrob(

-                                           coords$xmin, coords$ymax,

-                                           width = coords$xmax - coords$xmin,

-                                           height = coords$ymax - coords$ymin,

-                                           default.units = "native",

-                                           just = c("left", "top"),

-                                           gp = gpar(col = coords$colour,

-                                                     fill = alpha(coords$fill, coords$alpha),

-                                                     lwd = coords$size * ggplot2:::.pt,

-                                                     lty = coords$linetype,

-                                                     linejoin = linejoin,

-                                                     lineend = if (identical(linejoin, "round")) "round" else "square")

+                                   if (gradient){

+                                       gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

+                                       rects <- lapply(split(coords, seq_len(nrow(coords))), function(row){

+                                                     fill <- grid::linearGradient(

+                                                                 x1 = 0,

+                                                                 x2 = 1,

+                                                                 y1 = 0.5,

+                                                                 y2 = 0.5,

+                                                                 colours = if(gradient.direction == "rt"){

+                                                                               alpha(c(row$fill, "white"), row$alpha)

+                                                                           }else{

+                                                                               rev(alpha(c(row$fill, "white"), row$alpha))

+                                                                           },

+                                                                 stops = seq(0, 1, length.out = gradient.length.out)

+                                                             )

+                                                     rectGrob(

+                                                         row$xmin, row$ymax, width = row$xmax - row$xmin, height = row$ymax - row$ymin,

+                                                         default.units = "native",

+                                                         just = c("left", "top"),

+                                                         gp = gpar(col = row$colour,

+                                                                   fill = fill,

+                                                                   lwd = row$size * ggplot2:::.pt,

+                                                                   lty = row$linetype,

+                                                                   linejoin = linejoin,

+                                                                   lineend = if (identical(linejoin, "round")) "round" else "square")

+                                                     )

+                                                 })

+                                       ggname("geom_hilight_rect2", do.call("grobTree", rects))

+                                   }else{

+                                       ggname("geom_hilight_rect2", rectGrob(

+                                              coords$xmin, coords$ymax,

+                                              width = coords$xmax - coords$xmin,

+                                              height = coords$ymax - coords$ymin,

+                                              default.units = "native",

+                                              just = c("left", "top"),

+                                              gp = gpar(col = coords$colour,

+                                                        fill = alpha(coords$fill, coords$alpha),

+                                                        lwd = coords$size * ggplot2:::.pt,

+                                                        lty = coords$linetype,

+                                                        linejoin = linejoin,

+                                                        lineend = if (identical(linejoin, "round")) "round" else "square")

                                          ))

+                                   }

                                }

                            }

@@ -196,6 +260,94 @@ GeomHilightEncircle <- ggproto("GeomHilightEncircle", Geom,

                         )

+

+draw_panel_polar <- function (data, panel_params, coord, rule = "evenodd", gradient, gradient.direction, gradient.length.out){

+    n <- nrow(data)

+    if (n == 1)

+        return(zeroGrob())

+    munched <- ggplot2::coord_munch(coord, data, panel_params)

+    if (is.null(munched$subgroup)) {

+        munched <- munched[order(munched$group), ]

+        first_idx <- !duplicated(munched$group)

+        first_rows <- munched[first_idx, ]

+        if (gradient){

+            gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

+            rects <- lapply(split(munched, munched$group), function(row){

+                            fill <- grid::linearGradient(

+                                        x1 = unique(row$x.start), 

+                                        x2 = unique(row$x.stop),

+                                        y1 = unique(row$y.start),

+                                        y2 = unique(row$y.stop),

+                                        default.units = "native",

+                                        colours = if (gradient.direction=="rt"){

+                                                     alpha(c(first_rows$fill, "white"), first_rows$alpha) 

+                                                  }else{

+                                                     rev(alpha(c(first_rows$fill, "white"), first_rows$alpha))

+                                                  },

+                                        stops = seq(0, 1, length.out = gradient.length.out)

+                                    )

+                            grid::polygonGrob(

+                                row$x, row$y, id = row$group,

+                                default.units = "native",

+                                gp = gpar(col = first_rows$colour,

+                                          fill = fill,

+                                          lwd = first_rows$size * ggplot2:::.pt,

+                                          lty = first_rows$linetype)

+                            )

+                     })

+            ggname("geom_polygon2", do.call("grobTree", rects))   

+        }else{

+            ggname("geom_polygon2", grid::polygonGrob(munched$x, munched$y,

+               default.units = "native", id = munched$group, gp = gpar(col = first_rows$colour,

+               fill = alpha(first_rows$fill, first_rows$alpha),

+               lwd = first_rows$size * ggplot2::.pt, lty = first_rows$linetype)))

+        }

+    }

+    else {

+        if (utils::packageVersion("grid") < "3.6") {

+            abort("Polygons with holes requires R 3.6 or above")

+        }

+        munched <- munched[order(munched$group, munched$subgroup), ]

+        id <- match(munched$subgroup, unique(munched$subgroup))

+        first_idx <- !duplicated(munched$group)

+        first_rows <- munched[first_idx, ]

+        if (gradient){

+            gradient.direction <- match.arg(gradient.direction, c("rt", "tr"))

+            rects <- lapply(split(munched, munched$group), function(row){

+                            fill <- grid::linearGradient(

+                                        x1 = first_rows$x.start,

+                                        x2 = first_rows$x.stop,

+                                        y1 = first_rows$y.start,

+                                        y2 = first_rows$y.stop,

+                                        default.units = "native",

+                                        colours = if (gradient.direction=="rt"){

+                                                     alpha(c(first_rows$fill, "white"), first_rows$alpha)

+                                                  }else{

+                                                     rev(alpha(c(first_rows$fill, "white"), first_rows$alpha))

+                                                  },

+                                        stops = seq(0, 1, length.out = gradient.length.out)

+                                    )

+                            grid::pathGrob(

+                                row$x, row$y, id = match(row$subgroup, unique(row$group)), 

+                                pathId = munched$group,

+                                rule = rule, default.units = "native",

+                                gp = gpar(col = first_rows$colour,

+                                          fill = fill,

+                                          lwd = first_rows$size * ggplot2:::.pt,