在离散 x 轴上绘制 ggplot2 geom_polygon

Question

I would like to be able to plot a ggplot2::geom_polygon on a specific discrete x value. This would be something like "including a plot inside a plot", or something like "creating my own geom_ ".

Minimal reprex (this is an example of two polygons that I build separately):

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]]

^{Created on 2020-02-11 by the reprex package (v0.3.0)}

After building them separately, I would like to plot them to their respective id's, they should be placed where these labels are:

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

^{Created on 2020-02-11 by the reprex package (v0.3.0)}

Does anyone know how to achieve this? I know I could use cowplot or patchwork to achieve something similar, but it is really important that these polygons are plotted to their respective id's (my real example is more complex).

Answer 1

Although I like your polygon function, I get the feeling that there may be a much simpler solution to it. You can use a continuous scale and then just use facet .

Another option is to add an x value to your polygons, increasing for each ID. Then fake discrete breaks.

If you really want to use your function - patchwork totally works. See option 3

Option 1 Facet

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)

^{Created on 2020-02-11 by the reprex package (v0.3.0)}

Option 2 x - shift by ID value

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')

Option 3 Patchworking

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()

^{Created on 2020-02-11 by the reprex package (v0.3.0)}

Answer 2

Not a perfect way, but what about generating images and adding them with the function annotation_custom . For example:

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)