선 모양 파일을 래스터로 변환, 값 = 셀 내 총 선 길이

도로 네트워크를 나타내는 선 모양 파일이 있습니다. 이 데이터를 래스터 화하고 래스터의 결과 값이 래스터 셀에 속하는 선의 총 길이를 보여줍니다.

데이터는 영국 내셔널 그리드 (British National Grid) 투영에 있으므로 단위는 미터입니다.

이상적으로는을 사용 하여이 작업을 수행하고 싶습니다 . 패키지 R의 rasterize함수가 raster이것을 달성하는 데 도움이 될 것이라고 추측합니다. 어떤 함수가 적용되어야하는지 해결할 수는 없습니다.

최근 질문에 이어 rgeos 패키지에서 제공하는 기능을 사용 하여 문제를 해결할 수 있습니다. 재현성의 이유로 DIVA-GIS 에서 탄자니아 도로 모양 파일을 다운로드하여 현재 작업 디렉토리에 넣었습니다. 다음 작업에는 세 가지 패키지가 필요합니다.

• 일반적인 공간 데이터 처리를위한 rgdal
• 래스터 Shape 파일 데이터에 대한 래스터
• 래스터 템플릿으로 도로의 교차점을 확인하고 도로 길이를 계산하는 rgeos

결과적으로 첫 줄은 다음과 같아야합니다.

library(rgdal)
library(raster)
library(rgeos)

그런 다음 shapefile 데이터를 가져와야합니다. DIVA-GIS 셰이프 파일은 EPSG : 4326으로 ​​배포되므로 셰이프 파일을 EPSG : 21037 (UTM 37S)로 투영하여 각도가 아닌 미터를 처리합니다.

roads <- readOGR(dsn = ".", layer = "TZA_roads")
roads_utm <- spTransform(roads, CRS("+init=epsg:21037"))

후속 래스터 화를 위해서는 모양 파일의 공간 범위를 포함하는 래스터 템플릿이 필요합니다. 래스터 템플릿은 기본적으로 10 개의 행과 10 개의 열로 구성되므로 계산 시간이 너무 길지 않습니다.

roads_utm_rst <- raster(extent(roads_utm), crs = projection(roads_utm))

이제 템플릿이 설정되었으므로 래스터의 모든 셀을 반복합니다 (현재 NA 값으로 만 구성됨). 현재 셀에 '1'값을 할당 한 다음을 실행 rasterToPolygons하면 결과 모양 파일 'tmp_shp'가 현재 처리 된 픽셀의 범위를 자동으로 유지합니다. gIntersects이 범위가 도로와 겹치는 지 여부를 감지합니다. 그렇지 않으면 함수는 '0'값을 리턴합니다. 그렇지 않으면, 도로 모양 파일이 현재 셀에 의해 잘리고 해당 셀 내 'SpatialLines'의 총 길이는를 사용하여 계산됩니다 gLength.

lengths <- sapply(1:ncell(roads_utm_rst), function(i) {
  tmp_rst <- roads_utm_rst
  tmp_rst[i] <- 1
  tmp_shp <- rasterToPolygons(tmp_rst)

  if (gIntersects(roads_utm, tmp_shp)) {
    roads_utm_crp <- crop(roads_utm, tmp_shp)
    roads_utm_crp_length <- gLength(roads_utm_crp)
    return(roads_utm_crp_length)
  } else {
    return(0)
  }
})

마지막으로 계산 된 길이 (킬로미터로 변환 된)를 래스터 템플릿에 삽입하고 결과를 시각적으로 확인할 수 있습니다.

roads_utm_rst[] <- lengths / 1000

library(RColorBrewer)
spplot(roads_utm_rst, scales = list(draw = TRUE), xlab = "x", ylab = "y", 
       col.regions = colorRampPalette(brewer.pal(9, "YlOrRd")), 
       sp.layout = list("sp.lines", roads_utm), 
       par.settings = list(fontsize = list(text = 15)), at = seq(0, 1800, 200))

아래는 Jeffrey Evans의 솔루션에서 수정되었습니다. 이 솔루션은 래스터 화를 사용하지 않기 때문에 훨씬 빠릅니다.

library(raster)
library(rgdal)
library(rgeos)

roads <- shapefile("TZA_roads.shp")
roads <- spTransform(roads, CRS("+proj=utm +zone=37 +south +datum=WGS84"))
rs <- raster(extent(roads), crs=projection(roads))
rs[] <- 1:ncell(rs)

# Intersect lines with raster "polygons" and add length to new lines segments
rsp <- rasterToPolygons(rs)
rp <- intersect(roads, rsp)
rp$length <- gLength(rp, byid=TRUE) / 1000
x <- tapply(rp$length, rp$layer, sum)
r <- raster(rs)
r[as.integer(names(x))] <- x

for 루프가 필요하지 않습니다. 모든 것을 한 번에 교차 한 다음 sp의 "SpatialLinesLengths"함수를 사용하여 새 선 세그먼트에 선 길이를 추가하십시오. 그런 다음 fun = sum 인수와 함께 래스터 패키지 래스터 화 함수를 사용하여 각 셀을 교차하는 선 길이의 합으로 래스터를 만들 수 있습니다. 위의 답변과 관련 데이터를 사용하면 동일한 결과를 생성하는 코드가 있습니다.

require(rgdal)
require(raster)
require(sp)
require(rgeos)

setwd("D:/TEST/RDSUM")
roads <- readOGR(getwd(), "TZA_roads")
  roads <- spTransform(roads, CRS("+init=epsg:21037"))
    rrst <- raster(extent(roads), crs=projection(roads))

# Intersect lines with raster "polygons" and add length to new lines segments
rrst.poly <- rasterToPolygons(rrst)
  rp <- gIntersection(roads, rrst.poly, byid=TRUE)
    rp <- SpatialLinesDataFrame(rp, data.frame(row.names=sapply(slot(rp, "lines"), 
                               function(x) slot(x, "ID")), ID=1:length(rp), 
                               length=SpatialLinesLengths(rp)/1000) ) 

# Rasterize using sum of intersected lines                            
rd.rst <- rasterize(rp, rrst, field="length", fun="sum")

# Plot results
require(RColorBrewer)
spplot(rd.rst, scales = list(draw=TRUE), xlab="x", ylab="y", 
       col.regions=colorRampPalette(brewer.pal(9, "YlOrRd")), 
       sp.layout=list("sp.lines", rp), 
       par.settings=list(fontsize=list(text=15)), at=seq(0, 1800, 200))

또 다른 접근법이 있습니다. spatstat패키지 를 사용하여 이미 제공된 것과 다릅니다 . 내가 알 수있는 한,이 패키지에는 자체 버전의 공간 객체 (예 im: raster객체 대 )가 있지만 maptools패키지는 spatstat객체와 표준 공간 객체 사이에서 앞뒤로 변환 할 수 있습니다.

이 접근법은 이 R-sig-Geo post 에서 가져 왔습니다 .

require(sp)
require(raster)
require(rgdal)
require(spatstat)
require(maptools)
require(RColorBrewer)

# Load data and transform to UTM
roads <- shapefile('data/TZA_roads.shp')
roadsUTM <- spTransform(roads, CRS("+init=epsg:21037"))

# Need to convert to a line segment pattern object with maptools
roadsPSP <- as.psp(as(roadsUTM, 'SpatialLines'))

# Calculate lengths per cell
roadLengthIM <- pixellate.psp(roadsUTM, dimyx=10)

# Convert pixel image to raster in km
roadLength <- raster(dtanz / 1000, crs=projection(roadsUTM))

# Plot
spplot(rtanz, scales = list(draw=TRUE), xlab="x", ylab="y", 
       col.regions=colorRampPalette(brewer.pal(9, "YlOrRd")), 
       sp.layout=list("sp.lines", roadsUTM), 
       par.settings=list(fontsize=list(text=15)), at=seq(0, 1800, 200))

가장 느린 비트는 도로를 SpatialLines선분 패턴 (즉, spatstat::psp)으로 변환하는 것 입니다. 그것이 완료되면 실제 길이 계산 부분은 훨씬 더 높은 해상도에서도 매우 빠릅니다. 예를 들어, 이전 2009 MacBook에서 :

system.time(pixellate(tanzpsp, dimyx=10))
#    user  system elapsed 
#   0.007   0.001   0.007

system.time(pixellate(tanzpsp, dimyx=1000))
#    user  system elapsed 
#   0.146   0.032   0.178 

공간 라인을 작동시키고 sf 와 데이터를 가져 오는 몇 가지 기능을 가진 패키지 정맥 을 제시하겠습니다.

library(vein)
library(sf)
library(cptcity)
data(net)
netsf <- st_as_sf(net) #Convert Spatial to sf
netsf <- st_transform(netsf, 31983) # Project data
netsf$length_m  <- st_length(netsf)
netsf <- netsf[, "length_m"]
g <- make_grid(netsf, width = 1000) #Creat grid of 1000m spacing with columns id for each feature
# Number of lon points: 12
# Number of lat points: 11

gnet <- emis_grid(netsf, g)
plot(gnet["length_m"])

sf_to_raster <- function(x, column, ncol, nrow){
  x <- sf::as_Spatial(x)
  r <- raster::raster(ncol = ncol, nrow = nrow)
  raster::extent(r) <- raster::extent(x)
  r <- raster::rasterize(x, r, column)
  return(r)
}

rr <- sf_to_raster(gnet, "length_m", 12, 11)
spplot(rr, sp.layout = list("sp.lines", as_Spatial(netsf)),
       col.regions = cpt(), scales = list(draw = T))
spplot(rr, sp.layout = list("sp.lines", as_Spatial(netsf)),
       col.regions = cpt(pal = 5176), scales = list(draw = T))
spplot(rr, sp.layout = list("sp.lines", as_Spatial(netsf)),
       col.regions = lucky(), scales = list(draw = T))
# Colour gradient: neota_flor_apple_green, number: 6165

순진하게 들릴지 모르지만 도로 시스템 인 경우 도로를 선택하고 클립 보드에 저장 한 다음 클립 보드에 버퍼를 추가하여 도로의 법적 폭 (예 : 3 미터)에 버퍼를 추가 할 수있는 도구를 찾으십시오. +/- 버퍼는 중앙선에서 가장자리까지 * 2 i이므로 3 미터 버퍼는 실제로 좌우로 6 미터입니다.