Shapefile 地图上的条形图？

Question

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

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

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

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。

\n

我采用了后一种方法（即，将每个条形图创建为独立图，并将其添加到主图中annotate_custom()），如下所示：

\n

library(sf)\nlibrary(tidyverse)\nlibrary(rnaturalearth)\n\n# I use rnaturalearth package, that should be the same source than your\n# downloaded shapefile\nasia <- ne_countries(scale = 50, continent = "Asia", returnclass = "sf") %>%\n  st_make_valid()\n\n\n# We need to fake the legend on the main plot, using this...\nfakelegend <- asia %>%\n  filter(iso_a3 == "JPN") %>%\n  select(pop_est, gdp_md_est) %>%\n  pivot_longer(pop_est:gdp_md_est)\n\n\n# Create base (main plot)\nmy_plot <- ggplot(asia) +\n  # We create here a fake legend\n  geom_sf(data = fakelegend, aes(fill = name), color = NA) +\n  # But we overlay the result with a blank map, so only legend is visible\n  geom_sf()\n\n# My base plot\nmy_plot\n

\n

\n

\n# Get centroids\n\ncentroids <- bind_cols(asia, st_coordinates(st_centroid(asia,\n  of_largest_polygon = TRUE\n))) %>%\n  st_drop_geometry() %>%\n  select(gu_a3, pop_est, gdp_md_est, lon = X, lat = Y) %>%\n  pivot_longer(pop_est:gdp_md_est)\n#> Warning: st_centroid assumes attributes are constant over geometries\n\n\ncentroids\n#> # A tibble: 106 \xc3\x97 5\n#>    gu_a3   lon   lat name           value\n#>    <chr> <dbl> <dbl> <chr>          <dbl>\n#>  1 AFG    65.9  33.8 pop_est     28400000\n#>  2 AFG    65.9  33.8 gdp_md_est     22270\n#>  3 ARE    54.3  23.9 pop_est      4798491\n#>  4 ARE    54.3  23.9 gdp_md_est    184300\n#>  5 ARM    44.9  40.3 pop_est      2967004\n#>  6 ARM    44.9  40.3 gdp_md_est     18770\n#>  7 AZE    47.7  40.3 pop_est      8238672\n#>  8 AZE    47.7  40.3 gdp_md_est     77610\n#>  9 BGD    90.2  23.9 pop_est    156050883\n#> 10 BGD    90.2  23.9 gdp_md_est    224000\n#> # \xe2\x84\xb9 96 more rows\n\n# Common y scales on each subplot, we need this value\n# to adjust it\nmaxy <- max(asia$pop_est)\n\n# Select some countries\ncntr_sel <- c("JPN", "CHN", "AFG", "MNG", "IND")\n\n# Offset for positions close to the centroid\noffs <- 5\n\n# We create subplots on a loop\nfor (cnt in cntr_sel) {\n\n  # Create subplot on loop\n  sub_data <- centroids %>% filter(gu_a3 == cnt)\n\n  # Subplot\n  sub_plot <- ggplot(sub_data, aes(x = gu_a3, y = value, fill = name)) +\n    geom_bar(stat = "identity", position = "dodge", show.legend = FALSE) +\n    xlab(cnt) +\n    # Common y scale here\n    ylim(c(0, maxy)) +\n    theme_void() +\n    theme(axis.title.x = element_text(hjust = 0.5, size = 8, face = "bold"))\n\n  # Add it here to the main plot\n  my_plot <- my_plot +\n    # As a grob\n    annotation_custom(ggplotGrob(sub_plot),\n      # Position of the annotation, based on the centroid info\n      xmin = sub_data$lon[1] - offs,\n      xmax = sub_data$lon[1] + offs,\n      ymin = sub_data$lat[1],\n      ymax = sub_data$lat[1] + offs * 2\n    )\n}\n\n# And the final result\nmy_plot\n

\n

\n

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

\n