将极坐标图作为单独的对象添加到 ggplot/ggmap 中？

Question

我有下面的代码，用于在 ggplot 中生成基于象限的值的简单极坐标图（来自纬度和经度中心点的风半径），如下所示：

我想将这些极坐标图提取到 SpatialPolygons 对象，这样我就可以将它们绘制为地图上的多边形，与此类似：

有没有什么方法可以将像这样的 ggplot 对象提取到 SpatialPolygons、shapefile 或某种数据框，以便使用 ggplot/ggmap 在地图上绘制？即使是进一步探索的建议也会很有用。提前致谢。

我的数据框：

winds <- data.frame(WindField = c(34, 50, 64, 34, 50, 64, 34, 50, 64, 34, 50, 64), 
                    Quadrant = c("NE", "NE", "NE", "SE", "SE", "SE", 
                                 "SW", "SW", "SW", "NW", "NW", "NW"), 
                    Radius = c(222, 93, 37, 139, 46, 37, 74, 19, 9, 222, 93, 37)) 

quads <- c("NE", "SE", "SW", "NW")

我的 ggplot 代码：

ggplot() + 
    geom_col(data = winds,
             aes(x = factor(Quadrant, levels = quads),
                 y = Radius,
                 fill = factor(WindField),
                 group = factor(Quadrant, levels = quads)),
             stat = "identity", position = "identity", width = 1, color = 'black') +
    scale_fill_manual(values = c("yellow", "orange", "red")) +
    guides(fill = guide_legend(title = "Wind [kt]")) +
    coord_polar() +
    theme_bw() +
    theme(plot.title = element_text(size = 16), 
          plot.subtitle = element_text(size = 12),
          axis.title = element_text(size = 14),
          axis.text.y = element_text(size = 12, face = 'bold'),
          axis.text.x = element_text(size = 14, face = 'bold'),
          legend.text = element_text(size = 13), 
          legend.title = element_text(size = 13),
          panel.border = element_blank(), 
          legend.position = "bottom") +
    labs(y = "Radius [km]", x='Quadrant') 

Answer 1

我不认为 shapefile 与 ggplot 配合得很好，但您可以将图（即 ggplot 对象）转换为 grob 对象并使用annotation_custom().

下面是一个示例，假设您希望使用包含所有必要信息的单个数据框源文件来绘制多个条形图。

第0步：生成数据

set.seed(123)
df <- data.frame(
  plot.ID = rep(1:2, each = 12),
  WindField = rep(c(34, 50, 64), times = 8),
  Quadrant = rep(rep(c("NE", "SE", "SW", "NW"), each = 3), times = 2),
  Radius = rpois(24, lambda = 50) * 
    rep(c(5, 2, 1), times = 8) * # ensure radii decreases as WindField increases
    c(rep(sample(1:4), each = 3), # ensure each quadrant looks visually distinct
      rep(sample(5:8), each = 3)) # & looks different between plots
)

# convert Quadrant / WindField to factors
df$Quadrant = factor(df$Quadrant, levels = c("NE", "SE", "SW", "NW"))
df$WindField = factor(df$WindField)

# add position for each plot (using Florida for illustration)
# note maximum radius of the largest plot
df <- left_join(df,
                 data.frame(plot.ID = 1:2,
                            lon = c(-82, -80),
                            lat = c(29, 26)),
                 by = "plot.ID") %>%
  mutate(max.Radius = max(Radius))

> head(df)
  plot.ID WindField Quadrant Radius lon lat max.Radius
1       1        34       NE    460 -82  29       1920
2       1        50       NE    232 -82  29       1920
3       1        64       NE     76 -82  29       1920
4       1        34       SE   1000 -82  29       1920
5       1        50       SE    496 -82  29       1920
6       1        64       SE    212 -82  29       1920

验证在正常绘图上绘图的样子：

ggplot(df,
       aes(x = Quadrant, y = Radius, fill = WindField)) +
  geom_col(position = "identity", width = 1, color = "black") +
  scale_fill_manual(values = c("yellow", "orange", "red")) +
  coord_polar() +
  facet_grid(~plot.ID) +
  theme_void()

步骤 1：为每个位置创建单独的极坐标图，转换为 grob 对象，并指定它们的位置

df.grobs <- df %>%
  group_by(plot.ID, lon, lat, max.Radius) %>%
  do(subplots = ggplot(.,
                       aes(x = Quadrant, y = Radius, fill = WindField)) +
       geom_col(position = "identity", width = 1, color = "black",
                alpha = 0.5,            # increase transparency to see map underneath
                show.legend = FALSE) +  # don't show legend for individual grobs
       scale_y_continuous(limits = c(0, unique(.$max.Radius))) + 
       scale_fill_manual(values = c("yellow", "orange", "red")) +
       coord_polar() +
       theme_void()) %>%
  mutate(subgrobs = list(annotation_custom(ggplotGrob(subplots),
                                           x = lon - 1,      # change from 1 to other 
                                           y = lat - 1,      # values if necessary,
                                           xmax = lon + 1,   # depending on the map's
                                           ymax = lat + 1))) # resolution.

第 2 步：创建地图

library(ggmap)

p <- get_map("Florida", zoom = 7) %>% 
  ggmap() + 
  coord_fixed()

第 3 步：将地图与条形图块列表结合起来

p + df.grobs$subgrobs