將極坐標圖作為單獨的對象添加到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