32

我将maps包中的世界地图覆盖到ggplot2光栅几何上。但是,此栅格不是以本初子午线(0 度)为中心,而是以 180 度(大致白令海和太平洋)为中心。以下代码获取地图并将地图以 180 度居中:

require(maps)
world_map = data.frame(map(plot=FALSE)[c("x","y")])
names(world_map) = c("lon","lat")
world_map = within(world_map, {
  lon = ifelse(lon < 0, lon + 360, lon)
})
ggplot(aes(x = lon, y = lat), data = world_map) + geom_path()

产生以下输出:

在此处输入图像描述

很明显,在位于本初子午线一端或另一端的多边形之间绘制了线。我目前的解决方案是用 NA 替换接近本初子午线的点,将within上面的调用替换为:

world_map = within(world_map, {
  lon = ifelse(lon < 0, lon + 360, lon)
  lon = ifelse((lon < 1) | (lon > 359), NA, lon)
})
ggplot(aes(x = lon, y = lat), data = world_map) + geom_path()

这会导致正确的图像。我现在有几个问题:

  1. 必须有更好的方法将地图集中在另一个子午线上。我尝试使用orientationin 参数map,但将其设置为orientation = c(0,180,0)并没有产生正确的结果,实际上它并没有改变结果对象(all.equalyielded TRUE)的任何内容。
  2. 在不删除一些多边形的情况下应该可以摆脱水平条纹。可能是解决点 1. 也解决了这一点。
4

3 回答 3

31

这可能有点棘手,但您可以通过以下方式完成:

mp1 <- fortify(map(fill=TRUE, plot=FALSE))
mp2 <- mp1
mp2$long <- mp2$long + 360
mp2$group <- mp2$group + max(mp2$group) + 1
mp <- rbind(mp1, mp2)
ggplot(aes(x = long, y = lat, group = group), data = mp) + 
  geom_path() + 
  scale_x_continuous(limits = c(0, 360))

在此处输入图像描述

通过此设置,您可以轻松设置中心(即限制):

ggplot(aes(x = long, y = lat, group = group), data = mp) + 
  geom_path() + 
  scale_x_continuous(limits = c(-100, 260))

在此处输入图像描述

更新

这里我做一些解释:

整个数据看起来像:

ggplot(aes(x = long, y = lat, group = group), data = mp) + geom_path()

在此处输入图像描述

但是通过scale_x_continuous(limits = c(0, 360)),您可以裁剪从 0 到 360 经度的区域子集。

而在 中geom_path,同一组的数据是相连的。所以如果mp2$group <- mp2$group + max(mp2$group) + 1不存在,它看起来像: 在此处输入图像描述

于 2012-05-17T02:52:10.367 回答
17

这是一种不同的方法。它的工作原理是:

  1. maps包中的世界地图转换为SpatialLines具有地理(经纬度)CRS 的对象。
  2. 将地图投影SpatialLines到以本初子午线为中心的 Plate Carée(又名等距圆柱)投影。(此投影与地理测绘非常相似)。
  3. 切割成两个部分,否则会被地图的左右边缘剪裁。(这是使用rgeos包中的拓扑函数完成的。)
  4. 重新投影到以所需子午线为中心的 Plate Carée 投影(lon_0术语取自包中PROJ_4使用spTransform()rgdal程序)。
  5. 识别(并消除)任何剩余的“条纹”。我通过搜索跨越三个广泛分开的子午线中的两个的线来自动执行此操作。(这也使用rgeos包中的拓扑函数。)

这显然需要做很多工作,但留下的地图会被最小化截断,并且可以使用spTransform(). 为了在光栅图像上叠加这些baselattice图形,我首先重新投影光栅,也使用spTransform(). 如果您需要它们,同样可以投影网格线和标签以匹配SpatialLines地图。


library(sp)
library(maps)
library(maptools)   ## map2SpatialLines(), pruneMap()
library(rgdal)      ## CRS(), spTransform()
library(rgeos)      ## readWKT(), gIntersects(), gBuffer(), gDifference() 

## Convert a "maps" map to a "SpatialLines" map
makeSLmap <- function() {
    llCRS <- CRS("+proj=longlat +ellps=WGS84")
    wrld <- map("world", interior = FALSE, plot=FALSE,
            xlim = c(-179, 179), ylim = c(-89, 89))
    wrld_p <- pruneMap(wrld, xlim = c(-179, 179))
    map2SpatialLines(wrld_p, proj4string = llCRS)
}

## Clip SpatialLines neatly along the antipodal meridian
sliceAtAntipodes <- function(SLmap, lon_0) {
    ## Preliminaries
    long_180 <- (lon_0 %% 360) - 180
    llCRS  <- CRS("+proj=longlat +ellps=WGS84")  ## CRS of 'maps' objects
    eqcCRS <- CRS("+proj=eqc")
    ## Reproject the map into Equidistant Cylindrical/Plate Caree projection 
    SLmap <- spTransform(SLmap, eqcCRS)
    ## Make a narrow SpatialPolygon along the meridian opposite lon_0
    L  <- Lines(Line(cbind(long_180, c(-89, 89))), ID="cutter")
    SL <- SpatialLines(list(L), proj4string = llCRS)
    SP <- gBuffer(spTransform(SL, eqcCRS), 10, byid = TRUE)
    ## Use it to clip any SpatialLines segments that it crosses
    ii <- which(gIntersects(SLmap, SP, byid=TRUE))
    # Replace offending lines with split versions
    # (but skip when there are no intersections (as, e.g., when lon_0 = 0))
    if(length(ii)) { 
        SPii <- gDifference(SLmap[ii], SP, byid=TRUE)
        SLmap <- rbind(SLmap[-ii], SPii)  
    }
    return(SLmap)
}

## re-center, and clean up remaining streaks
recenterAndClean <- function(SLmap, lon_0) {
    llCRS <- CRS("+proj=longlat +ellps=WGS84")  ## map package's CRS
    newCRS <- CRS(paste("+proj=eqc +lon_0=", lon_0, sep=""))
    ## Recenter 
    SLmap <- spTransform(SLmap, newCRS)
    ## identify remaining 'scratch-lines' by searching for lines that
    ## cross 2 of 3 lines of longitude, spaced 120 degrees apart
    v1 <-spTransform(readWKT("LINESTRING(-62 -89, -62 89)", p4s=llCRS), newCRS)
    v2 <-spTransform(readWKT("LINESTRING(58 -89, 58 89)",   p4s=llCRS), newCRS)
    v3 <-spTransform(readWKT("LINESTRING(178 -89, 178 89)", p4s=llCRS), newCRS)
    ii <- which((gIntersects(v1, SLmap, byid=TRUE) +
                 gIntersects(v2, SLmap, byid=TRUE) +
                 gIntersects(v3, SLmap, byid=TRUE)) >= 2)
    SLmap[-ii]
}

## Put it all together:
Recenter <- function(lon_0 = -100, grid=FALSE, ...) {                        
    SLmap <- makeSLmap()
    SLmap2 <- sliceAtAntipodes(SLmap, lon_0)
    recenterAndClean(SLmap2, lon_0)
}

## Try it out
par(mfrow=c(2,2), mar=rep(1, 4))
plot(Recenter(-90), col="grey40"); box() ## Centered on 90w 
plot(Recenter(0),   col="grey40"); box() ## Centered on prime meridian
plot(Recenter(90),  col="grey40"); box() ## Centered on 90e
plot(Recenter(180), col="grey40"); box() ## Centered on International Date Line

在此处输入图像描述

于 2012-05-25T06:58:13.043 回答
1

这应该有效:

 wm <- map.wrap(map(projection="rectangular", parameter=0, orientation=c(90,0,180), plot=FALSE))
world_map <- data.frame(wm[c("x","y")])
names(world_map) <- c("lon","lat")

map.wrap 切断了穿过地图的线条。它可以通过 map(wrap=TRUE) 的选项使用,但仅在 plot=TRUE 时有效。

剩下的一个烦恼是,在这一点上,纬度/经度的单位是弧度,而不是度数:

world_map$lon <- world_map$lon * 180/pi + 180
world_map$lat <- world_map$lat * 180/pi
ggplot(aes(x = lon, y = lat), data = world_map) + geom_path()
于 2016-01-06T15:14:02.740 回答