Shapefile 地图上的条形图？

Question

我正在创建一个包含亚洲大陆分区统计图的新图形，但想在每个国家/地区上方添加条形图。理想情况下，我想创建这样的东西：https://forum.generic-mapping-tools.org/t/how-to-plot-bar-charts-on-world-map/959

我知道这个问题之前已经被问过好几次了，但这些问题似乎更旧，并且使用了不再支持的软件包。我的方法是复制这个问题。

我从Eurostat下载了shape文件，并成功计算了shape文件地图中每个国家的质心：

library(sf)
library(tidyverse)

map <- read_sf(dsn = "C:/Users/Adrian/Desktop/PhD/Data/ne_50m_admin_0_countries", 
               layer = "ne_50m_admin_0_countries")


asia <- map[  map$CONTINENT %in% "Asia", ]

asia <- asia %>% mutate(centroids = st_centroid(st_geometry(.))) 
asia <- asia %>% mutate(long = unlist(map(asia$centroids,1)) ,
                        lat = unlist(map(asia$centroids, 2)))

ggplot(data = asia) +
  geom_sf() + coord_sf() +
  geom_point(data = asia, aes(x = long, y = lat) , 
              size = 2 )

给予：

但我不知道如何继续。我想在地图上的每个中心点或附近添加一个条形图（避免任何重叠），并用一个小标签表示国家/地区。

类似这样的：

library(reshape2)

data <- as.data.frame(asia)
data <- data %>%
  select(GU_A3 , POP_EST , GDP_MD)

data <- melt(data)

ggplot(data %>% filter(GU_A3 == "JPN"), aes(x=GU_A3, y=value, fill=variable)) +
  geom_bar(stat='identity', position='dodge') + ggtitle("JPN") +
  theme(plot.title = element_text(hjust = 0.5))

给予：

如何在地图上添加这些图表？我很感激任何帮助。

Answer 1

这是一个非常好的问题。它曾经是一个名为

ggsubplot

的包，但现在它不再在 CRAN 中（参见 RG#87：地图上的直方图/条形图）。希望 Michael Koohafkan 就此发表了一篇文章：A ggsubplot revival。

我采用了后一种方法（即将每个条形图创建为独立图，并使用

annotate_custom()

将其添加到主图）：

library(sf)
library(tidyverse)
library(rnaturalearth)

# I use rnaturalearth package, that should be the same source than your
# downloaded shapefile
asia <- ne_countries(scale = 50, continent = "Asia", returnclass = "sf") %>%
  st_make_valid()


# We need to fake the legend on the main plot, using this...
fakelegend <- asia %>%
  filter(iso_a3 == "JPN") %>%
  select(pop_est, gdp_md_est) %>%
  pivot_longer(pop_est:gdp_md_est)


# Create base (main plot)
my_plot <- ggplot(asia) +
  # We create here a fake legend
  geom_sf(data = fakelegend, aes(fill = name), color = NA) +
  # But we overlay the result with a blank map, so only legend is visible
  geom_sf()

# My base plot
my_plot

# Get centroids

centroids <- bind_cols(asia, st_coordinates(st_centroid(asia,
  of_largest_polygon = TRUE
))) %>%
  st_drop_geometry() %>%
  select(gu_a3, pop_est, gdp_md_est, lon = X, lat = Y) %>%
  pivot_longer(pop_est:gdp_md_est)
#> Warning: st_centroid assumes attributes are constant over geometries


centroids
#> # A tibble: 106 × 5
#>    gu_a3   lon   lat name           value
#>    <chr> <dbl> <dbl> <chr>          <dbl>
#>  1 AFG    65.9  33.8 pop_est     28400000
#>  2 AFG    65.9  33.8 gdp_md_est     22270
#>  3 ARE    54.3  23.9 pop_est      4798491
#>  4 ARE    54.3  23.9 gdp_md_est    184300
#>  5 ARM    44.9  40.3 pop_est      2967004
#>  6 ARM    44.9  40.3 gdp_md_est     18770
#>  7 AZE    47.7  40.3 pop_est      8238672
#>  8 AZE    47.7  40.3 gdp_md_est     77610
#>  9 BGD    90.2  23.9 pop_est    156050883
#> 10 BGD    90.2  23.9 gdp_md_est    224000
#> # ℹ 96 more rows

# Common y scales on each subplot, we need this value
# to adjust it
maxy <- max(asia$pop_est)

# Select some countries
cntr_sel <- c("JPN", "CHN", "AFG", "MNG", "IND")

# Offset for positions close to the centroid
offs <- 5

# We create subplots on a loop
for (cnt in cntr_sel) {

  # Create subplot on loop
  sub_data <- centroids %>% filter(gu_a3 == cnt)

  # Subplot
  sub_plot <- ggplot(sub_data, aes(x = gu_a3, y = value, fill = name)) +
    geom_bar(stat = "identity", position = "dodge", show.legend = FALSE) +
    xlab(cnt) +
    # Common y scale here
    ylim(c(0, maxy)) +
    theme_void() +
    theme(axis.title.x = element_text(hjust = 0.5, size = 8, face = "bold"))

  # Add it here to the main plot
  my_plot <- my_plot +
    # As a grob
    annotation_custom(ggplotGrob(sub_plot),
      # Position of the annotation, based on the centroid info
      xmin = sub_data$lon[1] - offs,
      xmax = sub_data$lon[1] + offs,
      ymin = sub_data$lat[1],
      ymax = sub_data$lat[1] + offs * 2
    )
}

# And the final result
my_plot

^{创建于 2023-06-07，使用 reprex v2.0.2}

Answer 2

我在这里为澳大利亚实施了一个解决方案https://github.com/zerogetsamgow/template_chart_overlay_on_map