如何在ggplot2地图上绘制条形图

Tho*_*mas 11 r ggplot2 gridextra r-grid

我也发现了类似的答案像这样的问题,但大部分都是使用包rworldmap,ggmap,ggsubplotgeom_subplot2d.例如,在此处此处查看.

我想知道如何将其他ggplot对象(如条形图)绘制到地图上,这是从shapefile创建的.我正在使用的那个可以在这里下载.

编辑

正如@beetroot正确指出的那样,可以在上面发布的链接下下载的新文件发生了显着变化.因此,调整shapefile等的名称.

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
Run Code Online (Sandbox Code Playgroud)

这导致了这样的地图.到现在为止还挺好. 在此输入图像描述

但是,我在组合两个地图时遇到了困难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')
Run Code Online (Sandbox Code Playgroud)

条形图应位于两个多边形的中心,即两个点的位置.我可以制作条形图并将它们分别绘制在地图上,如果这样可以使事情变得更容易.

ins*_*ven 13

我修改了一些代码,使示例更具说明性.我不仅要绘制2个kantons,还要绘制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
Run Code Online (Sandbox Code Playgroud)

初始情节

让我们为条形图生成数据.

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))
Run Code Online (Sandbox Code Playgroud)

现在制作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]
    })
Run Code Online (Sandbox Code Playgroud)

在这里,我们将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)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述