绘制颜色编码网格和多边形的交集

时间:2014-03-12 20:56:12

标签: r map gis shapefile

我有一个多边形(科罗拉多的轮廓)和一个覆盖多边形的颜色编码的纬度 - 经度网格。我希望仅在多边形本身内显示颜色编码的网格。我怎么能这样做?

绘制多边形和网格的代码如下。为了说明,我已将多边形放在下图中的网格上,否则您将无法看到多边形。

我尝试使用PBSmapping包来获取两个多边形的交集。但是,我只能用单一颜色绘制交叉区域,而不是让一个多边形的原始颜色方案保留。 (网格是多色的。)

我还想过尝试让多边形内部不填充,多边形外面的区域是白色。也许这是可能的。然后我可以将多边形放在网格上,网格只能在多边形中可见。但是,如果我有多个多边形和一个网格,那么这种方法可能不起作用。

感谢您的任何建议。这是迄今为止的代码:

library(rgdal)
library(maptools)
library(RColorBrewer)
library(classInt)
library(raster)

setwd('c:/users/mark w miller/gis_in_R')

## Specify a geographic extent for the map
## by defining the top-left and bottom-right geographic coordinates
mapExtent <- rbind(c(-115, 43), c( -97, 35))

# assign projection
newProj <- CRS("+proj=longlat +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")

## Project the map extent (first need to specify that it is longlat) 
mapExtentPr <- spTransform(SpatialPoints(mapExtent, 
                  proj4string=CRS("+proj=longlat")),
                  newProj)

# get Colorado polygon
us1 <- getData('GADM', country="USA", level=1)
colorado <- us1[(us1$NAME_1 %in% c('Colorado')),]

## Project Colorada layer
coloradoPr  <- spTransform( colorado, newProj) 

# create grid of polygons
grd <- GridTopology(c(-110.5, 35.5), c(1,1), c(11,8))
polys <- as(grd, "SpatialPolygons")

# assign projection to grid
proj4string(polys) = CRS("+proj=longlat +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")

# create fake atttribute data for each grid cell
poly.data = data.frame(f=runif(length(row.names(polys)), 0, 14))
row.names(poly.data) <- paste0('g', 1:length(row.names(polys)))

# convert grid to a SpatialPolygonsDataFrame:
poly.df = SpatialPolygonsDataFrame(polys, poly.data)

# assign colors to grid cells
plotvar <- poly.df$f
nclr    <- 8
plotclr <- brewer.pal(nclr,"BuPu")

colcode <- ifelse((                plotvar <=   2), plotclr[1],
           ifelse((plotvar >   2 & plotvar <=   4), plotclr[2],
           ifelse((plotvar >   4 & plotvar <=   6), plotclr[3],
           ifelse((plotvar >   6 & plotvar <=   8), plotclr[4],
           ifelse((plotvar >   8 & plotvar <=  10), plotclr[5],
           ifelse((plotvar >  10 & plotvar <=  12), plotclr[6],
           ifelse((plotvar >  12 & plotvar <=  14), plotclr[7],
                                                    plotclr[8])))))))

jpeg(filename = "colorado.with.grid2.jpeg")

## Plot each projected layer, beginning with the projected extent
plot(mapExtentPr, pch=NA)
plot(poly.df, , col=colcode, add=TRUE)
plot(coloradoPr , border="white", col="lightgrey", add=TRUE)

dev.off()

enter image description here

修改

一种可能不精确且非常费力的解决方案可能是创建多个网格,这些网格在组合时大致填充每个多边形。这有点类似于黎曼和。但是,我必须认为有更准确,更容易实施的解决方案。

1 个答案:

答案 0 :(得分:0)

以下是我到目前为止所提出的问题,使用PBSmapping包:

library(rgdal)
library(maptools)
library(RColorBrewer)
library(classInt)
library(raster)

setwd('c:/users/mark w miller/gis_in_R')

## Specify a geographic extent for the map
my.map.extent <- matrix(c(-113, 46,
                          -113, 33,
                           -93, 33,
                           -93, 46,
                          -113, 46), nrow=5, byrow=TRUE)

my.map.extent.p   = Polygon(my.map.extent)
my.map.extent.ps  = Polygons(list(my.map.extent.p),1)
my.map.extent.sps = SpatialPolygons(list(my.map.extent.ps))
proj4string(my.map.extent.sps) <- CRS("+proj=longlat +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")

# assign projection
newProj <- CRS("+proj=longlat +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")

# get my.states polygon
us1 <- getData('GADM', country="USA", level=1)
my.states <- us1[(us1$NAME_1 %in% c('Wyoming', 'Kansas')),]

## Project state layer
my.statesPr  <- spTransform(my.states, newProj) 

# create grid of polygons
#                      lower left,  cell size, number of cells on x axis and on y axis
grd <- GridTopology(c(-112.5, 33.5), c(1,1), c(20,15))
polys <- as(grd, "SpatialPolygons")

# assign projection to grid
proj4string(polys) = CRS("+proj=longlat +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")

# create fake attribute data for each grid cell
poly.data = data.frame(f=runif(length(row.names(polys)), 0, 14))
row.names(poly.data) <- paste0('g', 1:length(row.names(polys)))

# convert grid to a SpatialPolygonsDataFrame:
poly.df = SpatialPolygonsDataFrame(polys, poly.data)

# assign colors to grid cells
plotvar <- poly.df$f
nclr    <- 8
plotclr <- brewer.pal(nclr,"BuPu")

colcode <- ifelse((                plotvar <=   2), plotclr[1],
           ifelse((plotvar >   2 & plotvar <=   4), plotclr[2],
           ifelse((plotvar >   4 & plotvar <=   6), plotclr[3],
           ifelse((plotvar >   6 & plotvar <=   8), plotclr[4],
           ifelse((plotvar >   8 & plotvar <=  10), plotclr[5],
           ifelse((plotvar >  10 & plotvar <=  12), plotclr[6],
           ifelse((plotvar >  12 & plotvar <=  14), plotclr[7],
                                                    plotclr[8])))))))

library(PBSmapping) 

extent.ps <- combinePolys(SpatialPolygons2PolySet(my.map.extent.sps))
grid.ps   <- combinePolys(SpatialPolygons2PolySet(poly.df))
states.ps <- combinePolys(SpatialPolygons2PolySet(my.statesPr))

diff.grid.states <- combinePolys(joinPolys(extent.ps, states.ps, "DIFF"))

dev.new()

jpeg(filename = "my.states.with.grid.jpeg")

plotPolys(extent.ps, proj = TRUE, xlab="Easting", ylab="Northing")
plot(poly.df, col=colcode, lwd = 0.5, add=TRUE)
addPolys(diff.grid.states, col="white")

dev.off()

enter image description here