Построение баров на карте с помощью ggplot - PullRequest
Новая
       67

Построение баров на карте с помощью ggplot

0 голосов
/ 16 января 2019

Я хочу нанести один столбец для каждой страны на карту.

Мой код: 

library(tidyverse)
library(rworldmap)

# Get map data
worldMap <- map_data("world")

# Select only some countries and add values
europe <- data.frame("country"=c("Austria", "Belgium", "Germany", "Spain", "Finland", "France", 
                                 "Greece", "Ireland", "Italy", "Netherlands", "Portugal",
                                 "Bulgaria","Croatia","Cyprus", "Czech Republic","Denmark","Estonia", "Hungary",
                                 "Latvia", "Lithuania","Luxembourg","Malta", "Poland", "Romania","Slovakia",
                                 "Slovenia","Sweden","UK", "Switzerland",
                                 "Ukraine", "Turkey", "Macedonia", "Norway", "Slovakia", "Serbia", "Montenegro",
                                 "Moldova", "Kosovo", "Georgia", "Bosnia and Herzegovina", "Belarus", 
                                 "Armenia", "Albania", "Russia"),
                     "Growth"=c(1.0, 0.5, 0.7, 5.2, 5.9, 2.1, 
                                       1.4, 0.7, 5.9, 1.5, 2.2, rep(NA, 33)))

# Merge data and keep only Europe map data
worldMap$value <- europe$Growth[match(worldMap$region,europe$country)]

worldMap <- worldMap %>%
  filter(region %in% europe$country) 

# Plot it 
P <- ggplot()+ 
  geom_polygon(data = worldMap, aes(x=long, y = lat, group = group, fill=value),
               colour = "white", size = 0.1)+
  coord_map(xlim = c(-13, 35),  ylim = c(32, 71))

Мне известно об этом решении , но я не могу его воспроизвести: 

# Adding Centroids
centres <- worldMap %>%
  group_by(region) %>%
  summarize(long=mean(long, na.rm = T), 
            lat=mean(lat, na.rm = T))

centres$value <- europe$Growth[match(centres$region,europe$country)]

# Trying to add the barplots
europe$id <- (rep(1:length(europe$country)))

bar.testplot_list <- 
  lapply(1:length(europe$country), function(i) { 
    gt_plot <- ggplotGrob(
      ggplot(europe[europe$id == i,])+
        geom_bar(aes(factor(id),Growth,group=country), fill = rainbow(length(europe$country))[i],
                 position='dodge',stat='identity', color = "black") +
        labs(x = NULL, y = NULL) + 
        theme(legend.position = "none", rect = element_blank(),
              line = element_blank(), text = element_blank()) 
    )
    panel_coords <- gt_plot$layout[gt_plot$layout$name == "panel",]
    gt_plot[panel_coords$t:panel_coords$b, panel_coords$l:panel_coords$r]
  })

bar_annotation_list <- lapply(1:length(europe$country), function(i) 
  annotation_custom(bar.testplot_list[[i]], 
                    xmin = centres$long[centres$region == as.character(europe$country[i])] - 5e3,
                    xmax = centres$long[centres$region == as.character(europe$country[i])] + 5e3,
                    ymin = centres$lat[centres$region == as.character(europe$country[i])] - 5e3,
                    ymax = centres$lat[centres$region == as.character(europe$country[i])] + 5e3) )

result_plot <- Reduce(`+`, bar_annotation_list, P)
result_plot

Я также вижу, что он не работает с coord_map, но результат также не работает, когда я не включаю coord_map(xlim = c(-13, 35), ylim = c(32, 71)). -> Может кто-нибудь объяснить, как я могу добавить переменную роста в виде столбца для каждой соответствующей страны?

1 Ответ

0 голосов
/ 17 января 2019

Это должно быть рабочим решением. Обратите внимание, что заморские территории смещают центр тяжести Франции от центра тяжести материка Франция. 

library(tidyverse)
#library(rworldmap)
library(sf)
# Data 
library(spData)      
library(spDataLarge)

# Get map data
worldMap <- map_data("world")

# Select only some countries and add values
europe <- 
  data.frame("country"=c("Austria",
                         "Belgium", 
                         "Germany",
                         "Spain", 
                         "Finland", 
                         "France", 
                         "Greece", 
                         "Ireland", 
                         "Italy", 
                         "Netherlands", 
                         "Portugal",
                                 "Bulgaria","Croatia","Cyprus", "Czech Republic","Denmark","Estonia", "Hungary",
                                 "Latvia", "Lithuania","Luxembourg","Malta", "Poland", "Romania","Slovakia",
                                 "Slovenia","Sweden","UK", "Switzerland",
                                 "Ukraine", "Turkey", "Macedonia", "Norway", "Slovakia", "Serbia", "Montenegro",
                                 "Moldova", "Kosovo", "Georgia", "Bosnia and Herzegovina", "Belarus", 
                                 "Armenia", "Albania", "Russia"),
                     "Growth"=c(1.0, 0.5, 0.7, 5.2, 5.9, 2.1, 
                                1.4, 0.7, 5.9, 1.5, 2.2, rep(NA, 33)))

# Merge data and keep only Europe map data

data("world")

worldMap <- world

worldMap$value <- europe$Growth[match(worldMap$region,europe$country)]

centres <- 
  worldMap %>%
  filter()
  st_centroid()

worldMap <- worldMap %>%
  filter(name_long %in% europe$country) 

# Plot it 

centroids <- 
  centres$geom %>% 
  purrr::map(.,.f = function(x){data.frame(long = x[1],lat = x[2])}) %>% 
  bind_rows %>% data.frame(name_long = centres$name_long) %>% 
  left_join(europe,by = c("name_long" = "country"))


barwidth = 1
barheight = 0.75

ggplot()+ 
  geom_sf(data = worldMap, color = "black",fill = "lightgrey",
               colour = "white", size = 0.1)+
  coord_sf(xlim = c(-13, 35),  ylim = c(32, 71)) + 
  geom_rect(data = centroids,
            aes(xmin = long - barwidth,
                xmax = long + barwidth,
                ymin = lat,
                ymax = lat + Growth*barheight)) + 
  geom_text(data = centroids %>% filter(!is.na(Growth)),
            aes(x = long,
                y = lat + 0.5*Growth*0.75,
                label = paste0(Growth," %")),
            size = 2) + 
  ggsave(file = "test.pdf",
         width = 10,
         height = 10)
...