ラインシェープファイルをラスターに変換、値=セル内のラインの全長

道路ネットワークを表すラインシェープファイルがあります。このデータをラスター化して、ラスターの結果値がラスターセル内に収まるラインの全長を表示するようにします。

データはBritish National Gridプロジェクションにあるため、単位はメートルになります。

理想的には、を使用してこの操作を実行したいと思いますが、パッケージRのrasterize機能がrasterこれを達成するのに役立つと推測していますが、適用される機能がどうあるべきかわかりません。

最近の質問に続いて、問題を解決するためにrgeosパッケージが提供する機能を利用したいと思うかもしれません。再現性の理由から、タンザニアの道路のシェープファイルをDIVA-GISからダウンロードし、現在の作業ディレクトリに配置しました。今後のタスクには、3つのパッケージが必要です。

• 一般的な空間データ処理のためのrgdal
• ラスタシェープファイルデータのラスタライズのために
• rgeosは、ラスターテンプレートと道路の交差点を確認し、道路の長さを計算します

したがって、最初の行は次のようになります。

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

その後、シェープファイルデータをインポートする必要があります。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の投稿から取られています。

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 

私はあなたのパッケージ提示してみましょう静脈空間線や輸入動作するようにいくつかの機能とを平方フィートをしてdata.table

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

これは少し素朴に聞こえるかもしれませんが、道路システムの場合、道路を選択してクリップボードに保存し、クリップボードにバッファーを追加できるツールを見つけます。 +/-バッファは中心線から端まで* 2 iであり、3メートルのバッファは実際には6メートルの道路であることに注意してください。