是否可以仅更改 1 个方面标题的对齐方式

Question

假设我有一个像这样的多面 ggplot：

data(iris)
ggplot(iris, aes(x = Petal.Width, y = Sepal.Length)) +
  facet_grid(. ~ Species) +
  geom_point()

题：

是否可以仅将第一个方面标签（“setosa”）与左侧对齐，但将其他方面保持在中央？

我对直接没有任何运气ggplot，所以我尝试转换为 gtable（下面的代码），我可以看到我可能需要修改的元素是 tableGrb #13 - strip-t-1，但我不确定怎么做。我尝试将gt$layout$l和gt$layout$r值更改为 4（原为 5），但这会将标题完全移出构面。

pl <- ggplot(iris, aes(x = Petal.Width, y = Sepal.Length)) +
  facet_grid(. ~ Species) +
  geom_point()
gt <- ggplotGrob(pl)

gt$layout[gt$layout$name == 'strip-t-1', c('l', 'r')] <- c(4, 4) # my attempt
grid.newpage()
grid.draw(gt)

有谁知道这是否可能？

Answer 1

你有正确的想法，但不是正确的地点。基本上你需要做这样的事情：

library('ggplot2')
library('grid')

data(iris)
pl <- ggplot(iris, aes(x = Petal.Width, y = Sepal.Length)) +
  facet_grid(. ~ Species) +
  geom_point()
gt <- ggplotGrob(pl)

gt$grobs[[13]]$grobs[[1]]$children$strip.text.x.top..titleGrob.186$children$GRID.text.184$x <- unit(0.1, 'npc')
grid.newpage()
grid.draw(gt)

但是，这对你是行不通的......它甚至不会为我工作以来的第二次titleGrob.xxx和GRID.text.xxx每次使用时间而改变gt <- ggplotGrob(pl)

因此，请尝试不同的方法并了解您所指出的需要编辑的位置（在第一个中strip）：

gp <- ggplotGrob(pl)
grid.ls(grid.force(gp))

# layout
#   background.1-13-13-1
#   panel-1-1.8-5-8-5
# ...
#   strip-t-1.7-5-7-5                        <- here
#     strip.1-1-1-1
#       strip.background.x..rect.533
#       strip.text.x.top..titleGrob.525
#         GRID.text.523
#   strip-t-2.7-7-7-7
#     strip.1-1-1-1
#       strip.background.x..rect.533
#       strip.text.x.top..titleGrob.528
#         GRID.text.526
#   strip-t-3.7-9-7-9
#     strip.1-1-1-1
#       strip.background.x..rect.533
#       strip.text.x.top..titleGrob.531
#         GRID.text.529
#   axis-t-1.6-5-6-5
# ...
#   title.3-9-3-5
#   caption.11-9-11-5
#   tag.2-2-2-2

您可以使用gPath来获取路径而无需GRID.text.xxx事先知道。请注意，在您的示例中，我们可以只编辑第一个GRID.text，如果global = FALSE，即如果global = TRUE，所有这些都会更改，它就会起作用。

g1 <- editGrob(
  grid.force(gp),
  gPath('GRID.text'), grep = TRUE, global = FALSE,
  x = unit(0.25, 'npc')
)
grid.newpage()
grid.draw(g1)

但是，您可能需要一个非常具体的路径，所以请按照strip-t-1您的GRID.text（注意，global = TRUE它只影响一个条带）

g2 <- editGrob(
  grid.force(gp),
  gPath('strip-t-1', 'strip', 'strip', 'GRID.text'), grep = TRUE, global = TRUE,
  x = unit(0.75, 'npc')
)
grid.newpage()
grid.draw(g2)

Answer 2

这是最终 ggtext 包应该能够以一般方式完成的事情，但截至目前，它的 HTML 渲染代码太有限了。一个新的渲染引擎正在开发中，它支持更多的 CSS，包括 CSS 选择器，这使得以通用方式将格式设置为特定数据值成为可能。它还支持text-align左对齐文本所需的属性。

以下是有关如何工作的两个示例。一旦新的渲染引擎集成到 ggtext 中，您将不再需要辅助代码。

# packages needed
library(ggplot2)
library(dplyr)
library(glue)
library(rlang)
library(sinab)  # remotes::install_github("clauswilke/sinab")

# helper code that will eventually live in the ggtext package
element_html <- function(css = NULL, family = NULL, face = NULL, size = NULL, colour = NULL, fill = NULL,
                         linetype = NULL, linewidth = NULL, hjust = NULL, vjust = NULL, lineheight = NULL,
                         margin = NULL, width = NULL, height = NULL, color = NULL, 
                         debug = FALSE, inherit.blank = FALSE) {
  if (!is.null(color))
    colour <- color
  
  # doesn't work with other values at this time
  hjust <- 0
  vjust <- 1
  
  structure(
    list(
      css = css,
      family = family, face = face, size = size, colour = colour, fill = fill,
      linetype = linetype, linewidth = linewidth, hjust = hjust, vjust = vjust,
      lineheight = lineheight, margin = margin, width = width, height = height,
      debug = debug, inherit.blank = inherit.blank),
    class = c("element_html", "element_text", "element")
  )
}

element_grob.element_html <- function(element, label = "", x = NULL, y = NULL,
                                      family = NULL, face = NULL, colour = NULL, size = NULL,
                                      hjust = NULL, vjust = NULL, lineheight = NULL,
                                      margin = NULL, ...) {
  if (is.null(label))
    return(ggplot2::zeroGrob())
  
  # for now we ignore hjust and vjust, it doesn't work yet
  hj <- 0
  vj <- 1
  
  css <- element$css %||% ""
  
  html_grob(
    label, x = x, y = y, hjust = hj, vjust = vj,
    width = element$width, height = element$height,
    css = css
  )
}


# CSS styling
css <- '
p { text-align: center; padding-top: 2px; }
.setosa { text-align: left; }
'

# plotting code
iris %>%
  mutate(
    # set class attribute to species name
    facet_label = glue('<p class = "{Species}">{Species}</p>')
  ) %>%
  ggplot(aes(x = Petal.Width, y = Sepal.Length)) +
  facet_grid(. ~ facet_label) +
  geom_point() +
  theme(strip.text = element_html(css = css))

# another example with different styling
css <- '
p { text-align: center; padding-top: 2px; font-style: italic; }
.setosa { background-color: #0072B2; color: white; }
.versicolor { background-color: #E69F00; }
.virginica { background-color: #009E73;  color: white; }
'

# plotting code
iris %>%
  mutate(
    # set class attribute to species name
    facet_label = glue('<p class = "{Species}">I. {Species}</p>')
  ) %>%
  ggplot(aes(x = Petal.Width, y = Sepal.Length, color = Species)) +
  facet_grid(. ~ facet_label) +
  geom_point() +
  scale_color_manual(
    values = c(
      setosa = "#0072B2", versicolor = "#E69F00", virginica = "#009E73"
    ),
    guide = "none"
  ) +
  theme_bw() +
  theme(
    strip.background = element_blank(),
    strip.text = element_html(css = css)
  )

^{由reprex 包(v0.3.0)于 2020 年 9 月 16 日创建}