@@ -7,6 +7,8 @@ vignettes/.DS_Store

 __init__.py

 __pycache__

 __init__.pyc

-.Rproj.user

+*.Rproj.user

+*.RData

+*.ignore

+.web_cache

 ggtree.Rproj

-.RData

@@ -3,3 +3,7 @@ Justin Silverman

 + `geom_balance`

 	- <https://github.com/GuangchuangYu/ggtree/pull/64>

+JustGitting

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

++ `Add daylight layout for unrooted trees`

+  - <https://github.com/GuangchuangYu/ggtree/pull/124>

\ No newline at end of file

@@ -43,4 +43,4 @@ BugReports: https://github.com/GuangchuangYu/ggtree/issues

 Packaged: 2014-12-03 08:16:14 UTC; root

 biocViews: Alignment, Annotation, Clustering, DataImport,

     MultipleSequenceAlignment, ReproducibleResearch, Software, Visualization

-RoxygenNote: 5.0.1

+RoxygenNote: 6.0.1

@@ -27,6 +27,7 @@ export("%<+%")

 export("%>%")

 export(.)

 export(Date2decimal)

+export(GeomHilight)

 export(MRCA)

 export(StatBalance)

 export(StatHilight)

@@ -44,7 +45,9 @@ export(flip)

 export(geom_aline)

 export(geom_balance)

 export(geom_cladelabel)

+export(geom_cladelabel2)

 export(geom_hilight)

+export(geom_hilight_encircle)

 export(geom_label2)

 export(geom_nodepoint)

 export(geom_point2)

@@ -87,6 +90,7 @@ export(scaleClade)

 export(scale_color)

 export(scale_x_ggtree)

 export(stat_balance)

+export(stat_chull)

 export(stat_hilight)

 export(subview)

 export(theme_inset)

@@ -109,6 +113,7 @@ importFrom(ape,ladderize)

 importFrom(ape,read.tree)

 importFrom(ape,reorder.phylo)

 importFrom(ape,write.tree)

+importFrom(ggplot2,Geom)

 importFrom(ggplot2,GeomCurve)

 importFrom(ggplot2,GeomLabel)

 importFrom(ggplot2,GeomPoint)

new file mode 100644

@@ -0,0 +1 @@

+stat_chull.R

@@ -38,13 +38,20 @@ getMRCA.df <- function(data, tip) {

 }

-getMRCA.df_internal <- function(data, tip1, tip2) {

-    node1 <- which(tip1 == data$label | tip1 == data[, "node"])

-    node2 <- which(tip2 == data$label | tip2 == data[, "node"])

+getMRCA.df_internal <- function(data, tip, anc) {

+    node1 <- which(tip == data$label | tip == data[, "node"])

+    node2 <- which(anc == data$label | anc == data[, "node"])

     anc1 <- get.ancestor.df(data, node1)

     anc2 <- get.ancestor.df(data, node2)

+    if(is.null(anc1)){

+      print("Warning getMRCA.df_internal(): tip is root")

+    }else if(is.null(anc1)){

+      print("Warning getMRCA.df_internal(): anc is root")

+    }

+    

+    # Return common ancestors.

     intersect(c(node1, anc1), c(node2, anc2))[1]

 }

@@ -53,7 +60,9 @@ get.ancestor.df <- function(df, node) {

     pp <- getParent.df(df, node)

     pp <- pp[pp != 0]

     if (length(pp) == 0) {

-        stop("input node is root...")

+      #stop("input node is root...")

+      cat("WARNING: input node ",node," is root.")

+      return(NULL) # root has no ancestor

     }

     i <- 1

     while(i <= length(pp)) {

@@ -94,18 +94,18 @@ geom_cladelabel <- function(node, label, offset=0, offset.text=0,

                                         inherit.aes = inherit.aes, na.rm=na.rm,

                                         parse = parse, ...)

         }

-

-        layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,

-                                   size=barsize, color = barcolor,

-                                   mapping=mapping, data=data,

-                                   position=position, show.legend = show.legend,

-                                   inherit.aes = inherit.aes, na.rm=na.rm, ...)

-

+      

+      layer_bar <- stat_cladeBar(node=node, offset=offset, align=align,

+                                 size=barsize, color = barcolor,

+                                 mapping=mapping, data=data,

+                                 position=position, show.legend = show.legend,

+                                 inherit.aes = inherit.aes, na.rm=na.rm, ...)

+      

     }

-

+    

     list(

-       layer_bar,

-       layer_text

+      layer_bar,

+      layer_text

     )

 }

@@ -115,99 +115,100 @@ stat_cladeText <- function(mapping=NULL, data=NULL,

                            node, label, offset, align, ...,

                            show.legend=NA, inherit.aes=FALSE,

                            na.rm=FALSE, parse=FALSE) {

-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)

-    if (is.null(mapping)) {

-        mapping <- default_aes

-    } else {

-        mapping <- modifyList(mapping, default_aes)

-    }

-

-    layer(stat=StatCladeText,

-          data=data,

-          mapping=mapping,

-          geom=geom,

-          position=position,

-          show.legend = show.legend,

-          inherit.aes = inherit.aes,

-          params=list(node=node,

-                      label  = label,

-                      offset = offset,

-                      align  = align,

-                      na.rm  = na.rm,

-                      parse  = parse,

-                      ...),

-          check.aes = FALSE

-          )

-

+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)

+  if (is.null(mapping)) {

+    mapping <- default_aes

+  } else {

+    mapping <- modifyList(mapping, default_aes)

+  }

+  

+  layer(stat=StatCladeText,

+        data=data,

+        mapping=mapping,

+        geom=geom,

+        position=position,

+        show.legend = show.legend,

+        inherit.aes = inherit.aes,

+        params=list(node=node,

+                    label  = label,

+                    offset = offset,

+                    align  = align,

+                    na.rm  = na.rm,

+                    parse  = parse,

+                    ...),

+        check.aes = FALSE

+  )

+  

 }

 stat_cladeBar <- function(mapping=NULL, data=NULL,

                           geom="segment", position="identity",

                           node, offset, align,  ...,

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

-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)

-    if (is.null(mapping)) {

-        mapping <- default_aes

-    } else {

-        mapping <- modifyList(mapping, default_aes)

-    }

-

-    layer(stat=StatCladeBar,

-          data=data,

-          mapping=mapping,

-          geom=geom,

-          position=position,

-          show.legend = show.legend,

-          inherit.aes = inherit.aes,

-          params=list(node=node,

-                      offset=offset,

-                      align=align,

-                      na.rm=na.rm,

-                      ...),

-          check.aes = FALSE

-          )

+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)

+  if (is.null(mapping)) {

+    mapping <- default_aes

+  } else {

+    mapping <- modifyList(mapping, default_aes)

+  }

+  

+  layer(stat=StatCladeBar,

+        data=data,

+        mapping=mapping,

+        geom=geom,

+        position=position,

+        show.legend = show.legend,

+        inherit.aes = inherit.aes,

+        params=list(node=node,

+                    offset=offset,

+                    align=align,

+                    na.rm=na.rm,

+                    ...),

+        check.aes = FALSE

+  )

 }

 StatCladeText <- ggproto("StatCladeText", Stat,

                          compute_group = function(self, data, scales, params, node, label, offset, align) {

-                             df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03)

-                             df$y <- mean(c(df$y, df$yend))

-                             df$label <- label

-                             return(df)

+                           df <- get_cladelabel_position(data, node, offset, align, adjustRatio = 1.03)

+                           df$y <- mean(c(df$y, df$yend))

+                           df$label <- label

+                           return(df)

                          },

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

-                         )

+)

 StatCladeBar <- ggproto("StatCladBar", Stat,

                         compute_group = function(self, data, scales, params, node, offset, align) {

-                            get_cladelabel_position(data, node, offset, align, adjustRatio=1.02)

+                          get_cladelabel_position(data, node, offset, align, adjustRatio=1.02)

                         },

                         required_aes = c("x", "y", "xend", "yend")

-                        )

+)

 get_cladelabel_position <- function(data, node, offset, align, adjustRatio) {

-    df <- get_cladelabel_position_(data, node)

-    if (align) {

-        mx <- max(data$x, na.rm=TRUE)

-    } else {

-        mx <- df$x

-    }

-    mx <- mx * adjustRatio + offset

-    data.frame(x=mx, xend=mx, y=df$y, yend=df$yend)

+  df <- get_cladelabel_position_(data, node)

+  if (align) {

+    # Find max x value for all tree nodes so all clade labels align to same position.

+    mx <- max(data$x, na.rm=TRUE)

+  } else {

+    mx <- df$x

+  }

+  mx <- mx * adjustRatio + offset

+  data.frame(x=mx, xend=mx, y=df$y, yend=df$yend)

 }

-

+# get x, y and yend of clade region.

 get_cladelabel_position_ <- function(data, node) {

-    sp <- get.offspring.df(data, node)

-    sp2 <- c(sp, node)

-    sp.df <- data[match(sp2, data$node),]

-

-    y <- sp.df$y

-    y <- y[!is.na(y)]

-    mx <- max(sp.df$x, na.rm=TRUE)

-    data.frame(x=mx, y=min(y), yend=max(y))

+  sp <- get.offspring.df(data, node)

+  sp2 <- c(sp, node)

+  sp.df <- data[match(sp2, data$node),]

+  

+  y <- sp.df$y

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

+  mx <- max(sp.df$x, na.rm=TRUE)

+  data.frame(x=mx, y=min(y), yend=max(y))

 }

new file mode 100644

@@ -0,0 +1,321 @@

+##' annotate a clade with bar and text label

+##'

+##'

+##' @title geom_cladelabel2

+##' @param node selected node

+##' @param label clade label

+##' @param offset offset of bar and text from the clade

+##' @param offset.text offset of text from bar

+##' @param offset.bar offset of bar from text

+##' @param align logical 

+##' @param barsize size of bar

+##' @param fontsize font size of text

+##' @param angle angle of text

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

+##' @param hjust justify text horizontally

+##' @param color color for clade & label, of length 1 or 2

+##' @param fill fill label background, only work with geom='label'

+##' @param family sans by default, can be any supported font

+##' @param parse logical, whether parse label

+##' @param ... additional parameter

+##' @return ggplot layers

+##' @export

+##' @author JustGitting

+geom_cladelabel2 <- function(node, label, offset=0, offset.text=0, offset.bar=0,

+                            align=FALSE, barsize=0.5, fontsize=3.88, hjust = 0,

+                            geom="text",

+                            color = NULL,

+                            family="sans", parse=FALSE, ...) {

+    mapping <- NULL

+    data <- NULL

+    position <- "identity"

+    show.legend <- NA

+    na.rm <- TRUE

+    inherit.aes <- FALSE

+

+    

+    # create custom arguments from ellipsis (aka '...') for stat_cladeText2 depending on geom type

+    

+    # http://ggplot2.tidyverse.org/reference/geom_text.html 

+    # geom_label(mapping = NULL, data = NULL, stat = "identity",

+    #            position = "identity", ..., 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 = FALSE, show.legend = NA,

+    #            inherit.aes = TRUE)

+    # 

+    # geom_text(mapping = NULL, data = NULL, stat = "identity",

+    #           position = "identity", ..., parse = FALSE, nudge_x = 0, nudge_y = 0,

+    #           check_overlap = FALSE, na.rm = FALSE, show.legend = NA,

+    #           inherit.aes = TRUE)

+    #

+    # Aesthetics: x, y, label, alpha, angle, colour, family, fontface, group, hjust, lineheight, size, vjust

+    

+    # http://ggplot2.tidyverse.org/reference/geom_segment.html

+    # geom_curve(mapping = NULL, data = NULL, stat = "identity",

+    #            position = "identity", ..., curvature = 0.5, angle = 90, ncp = 5,

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

+    #            inherit.aes = TRUE)

+    #

+    # Aesthetics:  x, y, xend, yend, alpha, colour, group, linetype, size

+    

+    # name_mapping = list('oldA'='newA', 'oldB'='newB')

+    # data_list = list(oldB=1, oldA=2)

+    # names(data_list) = name_mapping[match(names(data_list), names(name_mapping))]

+    

+    arg_list_geom_label <- c( "nudge_x", "nudge_y", "label.padding", "label.r", "label.size", 

+                              "alpha", "angle", "fontface", "group", "lineheight", "size", "vjust", "fill")

+    

+    arg_list_geom_text <- c( "nudge_x", "nudge_y", "check_overlap", 

+                             "alpha", "angle", "fontface", "group", "lineheight", "size", "vjust")

+    

+    # ignore angle

+    arg_list_geom_curve <- c( "curvature", "ncp", "arrow", "lineend", 

+                              "alpha", "group", "linetype")

+    

+    

+    # Parse ellipsis to collect parameters for geom_text or geom_label

+    ellipsis <- list(...)

+    if (geom == "text") {

+      args_stat_cladeText2 <- ellipsis[names(ellipsis) %in% arg_list_geom_text]  

+    } else {

+      args_stat_cladeText2 <- ellipsis[names(ellipsis) %in% arg_list_geom_label]

+    }

+    

+    if (parse == 'emoji') {

+      emoji <- get_fun_from_pkg("emojifont", "emoji")

+      label <- emoji(label)

+      parse <- FALSE

+      family <- "EmojiOne"

+    }

+    

+    

+    # add parameters to stat_cladeText2 options.

+    args_stat_cladeText2$node        <- node

+    args_stat_cladeText2$label       <- label

+    args_stat_cladeText2$offset      <- offset+offset.text

+    args_stat_cladeText2$align       <- align

+    args_stat_cladeText2$hjust       <- hjust

+    args_stat_cladeText2$size        <- fontsize

+    args_stat_cladeText2$family      <- family

+    args_stat_cladeText2$mapping     <- mapping

+    args_stat_cladeText2$data        <- data

+    args_stat_cladeText2$geom        <- geom 

+    args_stat_cladeText2$position    <- position

+    args_stat_cladeText2$show.legend <- show.legend

+    args_stat_cladeText2$inherit.aes <- inherit.aes 

+    args_stat_cladeText2$na.rm       <- na.rm

+    args_stat_cladeText2$parse       <- parse 

+    

+    # create arg list of stat_cladeBar2.

+    args_stat_cladeBar2 <- ellipsis[names(ellipsis) %in% arg_list_geom_curve]

+    

+    args_stat_cladeBar2$size        <- barsize

+    args_stat_cladeBar2$node        <- node

+    args_stat_cladeBar2$offset      <- offset+offset.bar

+    args_stat_cladeBar2$align       <- align

+    args_stat_cladeBar2$size        <- barsize

+    args_stat_cladeBar2$mapping     <- mapping

+    args_stat_cladeBar2$data        <- data

+    args_stat_cladeBar2$position    <- position

+    args_stat_cladeBar2$show.legend <- show.legend

+    args_stat_cladeBar2$inherit.aes <- inherit.aes

+    args_stat_cladeBar2$na.rm       <- na.rm

+    

+    

+    if (!is.null(color)) {

+        if (length(color) > 2) {

+          stop("color should be of length 1 or 2")

+        }

+        if (length(color) == 0) {

+          color = NULL

+        } else if (length(color) == 1) {

+          args_stat_cladeText2$colour <- color

+          args_stat_cladeBar2$colour <- color

+        } else {

+          args_stat_cladeText2$colour <- color[1]

+          args_stat_cladeBar2$colour <- color[2]

+        }

+    }

+    

+    # print('text opts') # Debug

+    # print(args_stat_cladeText2) # Debug

+    # print('bar opts') # Debug

+    # print(args_stat_cladeBar2) # Debug

+

+    # create text and bar layers.

+    layer_text <- do.call(stat_cladeText2, args_stat_cladeText2)

+    layer_bar <- do.call(stat_cladeBar2, args_stat_cladeBar2)

+

+    list(

+      layer_bar,

+      layer_text

+    )

+}

+

+# Display label at middle angle of clade subtree arc.

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

+                            geom="text", position="identity",

+                            node, label, offset, align, ...,

+                            show.legend=NA, inherit.aes=FALSE,

+                            na.rm=FALSE, parse=FALSE) {

+  # columns from ggplot data data.frame.

+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent)

+  if (is.null(mapping)) {

+    mapping <- default_aes

+  } else {

+    mapping <- modifyList(mapping, default_aes)

+  }

+  

+  layer(stat=StatCladeText2,

+        data=data,

+        mapping=mapping,

+        geom=geom,

+        position=position,

+        show.legend = show.legend,

+        inherit.aes = inherit.aes,

+        check.aes = FALSE,

+        params=list(node=node,

+                    label  = label,

+                    offset = offset,

+                    align  = align,

+                    na.rm  = na.rm,

+                    parse  = parse,

+                    ...)

+        

+  )

+  

+}

+      

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

+                           geom="curve", position="identity",

+                           node, offset, align, ...,

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

+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, xend=~x, yend=~y)

+  if (is.null(mapping)) {

+    mapping <- default_aes 

+  } else {

+    mapping <- modifyList(mapping, default_aes)

+  }

+  

+  layer(stat=StatCladeBar2,

+        data=data,

+        mapping=mapping, 

+        geom=geom,

+        position=position,

+        show.legend = show.legend,

+        inherit.aes = inherit.aes,

+        check.aes = FALSE,

+        params=list(node=node,

+                    offset=offset,

+                    align=align,

+                    na.rm=na.rm,

+                    ...)

+        

+  )

+}

+

+StatCladeText2 <- ggproto("StatCladeText2", Stat,

+                          

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

+

+                          compute_group = function(self, data, scales, params = NULL, node, label, offset, align) {

+                            df <- get_cladelabel2_position_label(data, node, offset, align, adjustRatio = 1.2)

+

+                            # computer_group does not need to return df$label as label is declared in the geom_cladelabel2() function.

+                            # The data.frame returned by computer_group() does not override the variables explicitly specified in the geom_cladelabel2()

+                            # df$label <- label 

+                            

+                            if(is.null(params$angle)){

+                              df$angle <- df$theta_label * 180

+                              if( df$angle > 90 & df$angle < 270){

+                                # add 180 to angle so label is easy to ready

+                                df$angle <- df$angle + 180

+                              }

+                            }

+                          

+                            return(df)

+                          }

+)

+

+StatCladeBar2 <- ggproto("StatCladeBar2", Stat,

+                        

+                        required_aes = c("x", "y", "xend", "yend"),

+                        

+                        compute_group = function(self, data, scales, params, node, offset, align) {

+                          df <- get_cladelabel2_position_bar(data, node, offset, align, adjustRatio=1.1)

+                          return(df)

+                        }

+)

+

+get_cladelabel2_position_label <- function(data, node, offset, align, adjustRatio) {

+  df <- get_cladelabel2_position_(data, node)

+  

+  if (align) {

+    # Find max radius from tree root.

+    r <- max(getNodeEuclDistances(data, getRoot.df(data)))

+  } else {

+    r <- df$r

+  }

+  

+  r <- r * adjustRatio + offset

+  

+  # Calculate the angle between theta_left and theta_right

+  delta <- df$theta_left - df$theta_right

+  

+  if(delta > 0){

+    theta_label <- delta/2 + df$theta_right

+  }else if(delta < 0){

+    delta_adj <- delta + 2

+    theta_label <- delta_adj/2 + df$theta_right

+  }else{

+    theta_label <- df$theta_left

+  }

+  

+  # correct if theta_label > 360

+  if(theta_label > 2){

+    theta_label <-  theta_label - 2 

+  }

+  

+  # Calculate the position of the label

+  x1 <- r*cospi(theta_label) + data[data$node==node, 'x']

+  y1 <- r*sinpi(theta_label) + data[data$node==node, 'y']

+  

+  data.frame(x=x1, y=y1, theta_label=theta_label)

+  

+}

+

+

+get_cladelabel2_position_bar <- function(data, node, offset, align, adjustRatio) {

+  df <- get_cladelabel2_position_(data, node)

+

+  if (align) {

+    # Find max radius from tree root.

+    r <- max(getNodeEuclDistances(data, getRoot.df(data)))

+  } else {

+    r <- df$r

+  }

+

+  r <- r * adjustRatio + offset

+

+  # Calculate the left(end) and right(start) points for the arc

+  x1 <- r*cospi(df$theta_right) + data[data$node==node, 'x']

+  y1 <- r*sinpi(df$theta_right) + data[data$node==node, 'y']

+  xend <- r*cospi(df$theta_left) + data[data$node==node, 'x']

+  yend <- r*sinpi(df$theta_left) + data[data$node==node, 'y']

+  

+  data.frame(x=x1, y=y1, xend=xend, yend=yend)  

+

+}

+

+# Get clade subtree arc angles and maximum radius from clade node to all other clade nodes.

+get_cladelabel2_position_ <- function(data, node) {

+  # get left and right angles of the clade subtree.

+  subtree <- list( subtree = getSubtree.df(data, node), node = node )

+  

+  arc <- getTreeArcAngles(data, node, subtree)

+  # get max distance from node to clade tips.

+  r <- max(getNodeEuclDistances(data[data$node %in% subtree$subtree,], node))

+  

+  data.frame(r=r, theta_left=as.numeric(arc['left']), theta_right=as.numeric(arc['right']))

+}

+

@@ -1,52 +1,51 @@

 ##' layer of hilight clade with rectangle

 ##'

-##'

 ##' @title geom_hilight

-##' @param node selected node to hilight

-##' @param fill color fill

-##' @param alpha alpha (transparency)

-##' @param extend extend xmax of the rectangle

-##' @param extendto extend xmax to extendto

+##' @param node selected node to hilight (required)

+##' @param fill color fill (default = steelblue)

+##' @param alpha alpha transparency, (default = 0.5)

+##' @param extend extend xmax of the rectangle (default = 0)

+##' @param extendto extend xmax to extendto (default = NULL)

 ##' @return ggplot2

 ##' @export

 ##' @importFrom ggplot2 aes_

 ##' @importFrom ggplot2 GeomRect

 ##' @author Guangchuang Yu

 geom_hilight <- function(node, fill="steelblue", alpha=.5, extend=0, extendto=NULL) {

-

-

-    data = NULL

-    stat = "hilight"

-    position = "identity"

-    show.legend = NA

-    na.rm = TRUE

-    inherit.aes = FALSE

-

-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)

-    mapping <- default_aes

-

-

-    layer(

-        stat=StatHilight,

-        data = data,

-        mapping = mapping,

-        geom = GeomRect,

-        position = position,

-        show.legend=show.legend,

-        inherit.aes = inherit.aes,

-        params = list(node=node,

-                      fill=fill,

-                      alpha=alpha,

-                      extend=extend,

-                      extendto=extendto,

-                      na.rm = na.rm),

-        check.aes = FALSE

-    )

+  

+  data = NULL

+  stat = "hilight"

+  position = "identity"

+  show.legend = NA

+  na.rm = TRUE

+  inherit.aes = FALSE

+  check.aes = FALSE

+  

+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)

+  mapping <- default_aes

+  

+  l <- layer(

+    stat=StatHilight,

+    data = data,

+    mapping = mapping,

+    geom = GeomRect,

+    position = position,

+    show.legend=show.legend,

+    inherit.aes = inherit.aes,

+    check.aes = check.aes,

+    params = list(node=node,

+                  fill=fill,

+                  alpha=alpha,

+                  extend=extend,

+                  extendto=extendto,

+                  na.rm = na.rm)

+  )

+  

+  return(l)

 }

 ##' stat_hilight

 ##'

-##'

 ##' @title stat_hilight

 ##' @param mapping aes mapping

 ##' @param data data

@@ -68,28 +67,30 @@ stat_hilight <- function(mapping=NULL, data=NULL, geom="rect",

                          show.legend=NA, inherit.aes=FALSE,

                          fill, alpha, extend=0, extendto=NULL,

                          ...) {

-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)

-    if (is.null(mapping)) {

-        mapping <- default_aes

-    } else {

-        mapping <- modifyList(mapping, default_aes)

-    }

-

-    layer(

-        stat=StatHilight,

-        data = data,

-        mapping = mapping,

-        geom = geom,

-        position = position,

-        show.legend=show.legend,

-        inherit.aes = inherit.aes,

-        params = list(node=node,

-                      fill=fill,

-                      alpha=alpha,

-                      extend=extend,

-                      extendto=extendto,

-                      ...)

-        )

+  

+  default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)

+  

+  if (is.null(mapping)) {

+    mapping <- default_aes

+  } else {

+    mapping <- modifyList(mapping, default_aes)

+  }

+  

+  layer(

+    stat=StatHilight,

+    data = data,

+    mapping = mapping,

+    geom = geom,

+    position = position,

+    show.legend=show.legend,

+    inherit.aes = inherit.aes,

+    params = list(node=node,

+                  fill=fill,

+                  alpha=alpha,

+                  extend=extend,

+                  extendto=extendto,

+                  ...)

+  )

 }

 ##' StatHilight

@@ -100,19 +101,20 @@ stat_hilight <- function(mapping=NULL, data=NULL, geom="rect",

 ##' @export

 StatHilight <- ggproto("StatHilight", Stat,

                        compute_group = function(self, data, scales, params, node, extend, extendto) {

-                           df <- get_clade_position_(data, node)

-                           df$xmax <- df$xmax + extend

-                           if (!is.null(extendto) && !is.na(extendto)) {

-                               if (extendto < df$xmax) {

-                                   warning("extendto is too small, keep the original xmax value...")

-                               } else {

-                                   df$xmax <- extendto

-                               }

+                         

+                         df <- get_clade_position_(data, node)

+                         df$xmax <- df$xmax + extend

+                         if (!is.null(extendto) && !is.na(extendto)) {

+                           if (extendto < df$xmax) {

+                             warning("extendto is too small, keep the original xmax value...")

+                           } else {

+                             df$xmax <- extendto

                            }

-                           return(df)

+                         }

+                         return(df)

                        },

                        required_aes = c("x", "y", "branch.length")

-                       )

+)

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

@@ -125,31 +127,31 @@ StatHilight <- ggproto("StatHilight", Stat,

 ##' @export

 ##' @author Guangchuang Yu

 get_clade_position <- function(treeview, node) {

-    get_clade_position_(treeview$data, node)

+  get_clade_position_(treeview$data, node)

 }

 get_clade_position_ <- function(data, node) {

-    sp <- tryCatch(get.offspring.df(data, node), error=function(e) NULL)

-

-    i <- match(node, data$node)

-    if (is.null(sp)) {

-        ## tip

-        sp.df <- data[i,]

-    } else {

-        sp <- c(sp, node)

-        sp.df <- data[match(sp, data$node),]

-    }

-

-    x <- sp.df$x

-    y <- sp.df$y

-

-    if ("branch.length" %in% colnames(data)) {

-        xmin <- min(x)-data[i, "branch.length"]/2

-    } else {

-        xmin <- min(sp.df$branch)

-    }

-    data.frame(xmin=xmin,

-               xmax=max(x),

-               ymin=min(y)-0.5,

-               ymax=max(y)+0.5)

+  sp <- tryCatch(get.offspring.df(data, node), error=function(e) NULL)

+  

+  i <- match(node, data$node)

+  if (is.null(sp)) {

+    ## tip

+    sp.df <- data[i,]