如何在构面图旁边添加类似坐标的标签？

Question

我正在尝试将类似坐标的标签添加到多面ggplot中。我的方法不是最佳的，因为标签的位置取决于情节的输出大小，并且标签与标题重叠（我当然可以在字幕上添加换行符）。因此，设置正确的标签位置非常麻烦。有没有更好的方法来添加这些标签，可能使用一些grob / grid函数？

图由段和场景变量组成。我的第一个想法是使用文本几何来添加坐标，但是，这将增加许多标签（每个构面一个）。因此，我制作了仅包含外侧面内容的矢量

c("","","1","","","2")
c("A","B","C","","","")

，也使用previous answer中的函数。然后，我使用x和y参数设置位置，并设置coord_fixed以使其可见。

library(tidyverse)

df <- tribble(
  ~segment, ~scenario, ~segment_coord, ~scenario_coord,~x,~y,
  "Segment A","Scenario 1","A","1", 1,1,
  "Segment B","Scenario 1","B","1", 2,2,
  "Segment C","Scenario 1","C","1", 4,4,

  "Segment A","Scenario 2","A","2", 1,1,
  "Segment B","Scenario 2","B","2", 2,2,
  "Segment C","Scenario 2","C","2", 4,4
)

make_plot2 <- function(df, my_scenarios, my_segments){

  # Prepare coordinate vectors
  n_rows <- length(my_scenarios)
  n_cols <- length(my_segments)

  seq_fun2 <- function(vector, empty_elements){
    unlist(lapply(vector, function(x) c(rep("", times = empty_elements), x)))
  }
  row_coordinates <- seq_fun2(my_scenarios, n_cols-1) # makes ["","","1","","","2"]
  col_coordinates <- c(my_segments, rep("", n_cols * (n_rows-1))) # makes ["A","B","C","","",""]

  df %>%
    filter(scenario_coord %in% my_scenarios) %>% 
    filter(segment_coord %in% my_segments) %>%  

    ggplot(aes(x, y)) +
      facet_grid(scenario ~ segment) +

      # geom_text(aes(label = segment_coord), x = 2.5, y = 5) + #  would add to many coordinate labels
      # geom_text(aes(label = scenario_coord), x = 5, y = 2.5) +  #  would add to many coordinate labels
      annotate("text", x = 5, y = 2.5, label = row_coordinates) + # adds row coordinates
      annotate("text", x = 2.5, y = 5, label = col_coordinates) + # adds column coordinates

      labs(subtitle = "Quite long subtitle that gets in the way", title = "Title") +
      theme(plot.margin=unit(c(1,1,0.5,0.5),"cm")) +
      coord_fixed(xlim = c(1, 4), ylim = c(1, 4), clip = "off") # removes clipping, so that text is visible outside facets
}

使用不同的输出大小：

make_plot2(df, c("1","2"), c("A","B","C"))

make_plot2(df, c("1","2"), c("A","B","C"))

大图：

带有偏移标签的小图：

Answer 1

我想出了一个可能的解决方案：

my_scenarios <- c("1","2")
my_segments <- c("A","B","C")

plot <- df %>%
  filter(scenario_coord %in% my_scenarios) %>% 
  filter(segment_coord %in% my_segments) %>%  

  ggplot(aes(x, y)) +
    facet_grid(scenario ~ segment) +
    labs(subtitle = "Quite long subtitle that gets in the way",
      title = "Title")

现在情节变得简单得多。下一步涉及

• 将 ggplot2对象转换为 ggplot2图grob
• 在未使用的顶部和右侧轴（axis-t，axis-r）的顶部添加新的齿轮，
• 更改相应单元格的高度和宽度

# Convert the plot to a grob
gt = ggplotGrob(plot)

add_coordinates <- function(gt, axis_name, labels){

  axis <- gt$layout %>% filter(str_detect(name, !!axis_name))
  for(i in 1:nrow(axis)) {
    axis_i <- slice(axis, i)

    # Construct label grobs and add to gtable
    new_grob_name <- paste("coordinate",i,sep = "-")
    gt <- gtable_add_grob(
      gt, 
      textGrob(labels[i], gp = gpar(fontsize = 8)), 
      t = axis_i$t, 
      l = axis_i$l, 
      b = axis_i$b, 
      r = axis_i$r, 
      z = axis_i$z + 1, # on top of axis 
      name = new_grob_name)
  }
  return(gt)
}

gt <- add_coordinates(gt, "axis-t", my_segments)
gt <- add_coordinates(gt, "axis-r", my_scenarios)

# Change the widths and heights. Set same size as strips
# TODO: make dynamic 
gt$heights[6] = unit(gt$heights[7], "cm") 
gt$widths[11] = unit(gt$widths[10], "cm") 

# Draw it
grid.newpage()
grid.draw(gt)

此解决方案避免了弄乱布局，但是，上轴和右轴不再可用。