在正射投影中绘制世界地图时裁剪多边形

Clipping polygons when drawing world map in orthographic projection

我尝试在 R 中使用正交投影绘制世界地图,使用从 here 修改的代码,如下所示。还显示了输出图 - 很明显边界附近的陆地区域被裁剪了,在这种情况下是俄罗斯和南极洲。我相信这是由于多边形上的一些点环绕到可见侧的 "back",这些点被映射函数转换为 NA。有什么办法可以解决这个问题吗?

我真的需要那些缺失的区域,因为我的最终目标是绘制其中几张地图,每张地图的中心点都略有不同。如果某些陆地随意进出,那看起来会很奇怪。

library(maps)
library(mapdata)

## start plot & extract coordinates from orthographic map
o <- c(-5,155,0) #orientation
xy <- map("world",proj="orthographic",orientation=o)
## draw a circle around the points for coloring the ocean 
polygon(sin(seq(0,2*pi,length.out=100)),cos(seq(0,2*pi,length.out=100)),col=rgb(0.6,0.6,0.9),border=rgb(1,1,1,0.5),lwd=2)
## overlay world map
map("worldHires",proj="orthographic",orientation=o,fill=TRUE,col=rgb(0.5,0.8,0.5),resolution=0,add=TRUE)

我通过将刚好在视野之外的点投影到地球之外,并用这些 "out" 点填充可见的多边形来解决这个问题。然后使用黑色多边形覆盖溢出的陆地。

为了做到这一点,我使用以下函数(从地图包修改)检索了连续大陆的坐标:

#Get contiguous country coordinates
contigcoord <- function (database = "world", regions = ".", exact = FALSE, boundary = TRUE, interior = TRUE, fill = FALSE, xlim = NULL, ylim = NULL){
    if (is.character(database))
        as.polygon = fill
    else as.polygon = TRUE
    coord <- maps:::map.poly(database, regions, exact, xlim, ylim, boundary, 
        interior, fill, as.polygon)
    return(coord)
}

我也写了投影函数。 "front" = 1 如果该点应该可见:

#Lat/Long to x-y (0,1 range) in orthographic projection. Cen is the centre point of map
mapproj <- function(lat,long,cenlat,cenlong){
    d2r=pi/180; lat=lat*d2r; long=long*d2r; cenlat=cenlat*d2r; cenlong=cenlong*d2r
    x=cos(lat)*sin(long-cenlong)
    y=cos(cenlat)*sin(lat)-sin(cenlat)*cos(lat)*cos(long-cenlong)
    front=sin(cenlat)*sin(lat)+cos(cenlat)*cos(lat)*cos(long-cenlong) > 0
    return(list(x=x,y=y,front=front))
}

用于填充陆地的代码如下(cenlat和cenlong是可见地球中心的坐标):

xy <- contigcoord("world",fill=TRUE)
coord <- cbind(xy$x,xy$y)
coordtr <- mapproj(coord[,2],coord[,1],cenlat,cenlong)
coord <- cbind(coord,coordtr$x,coordtr$y,coordtr$front)

naloc <- (1:nrow(coord))[!complete.cases(coord)]
naloc <- c(0,naloc)
for(i in 2:length(naloc)){
    thispoly <- coord[(naloc[i-1]+1):(naloc[i]-1),3:5,drop=F]
    thispoly <- rbind(thispoly,thispoly[1,])
    unq <- unique(thispoly[,3])
    if(length(unq) == 1){ 
        if(unq == 1){ #Polygon is fully on front side
            polygon(thispoly[,1],thispoly[,2],col=rgb(0.5,0.8,0.5),border=NA)
        }
    } else { #front and back present
        ind <- thispoly[,3] == 0
        #project points "outside" the globe
        temdist <- pmax(sqrt(rowSums(as.matrix(thispoly[ind,1:2]^2))),1e-5)
        thispoly[ind,1:2] <- thispoly[ind,1:2]*(2-temdist)/temdist
        polygon(thispoly[,1],thispoly[,2],col=rgb(0.5,0.8,0.5),border=NA)
    }
}

结果如下所示(在全球范围内应用黑色图层之前):