Используйте другой центр, чем простой меридиан при построении карты мира

Я накладываю карту мира из 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. Должен быть лучший способ центрировать карту на другом меридиане. Я пытался использовать orientation параметр в map, но установив это orientation = c(0,180,0) не дал правильного результата, фактически ничего не изменило к объекту результата (all.equal дали TRUE).
  2. Избавление от горизонтальных полос должно быть возможным без удаления некоторых полигонов. Возможно, что решение пункта 1. также решает эту точку.

3 ответа

Решение

Вот другой подход. Работает:

  1. Преобразование карты мира из maps пакет в SpatialLines объект с географическим (лат-длинным) КРС.
  2. Проектирование SpatialLines карта в проекции Платиновой Кари (известной также как Цилиндрическая), центрированная на Первом Меридиане. (Эта проекция очень похожа на географическое картирование).
  3. Разрезание на два сегмента, которые в противном случае обрезались бы по левому и правому краям карты. (Это делается с использованием топологических функций из rgeos пакет.)
  4. Перепроецирование на проекцию Plate Carée с центром в требуемом меридиане (lon_0 в терминологии взяты из PROJ_4 программа используется spTransform() в rgdal пакет).
  5. Выявление (и удаление) любых оставшихся "полос". Я автоматизировал это, ища линии, которые пересекают два из трех широко разделенных меридианов. (При этом также используются топологические функции из rgeos пакет.)

Это, очевидно, большая работа, но она оставляет карты с минимально усеченными картами, которые можно легко перепроецировать с помощью spTransform(), Чтобы наложить их поверх растровых изображений с помощью base или же lattice графику, я сначала перепроектировать растры, также используя 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

Это может быть несколько сложно, но вы можете сделать это:

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 отсутствует, выглядит так:

Это должно работать:

 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 разрезает линии, идущие по карте. Его можно использовать через опцию для отображения (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()
Другие вопросы по тегам