使用高度和土地覆盖

时间:2018-02-20 05:41:53

标签: r gis distance

我想从我的区域上的多个兴趣点(n~150)计算累积成本(时间)表面,然后提取其他GPS坐标(~70,000)的成本栅格值。因此,我的最终目标是估计每个GPS坐标到最近的兴趣点的旅行时间。需要考虑每个细胞的两种阻力措施:海拔和土地覆盖。我正在使用包gdistance和Tobler的徒步旅行功能。我从GRASS(使用Naismith-Langmuir算法)和AccessMod获得了其他估计。由于使用不同的算法,估计值与GRASS实施方式不同,但它们与AccessMod估计值的差别不大,因为我试图尽可能地阅读手册来复制他们的方法。但是,gdistance估计值与AcessMod估计值之间的平均差值约为20分钟,最大差值为3小时。

是否有人愿意审核我的代码并提出可能解释差异的修改建议?我使用公共和简化的数据集重新创建了我的代码。

library(gdistance)
library(sp)

# load DEM and create polygon to build example
dem <- raster(system.file("external/maungawhau.grd", package="gdistance"))
e <- extent(dem); crs <- projection(dem)
poly <- as(e, 'SpatialPolygons')
crs(poly) <- crs
# points of interest
set.seed(1)
poi <- spsample(poly, 10, type="random")
# GPS locations of "ending" points
ends <- spsample(poly, 50, type="random")
#confirm creation of sample points
plot(dem)
points(poi, col="red")
points(ends, col="blue")

# create slope friction layer from DEM
altDiff <- function(x) {x[2]-x[1]}
hd <- transition(dem, altDiff, 8, symm=FALSE)
slope <- geoCorrection(hd)

# create landcover friction layer
lc <- raster(replicate(61,sample(1:5,87,rep=TRUE))) #landcover layer categorized by class
wlk <- data.frame(class = c(1,2,3,4,5), wlkspeed = c(0.66,0.25,0.25,2.7,3.4)) #walking speed (m/s) on flat ground for each landcover class
lc_friction <- subs(lc, wlk, by=1, which=2) #create resistance raster of speeds
lc_T <- transition(lc_friction, function(x) 1/mean(x), 8, symm=FALSE) 

#calculate Tobler's hiking function for each cell and its neighboring 8 cells then build cumulative cost surface and extract value at each "end"
adj <- adjacent(dem, cells=1:ncell(dem), pairs=TRUE, directions=8)
speed <- slope
speed[adj] <- lc_T[adj]*exp(-3.5*abs(slope[adj] + 0.05)) #Tobler's function with corrected walking speed as coefficient
conductance <- geoCorrection(speed)
access <- accCost(conductance, poi)
access[!is.finite(access)] <- NA
summary(values(access))
access_ends <- extract(access, ends)
seconds <- access_ends
minutes <- access_ends/60

#plot result
plot(access)
points(poi, col="red")
points(ends, col="blue")

0 个答案:

没有答案