将地图对象转换为土地/水阵列

时间:2016-10-07 09:20:07

标签: r maps

我想运行一些空间算法,有必要“掩盖”土地面积。我可以制作一张显示土地的地图:水为黑色:白色,带有maps包裹:

lonRange <- c( 100, 150 )
latRange <- c( 10, 50 )
mapObject <- maps::map( database = "world", xlim = lonRange, ylim = latRange, fill = TRUE )

这创建了一个看似简单的“4列表”,并将数据显示为黑白地图,其中土地为黑色,水为白色。我想要的是将数据优选地表示为数组,例如land = 0water = 1。我对确切的输出很灵活,但是像我这样的东西在我的脑海中是完美的。一个数组[,,1]表示二进制地/水值,[,,2]表示纬度,[,,3]表示经度:

map <- array( data = NA, dim = c( 10, 10, 3 ) )
map[,,1] <- c( rep( 1, 42 ), rep( 0, 58 ) )
map[,,2] <- c( rep( seq.int( from = latRange[2], to = latRange[1], length.out = 10 ), 10 ) )
map[,,3] <- sort( c( rep( seq.int( from = lonRange[1], to = lonRange[2], length.out = 10 ), 10 ) ) )

所以我可以调用map[1,1,]获取该点给定纬度和经度的陆/海变量。在这种情况下1(水),在lat_lon 50_100:

> map[1,1,]
[1]   1  50 100 

我认为我需要的信息包含在上面创建的mapObject列表中,但我无法弄清楚如何提取它。

我一直试图找出mapObject中的值是什么意思,但无法理解它们。元素[[1]][[2]](分别为xy看起来很有希望,但对我来说没有任何意义,我可以制定一个如何向前发展的计划。这些值似乎不代表纬度和/或经度,并且NAx中的相同点都有y个值。

任何人都可以帮我解读mapObject内容的含义吗?或者提出一个完全不同的方法来实现我在这里的目标?

map帮助页面说明了输出列表:

  

“x和y向量具有连续多边形的坐标”

这肯定会对我有所帮助,但我对多边形的表示知之甚少知之甚少。如果有人可以建议我可以在这里学到我需要的资源,那将非常感激。

2 个答案:

答案 0 :(得分:2)

注意:正如@hrbrmstr所提到的,有更好的方法。

(1)rgeos::gContains()判断一个点(由经度/纬度定义)是否在SpatialPolygon...中(参见:Check if point is in spatial object which consists of multiple polygons/holes)(注意:处理很多事情是个坏主意)通过这种方式的ponits)。在你的情况下,True意味着在陆地上。 (2)您可以从坐标SpatialPolygons中获取mapObject。 (注意:mapObject使用NA作为分区,因此NA之间的坐标对应于polygon}。

library(rgeos); library(maps); library(dplyr)

coords.mat <- matrix(c(mapObject$x, mapObject$y), ncol=2)     # get lon-lat coordinates
div <- c(0, which(is.na(mapObject$x)), length(mapObject$x)+1) # get divisions information

 ## separate coordinates by divisions(NA)
coords.list <- sapply(1:(length(div)-1), function(x) coords.mat[(div[x]+1):(div[x+1]-1),])

 ## change sets of coordinates into SpatialPolygons
map.sp <- coords.list %>% sapply(function(x) Polygon(x)) %>% 
  Polygons(ID = "a") %>% list() %>% SpatialPolygons()

 ## judge
contain.judge <- apply(map, c(1,2), function(x) gContains(map.sp, SpatialPoints(matrix(c(x[3], x[2]), ncol=2))))

 ## chage into binary data and combine
map[,,1] <- as.numeric(contain.judge)

 ## 
plot(coords.mat, pch=".", xlim = lonRange, ylim = latRange)
points(c(map[,,3]), c(map[,,2]), col=c(2,4)[as.factor(c(map[,,1]))], pch = 19)

enter image description here

# bonus: 100x100x3 array version. It takes a few minutes to judge all points.

enter image description here

答案 1 :(得分:1)

感谢@ cuttlefish44获得了很好的答案。我想我会添加如何使用答案来创建我需要的功能。特别是,我利用plyrdoMC包来跨4个核心多线程处理过程中最慢的部分*(注意holmberg::pkgLoad只是我的一个函数在安装和加载包之前检查包是否已安装。)

latlon这里是矩阵,根据以下演示中的创建:

landMask <- function( lat, lon, cores = 2 ) {

    holmberg::pkgLoad( c( "rgeos", "maps", "sp" ) )

    # get the latitude and longitude ranges
    latRange <- range( lat )
    lonRange <- range( lon )

    # download a map of the area
    mapObject <- maps::map( database = "world",
                            xlim = lonRange,
                            ylim = latRange,
                            fill = TRUE
    )

    # create an empty matrix to fill
    map <- array( data = NA,
                  dim = c( dim( lat ), 3 )
    )

    # fill 2 layers for latitude and longitude values
    map[ , , 2 ] <- c( rep( seq.int( from = max( latRange ),
                                     to = min( latRange ),
                                     length.out = dim( lat )[ 1 ] ),
                            dim( lat )[ 2 ] )
    )
    map[ , , 3 ] <- sort( c( rep( seq.int( from = min( lonRange ),
                                           to = max( lonRange ),
                                           length.out = dim( lon )[ 2 ] ),
                                  dim( lon )[ 1 ] ) )
    )


    # get the latitude and longitude coordinates from the mapObject
    coords.matrix <- matrix( c( mapObject$x, mapObject$y ), ncol = 2 )

    # extract the divisions (between polygon lines) from the mapObject
    div <- c( 0, which( is.na( mapObject$x ) ), length( mapObject$x ) + 1 )

    # separate coordinates by divisions
    coords.list <- sapply( 1:( length( div ) - 1 ), 
                           function( x ) {
                               coords.matrix[ ( div[ x ] + 1 ) : ( div[ x + 1 ] - 1 ), ]
                           } )

    ## change sets of coordinates into SpatialPolygons
    map.spatial <- sapply( coords.list, function( x ) { sp::Polygon( x ) } )
    map.spatial <- sp::Polygons( map.spatial, ID = "a" )
    map.spatial <- list( map.spatial )
    map.spatial <- sp::SpatialPolygons( map.spatial )

    # analyse each point to see whether it's land or water
    doMC::registerDoMC( cores = cores )
    land.water <- plyr::aaply( .data = map, 
                               .margins = c( 1, 2 ), 
                               .fun = function(x) {
                                   rgeos::gContains( map.spatial, 
                                                     sp::SpatialPoints( 
                                                         matrix( c( x[ 3 ], x[ 2 ] ), ncol = 2 )
                                                     ) )
                               },
                               .parallel = T )

    # change boolean to binary and combine
    map[ , , 1 ] <- as.integer( land.water )

    return( map )

}

现在尝试已经讨论的区域的功能。我将以100x100的价格与@ cuttlefish44&#34;&#34;奖金&#34;进行比较。

rows <- cols <- 100L

lat <- rep( seq.int( from = 10, to = 50, length.out = cols ), rows )
lon <- sort( rep( seq.int( from = 100, to = 150, length.out = rows ), cols ) )

lat <- matrix( data = lat, nrow = rows, ncol = cols )
lon <- matrix( data = lon, nrow = rows, ncol = cols )

system.time(
    landMask( lat = lat, lon = lon, cores = 4 )
)

来自system.time的结果,这个过程需要30多秒。不是超级快,但可以根据我的需要进行管理:

   user  system elapsed 
 60.127   3.050  31.786 

*我使用的是四核i7 MacBook Pro。