Преобразовать шейп-файл линии в растр, значение = общая длина линий в ячейке

У меня есть линейный шейп-файл, представляющий дорожную сеть. Я хочу растеризовать эти данные, в результате чего полученные значения в растре показывают общую длину линий, которые попадают в растровую ячейку.

Данные представлены в проекции Британской национальной сети, поэтому единицы измерения будут метрами.

В идеале я хотел бы выполнить эту операцию с использованием R, и я предполагаю, что rasterizeфункция из rasterпакета сыграет свою роль в достижении этого, я просто не могу понять, какой должна быть примененная функция.

После недавнего вопроса вы можете использовать функции, предлагаемые пакетом rgeos , для решения вашей проблемы. В целях воспроизводимости я загрузил шейп-файл танзанийских дорог из DIVA-GIS и поместил его в свой текущий рабочий каталог. Для предстоящих задач вам понадобятся три пакета:

• 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». В противном случае шейп-файл дороги обрезается текущей ячейкой, а общая длина «Пространственные линии» в этой ячейке рассчитывается с использованием 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))

Ниже приведено изменение решения Джеффри Эванса. Это решение намного быстрее, так как не использует растеризацию

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. Просто пересекайте все сразу, а затем добавьте длины линий к новым отрезкам, используя функцию SpatialLinesLengths в sp. Затем, используя функцию растрирования пакета растра с аргументом 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). Как только это будет сделано, вычисление фактической длины будет довольно быстрым, даже для гораздо более высоких разрешений. Например, на моем старом MacBook 2009 года:

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

Это может показаться немного наивным, но если это система дорог, выберите дороги и сохраните их в буфер обмена, а затем найдите инструмент, который позволяет добавить буфер в буфер обмена, установив его равной ширине дороги, то есть 3 метра. +/- помните, что буфер находится от центральной линии до края * 2 i для каждой стороны, поэтому 3-метровый буфер - это фактически 6-метровая дорога из стороны в сторону.