R栅格包中的提取和重新采样函数:区域加权值

时间:2017-04-25 09:05:02

标签: r extract r-raster

我也在other forum发了这个帖子,但由于我真的需要回复,我再次在这里发帖。

我在R中工作,想要计算从栅格的交叉单元格派生的多边形的值。该值应考虑每个交叉单元格的权重。当我尝试运行"提取"使用样本栅格和多边形的函数我得到的是与我手动计算的权重不同的权重,导致不同的最终值。

以下是我的示例代码:

require(raster)
r <- raster(nrow=2, ncol=2, xmn=-180, xmx=60, ymn=-30, ymx=90)   
r[] <- c(1,2,4,5)    
s <- raster(xmn=-120, xmx=-40, ymn=20, ymx=60, nrow=1, ncol=1)    
s.pl <- as(s, 'SpatialPolygons')    
w <- raster::extract(r, s.pl, method="simple",weights=T, normalizeWeights=F)    
mean.value <- raster::extract(r, s.pl, method="simple",weights=T, fun=mean) 

我得到的值是2.14但是根据单元格的实际权重它应该是2.更具体地说,对于与不同单元格相交的多边形的每个部分,数据是:

 Area Value
 1800 1
  600 2
  600 4
  200 5

因此基于上面的多边形的最终值应为2。

是否可以因为lat / lon中的投影?但即使我以米为单位指定投影,我也有相同的结果。如何获得我感兴趣的2的值?我也试过&#34; resample&#34;功能,但我也得到不同的结果。

我的最终目标是创建一个具有与原始栅格不同的分辨率和范围的新栅格,并根据与新栅格的像元相交的原始栅格的像元的权重来分配值。但似乎重新取样和提取函数都没有给出预期的结果。

1 个答案:

答案 0 :(得分:0)

以下是我根据this帖子的回复设法做的事情。

require(raster)
require(rgeos)
r <- raster(nrow=2, ncol=2, xmn=-180, xmx=60, ymn=-30, ymx=90)    
r[] <- c(1,2,4,5)    
r <- stack(r, r*2, r^2)
s <- raster(xmn=-120, xmx=-40, ymn=20, ymx=60, nrow=1, ncol=1)    
s.pl <- as(s, 'SpatialPolygons')    
r.s <- as(r, 'SpatialPolygonsDataFrame')
pi1 <- gIntersection(r.s, s.pl, byid = T)
areas1 <- data.frame(area=sapply(pi1@polygons, FUN=function(x) {slot(x, 'area')}))
row.names(areas1) <- sapply(pi1@polygons, FUN=function(x) {slot(x, 'ID')})
areas1$Pol.old <- as.numeric(vapply(strsplit(rownames(areas1), " "), `[`, 1, FUN.VALUE=character(1)))
areas1$pol.new <- as.numeric(vapply(strsplit(rownames(areas1), " "), `[`, 2, FUN.VALUE=character(1)))
f <- r.s@data
seqs <- match(areas1$Pol.old, rownames(f))
ar <- cbind(areas1, f[seqs,])
ar[,-(1:3)] <- ar[,-(1:3)]*ar$area
f <- aggregate.data.frame(ar, by=list(ar$pol.new), FUN=sum)
f[,-(1:4)] <- f[,-(1:4)]/f$area  
ar.v <- as.matrix(f[, -c(1:4)])
s2 <- stack(s)
s1 <- setValues(s2, ar.v)

如果有人可以建议更好和/或更快的代码,请告诉我,因为我不太喜欢我的方法。