在离散 x 轴上绘制 ggplot2 geom_polygon

Question

我希望能够在特定的离散 x 值上绘制ggplot2::geom_polygon 。 这将类似于“在情节中包含情节”或“创建我自己的geom_ ”。

最小reprex（这是我分别构建的两个多边形的示例）：

library(dplyr)
library(tidyr)
library(ggplot2)
library(purrr)

plot_polygon <- function(.data) {
  .data %>% 
    ggplot() +
    geom_polygon(aes(x, y)) +
    geom_label(aes(x = 1.75, y = 1.25, label = label), fill = "white") +
    theme_void()
}

df <- tibble(
  id = rep(letters[1:2], each = 3),
  x = rep(c(1, 2, 2), 2),
  y = rep(c(1, 1, 2), 2),
  label = rep(c("Polygon 1", "Polygon 2"), each = 3)
) %>% 
  nest(data = x:label) %>% 
  mutate(result_polygon = map(data, plot_polygon))

df
#> # A tibble: 2 x 3
#>   id    data             result_polygon
#>   <chr> <list>           <list>        
#> 1 a     <tibble [3 × 3]> <gg>          
#> 2 b     <tibble [3 × 3]> <gg>

df %>% 
  pull(result_polygon)
#> [[1]]

#> 
#> [[2]]

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

在分别构建它们之后，我想将它们绘制到它们各自的 id 中，它们应该放置在这些标签所在的位置：

df %>% 
  ggplot() +
  geom_label(aes(x = id, y = 1, label = c("Polygon 1 here", "Polygon 2 here")))

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

有谁知道如何实现这一目标？ 我知道我可以使用cowplot或patchwork来实现类似的效果，但是将这些多边形绘制到它们各自的 id 中非常重要（我的真实示例更复杂）。

Answer 1

虽然我喜欢你的多边形函数，但我觉得可能有一个更简单的解决方案。 您可以使用连续比例，然后只使用facet 。

另一种选择是为多边形添加一个 x 值，每个 ID 都会增加。 然后假离散中​​断。

如果你真的想使用你的功能 - 拼凑完全有效。 见选项 3

选项 1方面

library(tidyverse)

mydf <- tibble(
  id = rep(letters[1:2], each = 3),
  x = rep(c(1, 2, 2), 2),
  y = rep(c(1, 1, 2), 2),
  label = rep(c("Polygon 1", "Polygon 2"), each = 3)
)
ggplot(mydf) +
  geom_polygon(aes(x, y, group = id)) +
  facet_grid(~ id)

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

选项 2 x - 按 ID 值移动

my_breaks <- 
  seq(2.5, 1.5 + length(unique(mydf$id)), 1)

ggplot(mydf) +
  geom_polygon(aes(x + as.integer(as.factor(id)), y, group = id)) +
  scale_x_continuous(breaks = my_breaks, labels = unique(mydf$id)) +
  labs(x = 'ID')

选项 3拼凑

library(tidyverse)
library(patchwork)
# your function, slightly modified, to include subtitle labels per each ID 
plot_polygon <- function(.data) {
  .data %>% 
    ggplot() +
    geom_polygon(aes(x, y)) +
    geom_label(aes(x = 1.75, y = 1.25, label = label), fill = "white") +
    theme_void() +
    labs(subtitle = unique(.data$id))
}

# split your data by id, plot each data frame from this list, and pipe into patchwork list wrapper. 
mydf %>% split(mydf$id) %>% map(., function(x) plot_polygon(x)) %>% wrap_plots()

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

Answer 2

不是一个完美的方法，但是如何生成图像并使用函数annotation_custom添加它们呢？ 例如：

temp_save_fct <- function(id, plot) {
  tmpdir <- tempdir()
  filename <- paste0(id, "_plt.png")
  filepath <- paste(tmpdir, filename, sep="/")
  ggsave(filepath, plot=plot)
  img <- png::readPNG(filepath)
  grid::rasterGrob(img, interpolate=TRUE)
}

df$plt_grob <- map2(df$id, df$result_polygon, temp_save_fct)

df %>% 
  ggplot() +
  geom_label(aes(x = id, y = 1, label = c("", ""))) +
  annotation_custom(df$plt_grob[[1]], xmin=0.75, xmax=1.25, ymin=-Inf, ymax=Inf) +
  annotation_custom(df$plt_grob[[2]], xmin=1.75, xmax=2.25, ymin=-Inf, ymax=Inf)