Question

我使用geom_label来绘制文字。默认情况下，标签（框）的宽度取决于文本的宽度。但是，我想要一个统一的标签大小。也就是说，我想要文本后面的矩形的固定大小，而不管字符串的长度。

我当前标签的示例，具有不同的大小，具体取决于字符串长度：

如何制作如下所示的标签：

我查看了geom_label github并且看起来并不好看，我想也许某种方式可以修改unit()，但我无法正常工作

对于一些可重现的代码：

library(ggplot2)
ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) +
geom_text(check_overlap = TRUE) +
geom_label(aes(fill= factor(cyl)))

您如何使所有标签尺寸相同？

Answer 1

如评论中所述：一种解决方法是使用空格填充标签。但是，此方法不适用于默认的比例字体。我们需要使用固定宽度（等宽字体）字体系列。

我使用stringi便利函数进行填充，但sprintf或朋友也可以。

library(stringi)
library(ggplot2)

z <- row.names(mtcars)
z2 <- stri_pad_both(z, width = max(stri_width(z)))
d <- data.frame(x = 1, y = 1:length(z2), z2)

ggplot(d, aes(x, y, label = z2)) + geom_label(family = "mono")

Answer 2

用空格填充数据并使用单声道系列字体对我来说看起来非常hacky。我调整了geom_label代码中的一些参数以生成我想要的内容：

代码看起来如何使用一些可重现的代码：

library(ggplot2)
ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) +
  geom_text(check_overlap = TRUE) +
  geom_label(aes(fill= factor(cyl)))

library(ggplot2)
library(grid)
ggname <- function (prefix, grob) {
  grob$name <- grobName(grob, prefix)
  grob
}

geom_label2 <- function(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) {
  if (!missing(nudge_x) || !missing(nudge_y)) {
    if (!missing(position)) {
      stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE)
    }

    position <- position_nudge(nudge_x, nudge_y)
  }

  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomLabel2,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      parse = parse,
      label.padding = label.padding,
      label.r = label.r,
      label.size = label.size,
      na.rm = na.rm,
      ...
    )
  )
}

GeomLabel2 <- ggproto("GeomLabel2", Geom,
                     required_aes = c("x", "y", "label"),

                     default_aes = aes(
                       colour = "black", fill = "white", size = 3.88, angle = 0,
                       hjust = 0.5, vjust = 0.5, alpha = NA, family = "", fontface = 1,
                       lineheight = 1.2
                     ),

                     draw_panel = function(self, data, panel_params, coord, parse = FALSE,
                                           na.rm = FALSE,
                                           label.padding = unit(0.25, "lines"),
                                           label.r = unit(0.15, "lines"),
                                           label.size = 0.25) {
                       lab <- data$label
                       if (parse) {
                         lab <- parse(text = as.character(lab))
                       }

                       data <- coord$transform(data, panel_params)
                       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)
                       }

                       grobs <- lapply(1:nrow(data), function(i) {
                         row <- data[i, , drop = FALSE]
                         labelGrob2(lab[i],
                                   x = unit(row$x, "native"),
                                   y = unit(row$y, "native"),
                                   just = "center",
                                   padding = label.padding,
                                   r = label.r,
                                   text.gp = gpar(
                                     col = row$colour,
                                     fontsize = row$size * .pt,
                                     fontfamily = row$family,
                                     fontface = row$fontface,
                                     lineheight = row$lineheight
                                   ),
                                   rect.gp = gpar(
                                     col = row$colour,
                                     fill = alpha(row$fill, row$alpha),
                                     lwd = label.size * .pt
                                   )
                         )
                       })
                       class(grobs) <- "gList"

                       ggname("geom_label", grobTree(children = grobs))
                     },

                     draw_key = draw_key_label
)

labelGrob2 <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"),
                      just = "center", padding = unit(0.25, "lines"), r = unit(0.1, "snpc"),
                      default.units = "npc", name = NULL,
                      text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) {

  stopifnot(length(label) == 1)

  if (!is.unit(x))
    x <- unit(x, default.units)
  if (!is.unit(y))
    y <- unit(y, default.units)

  gTree(label = label, x = x, y = y, just = just, padding = padding, r = r,
        name = name, text.gp = text.gp, rect.gp = rect.gp, vp = vp, cl = "labelgrob2")
}

makeContent.labelgrob2 <- function(x) {
  hj <- resolveHJust(x$just, NULL)
  vj <- resolveVJust(x$just, NULL)

  t <- textGrob(
    x$label,
    x$x + 1 * (0.55 - hj) * unit(5, "mm"),
    x$y + 2 * (0.55 - vj) * x$padding,
    just = "center",
    gp = x$text.gp,
    name = "text"
  )

  r <- roundrectGrob(x$x, x$y, default.units = "native",
                     width =  1.5 * unit(max(stri_width(x$x)) + 1, "mm"),
                     height = grobHeight(t) + 2 * x$padding,
                     just = c(hj, vj),
                     r = x$r,
                     gp = x$rect.gp,
                     name = "box"
  )

  setChildren(x, gList(r, t))
}

ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) +
  geom_text(check_overlap = TRUE) +
  geom_label2(aes(fill= factor(cyl)))

如何在ggplot的geom_label中设置标准标签大小？

2 个答案: