Как нанести гистограмму на карту ggplot2

Я нашел похожие ответы на подобные вопросы, но большинство из них используют пакеты rworldmap, ggmap, ggsubplot или geom_subplot2d. См., Например, здесь или здесь.

Я хотел бы знать, как я могу нанести другие объекты ggplot, такие как гистограмма, на карту, созданную из шейп-файла. Тот, который я использую, можно загрузить здесь.

ИЗМЕНИТЬ

Как правильно заметил @beetroot, новый файл, который можно скачать по указанной выше ссылке, значительно изменился. Поэтому имена шейп-файлов и т. Д. Изменяются.

library(rgdal)
library(ggplot2)
library(rgeos)
library(maptools)

map.det<- readOGR(dsn="<path to your directory>/swissBOUNDARIES3D100216/swissBOUNDARIES3D/V200/SHAPEFILE_LV03", layer="VECTOR200_KANTONSGEBIET")
map.kt <- map.det[map.det@data$KANTONSNUM=="CH01000000"|map.det@data$KANTONSNUM=="CH19000000",]


#get centroids
map.test.centroids <- gCentroid(map.kt, byid=T)
map.test.centroids <- as.data.frame(map.test.centroids)
map.test.centroids$KANTONSNR <- row.names(map.test.centroids)

#create df for ggplot
kt_geom <- fortify(map.kt, region="KANTONSNUM")

#Plot map
map.test <- ggplot(NULL)+
        geom_polygon(data=kt_geom, aes(long, lat, group=group), fill="white")+
        coord_fixed()+
        geom_path(data=kt_geom, color="gray48", mapping=aes(long, lat, group=group), size=0.2)+
        geom_point(data=map.test.centroids, aes(x=x, y=y), size=9, alpha=6/10)

mapp

В результате получается такая карта. Все идет нормально. введите здесь описание изображения

Однако у меня возникают трудности с объединением двух графиков, таких как карта map.test и, например, этот:

geo_data <- data.frame(who=rep(c(1:2), each=2),
                   value=as.numeric(sample(1:100, 4, replace=T)),
                   KANTONSNR=rep(c(1,19), 2))

bar.testplot <- ggplot()+
     geom_bar(data=geo_data, aes(factor(id),value,group=who),position='dodge',stat='identity')

Гистограммы должны располагаться в центре двух многоугольников, то есть там, где находятся две точки. Я мог бы создать гистограммы и нанести их на карту отдельно, если это упростит задачу.


person Thomas    schedule 17.03.2016    source источник
comment
так почему ggsubplot не работает для вас, как в приведенном вами примере?   -  person David Heckmann    schedule 17.03.2016
comment
@DavidH Похоже, пакет удалили из репозитория CRAN.   -  person Thomas    schedule 17.03.2016
comment
Однако он все еще находится на github. Не уверен, работает ли он после всех последних изменений в ggplot2.   -  person Axeman    schedule 20.03.2016
comment
Спасибо за подсказку @Axeman, но, похоже, возникла проблема, я не могу установить пакет. Поэтому вопрос выше.   -  person Thomas    schedule 20.03.2016
comment
@beetroot Я только что обновил путь к слою.   -  person Thomas    schedule 21.03.2016
comment
@beetroot Ой, извини. Не доставил тебя туда. Да, файлы, которые необходимо загрузить, находятся в каталоге swissBOUNDARIES3D100216.   -  person Thomas    schedule 22.03.2016
comment
@beetroot Мне очень жаль, что этот файл значительно изменился с тех пор, как я скачал его впервые. Путь и вопрос корректируются. Спасибо что подметил это.   -  person Thomas    schedule 22.03.2016
comment
@Thomas. Когда я нажимаю на ссылку, которую вы предоставили для загрузки шейп-файла, возникает ошибка 404. Можете ли вы разместить его в Dropbox или Google Диске?   -  person weiwensg    schedule 02.12.2016


Ответы (1)


Я немного изменил ваш код, чтобы сделать пример более наглядным. Рисую не только 2 кантона, но и 47.

library(rgdal)
library(ggplot2)
library(rgeos)
library(maptools)
library(grid)
library(gridExtra)

map.det<- readOGR(dsn="c:/swissBOUNDARIES3D/V200/SHAPEFILE_LV03", layer="VECTOR200_KANTONSGEBIET")
map.kt <- map.det[map.det$ICC=="CH" & (map.det$OBJECTID %in% c(1:73)),]

# Merge polygons by ID
map.test <- unionSpatialPolygons(map.kt, map.kt@data$OBJECTID)

#get centroids
map.test.centroids <- gCentroid(map.test, byid=T)
map.test.centroids <- as.data.frame(map.test.centroids)
map.test.centroids$OBJECTID <- row.names(map.test.centroids)

#create df for ggplot
kt_geom <- fortify(map.kt, region="OBJECTID")

#Plot map
map.test <- ggplot(kt_geom)+
  geom_polygon(aes(long, lat, group=group), fill="white")+
  coord_fixed()+
  geom_path(color="gray48", mapping=aes(long, lat, group=group), size=0.2)+
  geom_point(data=map.test.centroids, aes(x=x, y=y), size=2, alpha=6/10)

map.test

начальный сюжет

Сгенерируем данные для штриховых графиков.

set.seed(1)
geo_data <- data.frame(who=rep(c(1:length(map.kt$OBJECTID)), each=2),
                       value=as.numeric(sample(1:100, length(map.kt$OBJECTID)*2, replace=T)),
                       id=rep(c(1:length(map.kt$OBJECTID)), 2))

Теперь делаем 47 штриховых диаграмм, которые позже должны быть построены в центральных точках.

bar.testplot_list <- 
  lapply(1:length(map.kt$OBJECTID), function(i) { 
    gt_plot <- ggplotGrob(
      ggplot(geo_data[geo_data$id == i,])+
        geom_bar(aes(factor(id),value,group=who), fill = rainbow(length(map.kt$OBJECTID))[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]
    })

Здесь мы конвертируем ggplots в gtables, а затем обрезаем их, чтобы получить только панели каждого штрихового графика. Вы можете изменить этот код, чтобы сохранить масштабы, добавить легенду, заголовок и т. Д.

Мы можем добавить этот штриховой график на исходную карту с помощью annotation_custom.

bar_annotation_list <- lapply(1:length(map.kt$OBJECTID), function(i) 
  annotation_custom(bar.testplot_list[[i]], 
                    xmin = map.test.centroids$x[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] - 5e3,
                    xmax = map.test.centroids$x[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] + 5e3,
                    ymin = map.test.centroids$y[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] - 5e3,
                    ymax = map.test.centroids$y[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] + 5e3) )

result_plot <- Reduce(`+`, bar_annotation_list, map.test)

введите описание изображения здесь

person inscaven    schedule 22.03.2016
comment
Отлично! Спасибо. Один вопрос: есть ли способ контролировать размер штриховых графиков? В моем случае их почти не видно на карте ... - person Sebastian Kuhn; 10.11.2017
comment
это +/- 5e3 в конце каждой строки внутри annotation custom определяет размер, попробуйте сделать не 5, а 20 или 50 тысяч - зависит от ваших диапазонов осей x и y - person inscaven; 10.11.2017
comment
Работает отлично! Спасибо!! - person Sebastian Kuhn; 10.11.2017
comment
Это заработало после нескольких изменений. Карты кантонов перемещены в новое место, некоторые имена файлов изменены, и теперь OBJECTID имеет значение KANTONSNUM. - person JerryN; 03.02.2019
comment
Этот код находит файл формы, который я загрузил с shop.swisstopo.admin.ch/de / продукты / ландшафт / границы3D. Полученный файл называется BOUNDARIES_2019.zip. Я разархивировал его, нашел соответствующий шейп-файл в DATEN / swissBOUNDARIES3D. Я прочитал это с map.det<- readOGR(dsn="data-raw/swissBOUNDARIES3D/SHAPEFILE_LV03_LN02", layer="swissBOUNDARIES3D_1_3_TLM_KANTONSGEBIET") - person JerryN; 03.02.2019