मेरे पास सड़क नेटवर्क का प्रतिनिधित्व करने वाली एक रेखा आकृति है। मैं इस डेटा को रेखापुंज करना चाहता हूँ, जिसके परिणामस्वरूप रेखापुंज में रेखीय मानों की कुल लंबाई दिखाई देती है, जो रास्टर सेल के भीतर आती है।
डेटा ब्रिटिश नेशनल ग्रिड प्रोजेक्शन में है इसलिए इकाइयां मीटर होंगी।
आदर्श रूप से मैं इस ऑपरेशन का उपयोग करना चाहूंगा R, और मुझे लगता है कि पैकेज rasterizeसे फ़ंक्शन rasterइसे प्राप्त करने में एक भूमिका निभाएगा, मैं अभी यह काम नहीं कर सकता कि लागू फ़ंक्शन क्या होना चाहिए।
जवाबों:
हाल ही के एक प्रश्न के बाद , आप अपनी समस्या को हल करने के लिए rgeos पैकेज द्वारा दी गई कार्यप्रणाली का उपयोग करना चाहते हैं । प्रजनन क्षमता के कारणों के लिए, मैंने DIVA-GIS से तंजानिया की सड़कों का एक आकार-प्रकार डाउनलोड किया और इसे अपनी वर्तमान कार्यशील निर्देशिका में रखा। आगामी कार्यों के लिए, आपको तीन पैकेजों की आवश्यकता होगी:
नतीजतन, आपकी पहली लाइनें इस तरह दिखनी चाहिए:
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))
sapply()किया pbsapply()और उसका उपयोग किया cl = detectCores()-1। अब मैं इस उदाहरण को समानांतर में चलाने में सक्षम हूं!
नीचे जेफरी इवांस के समाधान से संशोधित किया गया है। यह समाधान बहुत तेज़ है क्योंकि यह रैस्टराइज़ का उपयोग नहीं करता है
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))] <- xraster::intersect() था, मुझे यह पसंद है कि यह विपरीत सुविधाओं को जोड़ती है, इसके विपरीत rgeos::gIntersection()।
आपको लूप की आवश्यकता नहीं है। बस एक ही बार में सब कुछ इंटरसेक्ट करें और फिर "स्पैटियल लाईन लैंथर्स" फ़ंक्शन का उपयोग करके नई लाइन सेगमेंट में लाइन की लंबाई जोड़ें। फिर, रैस्टर पैकेज का उपयोग करके फन = सम तर्क के साथ फ़ंक्शन को व्यवस्थित करें आप प्रत्येक सेल को प्रतिच्छेद करते हुए लाइन की लंबाई (एस) के साथ एक रास्टर बना सकते हैं। उपरोक्त उत्तर और संबंधित डेटा का उपयोग करना यहां कोड है जो समान परिणाम उत्पन्न करेगा।
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))SpatialLinesLengths। लगता है कि यह सीखने में कभी देर नहीं हुई है, धन्यवाद (: rasterizeमेरी मशीन के ऊपरी दृष्टिकोण की तुलना में 7 गुना लंबा, हालांकि, काफी लंबा समय लगता है)।
rasterize()फंक्शन में वे सभी लाइनें शामिल हैं जो किसी दिए गए सेल को छूती हैं । इसके परिणामस्वरूप सेगमेंट की लंबाई कुछ मामलों में दो बार गिनी जाती है: एक बार सेल में एक बार वे और एक बार आसन्न सेल में जिसे लाइन एंडपॉइंट सिर्फ छूता है।
यहाँ एक और दृष्टिकोण है। यह उन लोगों से विचलित होता है जो पहले से ही 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 मैकबुक पर:
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 और 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 मीटर की सड़क है।
vignette('over', package = 'sp')मदद कर सकता है।