Question

通常需要制作时尚的地图以包含在出版物中。

如何将地图中的投影网格坐标包含在最适合levelplot生成的地图中，看起来像这里显示的地图：

我提供下面的样本数据（加拿大）以获得可重复性。加拿大的典型项目是dat = projectRaster(dem, crs = ('+proj=stere +lat_0=90 +lat_ts=60 +lon_0=-110 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs'))，SpTransform可用于转换边界线（can1）。

require(colorRamps)
require(raster)
require(rasterVis)
require(mapproj)
library(raster)    
library(proj4)


# Get province borders and project it to same CRS than raster
can1 <- getData('GADM', country="CAN", level=1)
getData('ISO3') # country name
dem=getData('alt', country='CAN', mask=TRUE)


require( colorRamps )
my.at <- unique(round(seq(ceiling(5800), floor(1), length.out = 51),0))#at: numeric vector specifying where the colors change. must be of length 1 more than the col vector.


col<-colorRampPalette(c("#d9d9d9", "#bdbdbd", "#969696", "#737373", "#525252", "#252525", "#000000"))


levelplot(dem,maxpixel=ncell(dem),panel=panel.levelplot.raster,names.attr=names(dem),
          interpolate=F,margin=FALSE,xlab=list(label="Longitude",cex=1.5),yscale.components = yscale.raster.subticks,
          xscale.components = xscale.raster.subticks,
          ylab=list(label="Latitude",cex=1.5),
          par.strip.text=list(cex=1),xlim=c(-158, -48.99485),
          ylim=c(38.00513, 85),col.regions=col,at = seq(0, 5800,100),
          colorkey = list(space = "bottom", labels = list(at = seq(0, 5800,800), rot=0,cex=1.1,font=6,fontface=1,
                                                          labels =c("0",  "800", "1600", "2400", "3200", "4000", "4800", "5600")),
                          height=0.99,width=1.8,tck = c(0,0)),
          par.settings=list(panel.background=list(col="white"),axis.line=list(lwd=1.9), strip.border=list(lwd=1.9),layout.heights=list(xlab.key.padding=-0.2)),
          cex=0.8, scales = list(x=list(draw=TRUE,cex=1.2), y=list(draw=TRUE,cex=1.2)))+
          layer(sp.polygons(can1,lwd=0.5,col="gray40"))

Answer 1

下一代码使用graticule包提供解决方案：

library(raster)
library(rasterVis)
library(graticule)


r <- getData('alt', country='CAN', mask=TRUE)

## Here is where the graticule routine starts
crs.longlat <- CRS("+init=epsg:4326")
prj <- CRS(projection(r))
extLL <- projectExtent(r, crs = crs.longlat)

lons <- pretty(c(xmin(extLL), xmax(extLL)))
lats <- pretty(c(ymin(extLL), ymax(extLL)))
## optionally, specify the extents of the meridians and parallels
## here we push them out a little on each side
xl <-  range(lons) + c(-0.4, 0.4)
yl <- range(lats) + c(-0.4, 0.4)
## build the lines with our precise locations and ranges
grat <- graticule(lons, lats, proj = prj,
                  xlim = xl, ylim = yl)
## Labels
labs <- graticule_labels(lons, lats,
                         xline = lons[2],
                         yline = lats[2],
                         proj = prj)
labsLon <- labs[labs$islon,]
labsLat <- labs[!labs$islon,]


## Display the raster
levelplot(r) +
    ## and the graticule
    layer(sp.lines(grat)) +
    layer(sp.text(coordinates(labsLon),
                  txt = parse(text = labsLon$lab),
                  adj = c(1.1, -0.25),
                  cex = 0.6)) +
    layer(sp.text(coordinates(labsLat),
                  txt = parse(text = labsLat$lab),
                  adj = c(-0.25, -0.25),
                  cex = 0.6))

使用levelplot R向地图添加经纬网

1 个答案: