首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >将带填充头部的箭头添加到geom_label_repel绘制的ggplot

问将带填充头部的箭头添加到geom_label_repel绘制的ggplot
EN

Stack Overflow用户
提问于 2020-04-06 18:48:12
回答 1查看 917关注 0票数 6

我想通过使用geom_label_repel函数将一个带填充头部的箭头添加到一个ggplot对象中。我认为我可以像在geom_segment中一样使用:arrow.fill = 'black',但它在geom_label_repel中不起作用。这是另一种获取填充箭头的方法吗?

我之所以使用geom_label_repel,是因为它是我设法在标签边框处开始箭头的唯一方法。如果可以用另一种方式找到这个坐标,我可以使用geom_segment。

代码语言:javascript
复制
library(tidyverse)
library(ggrepel)

dmax <- iris %>%
  filter(Sepal.Length == max(Sepal.Length))

ggplot(data = iris, aes(x=Sepal.Width, y=Sepal.Length)) +
  geom_point() +
  geom_label_repel(data=dmax, aes(label = 'max'), 
                   box.padding = unit(.25, 'lines'), 
                   point.padding = unit(1.5, 'lines'), 
                   arrow = arrow(length = unit(0.25, 'cm'), type = 'closed')) +
  geom_segment(aes(x=3, xend=max(Sepal.Width), y=0, yend=max(Sepal.Width)), 
               arrow=arrow(length = unit(0.25, 'cm'), type = 'closed'), 
               arrow.fill = 'black')
EN

回答 1

Stack Overflow用户

发布于 2021-02-15 15:23:39

我们可以从GeomSegment$draw_panel中看到,geom_segment中的arrow.fill值被传递给grid::segmentsGrob中的fill参数。同样的修改也可以应用于ggrepel::geom_label_repel

代码语言:javascript
复制
ggplot(data = iris, 
       aes(x=Sepal.Width, y=Sepal.Length)) +
  geom_point() +
  geom_label_repel2(data=. %>% 
                      filter(Sepal.Length == max(Sepal.Length)), 
                    aes(label = 'max'), 
                    box.padding = unit(.25, 'lines'), 
                    point.padding = unit(1.5, 'lines'), 
                    arrow = arrow(length = unit(0.25, 'cm'), type = 'closed'),
                    arrow.fill = "green") +
  geom_segment(aes(x=3, xend=max(Sepal.Width), y=0, yend=max(Sepal.Width)), 
               arrow = arrow(length = unit(0.25, 'cm'), type = 'closed'), 
               arrow.fill = 'red')

​

​

修改ggproto对象& geom函数的代码:

代码语言:javascript
复制
GeomLabelRepel2 <- ggproto(
  "GeomLabelRepel2",
  GeomLabelRepel,
  draw_panel = function (self, data, panel_scales, coord, parse = FALSE, na.rm = FALSE, 
                         box.padding = 0.25, label.padding = 0.25, point.padding = 1e-06, 
                         label.r = 0.15, label.size = 0.25, segment.colour = NULL, 
                         segment.size = 0.5, segment.alpha = NULL, min.segment.length = 0.5, 
                         arrow = NULL, arrow.fill = NULL, # add arrow.fill parameter
                         force = 1, nudge_x = 0, nudge_y = 0, xlim = c(NA, NA), 
                         ylim = c(NA, NA), max.iter = 2000, direction = "both", seed = NA) 
  {
    lab <- data$label
    if (parse) {
      lab <- parse(text = as.character(lab))
    }
    if (!length(which(ggrepel:::not_empty(lab)))) {
      return()
    }
    nudges <- data.frame(x = data$x + nudge_x, y = data$y + nudge_y)
    nudges <- coord$transform(nudges, panel_scales)
    data <- coord$transform(data, panel_scales)
    nudges$x <- nudges$x - data$x
    nudges$y <- nudges$y - data$y
    limits <- data.frame(x = xlim, y = ylim)
    limits <- coord$transform(limits, panel_scales)
    limits$x[is.na(limits$x)] <- c(0, 1)[is.na(limits$x)]
    limits$y[is.na(limits$y)] <- c(0, 1)[is.na(limits$y)]
    if (is.character(data$vjust)) {
      data$vjust <- compute_just(data$vjust, data$y)
    }
    if (is.character(data$hjust)) {
      data$hjust <- compute_just(data$hjust, data$x)
    }
    if(is.null(arrow.fill)) { # define fill if arrow.fill is specified
      arrow.fill.gp <- grid::gpar()
    } else {
      arrow.fill.gp <- grid::gpar(fill = arrow.fill)
    }
    ggplot2:::ggname("geom_label_repel", 
                     grid::gTree(limits = limits, 
                                 data = data, 
                                 lab = lab, 
                                 nudges = nudges, 
                                 box.padding = ggrepel:::to_unit(box.padding), 
                                 label.padding = ggrepel:::to_unit(label.padding), 
                                 point.padding = ggrepel:::to_unit(point.padding), 
                                 label.r = ggrepel:::to_unit(label.r), 
                                 label.size = label.size, 
                                 segment.colour = segment.colour,
                                 segment.size = segment.size, 
                                 segment.alpha = segment.alpha, 
                                 min.segment.length = ggrepel:::to_unit(min.segment.length), 
                                 arrow = arrow, 
                                 gp = arrow.fill.gp, # add gp
                                 force = force, 
                                 max.iter = max.iter, 
                                 direction = direction, 
                                 seed = seed, 
                                 cl = "labelrepeltree"))
  }
)

geom_label_repel2 <- function (mapping = NULL, data = NULL, stat = "identity", 
                               position = "identity", parse = FALSE, ..., box.padding = 0.25, 
                               label.padding = 0.25, point.padding = 1e-06, label.r = 0.15, 
                               label.size = 0.25, segment.colour = NULL, segment.color = NULL, 
                               segment.size = 0.5, segment.alpha = NULL, min.segment.length = 0.5, 
                               arrow = NULL, arrow.fill = NULL, # add arrow.fill parameter
                               force = 1, max.iter = 2000, nudge_x = 0, nudge_y = 0, 
                               xlim = c(NA, NA), ylim = c(NA, NA), na.rm = FALSE, show.legend = NA, 
                               direction = c("both", "y", "x"), seed = NA, 
                               inherit.aes = TRUE) {
  if (!missing(nudge_x) || !missing(nudge_y)) {
    if (!missing(position)) {
      stop("Specify either `position` or `nudge_x`/`nudge_y`", 
           call. = FALSE)
    }
  }
  layer(data = data, mapping = mapping, stat = stat, geom = GeomLabelRepel2, # change geom
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(parse = parse, box.padding = ggrepel:::to_unit(box.padding), 
                      label.padding = ggrepel:::to_unit(label.padding), point.padding = ggrepel:::to_unit(point.padding), 
                      label.r = ggrepel:::to_unit(label.r), label.size = label.size, 
                      segment.colour = segment.color %||% segment.colour, 
                      segment.size = segment.size, segment.alpha = segment.alpha, 
                      min.segment.length = ggrepel:::to_unit(min.segment.length), 
                      arrow = arrow, arrow.fill = arrow.fill, # add arrow.fill parameter
                      na.rm = na.rm, force = force, max.iter = max.iter, 
                      nudge_x = nudge_x, nudge_y = nudge_y, xlim = xlim, 
                      ylim = ylim, direction = match.arg(direction), seed = seed, 
                      ...))
}
票数 3
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/61058046

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档