আমার কাছে একটি রোড নেটওয়ার্ক উপস্থাপন করে একটি লাইন শেফফাইল রয়েছে। আমি এই ডেটাটিকে রাস্টারাইজ করতে চাই, রাস্টারগুলিতে ফলাফলের মানগুলির সাথে রাস্টার কোষের মধ্যে থাকা রেখাগুলির মোট দৈর্ঘ্য দেখায়।
ডেটা ব্রিটিশ ন্যাশনাল গ্রিড প্রক্ষেপণে তাই ইউনিটগুলি মিটার হবে।
আদর্শভাবে আমি এই অপারেশনটি ব্যবহার করে সম্পাদন করতে চাই Rএবং আমি অনুমান করছি যে প্যাকেজটির rasterizeক্রিয়াকলাপটি এটি rasterঅর্জনে ভূমিকা রাখবে, আমি কীভাবে প্রয়োগ করা ফাংশনটি হতে হবে তা ঠিক কাজ করতে পারি না।
উত্তর:
একটি অনুসরণ সাম্প্রতিক প্রশ্ন , আপনি দ্বারা প্রদত্ত বৈশিষ্ট্য ব্যবহার করতে চাইতে পারেন rgeos আপনার সমস্যা সমাধানের জন্য প্যাকেজ। পুনরুত্পাদনযোগ্যতার কারণে, আমি ডিআইভিএ -জিআইএস থেকে তানজানিয়ান রাস্তার একটি শেফফাইল ডাউনলোড করেছি এবং এটি আমার বর্তমান কার্যনির্বাহী ডিরেক্টরিতে রেখেছি। আসন্ন কাজের জন্য আপনার তিনটি প্যাকেজ দরকার:
ফলস্বরূপ, আপনার প্রথম লাইনগুলি দেখতে দেখতে পারা উচিত:
library(rgdal)
library(raster)
library(rgeos)এর পরে, আপনাকে শেফফাইল ডেটা আমদানি করতে হবে। নোট করুন যে ডিআইভা-জিআইএস শেফফিলগুলি EPSG: 4326 এ বিতরণ করা হয়েছে, তাই আমি ডিগ্রির পরিবর্তে মিটারগুলি মোকাবেলায় ইপিএসজি: 21037 (ইউটিএম 37 এস) এ শেফফিলটি প্রজেক্ট করব।
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))এখন যে টেমপ্লেটটি সেট আপ করা হয়েছে, রাস্টারটির সমস্ত কক্ষের মধ্য দিয়ে লুপ করুন (বর্তমানে এটি কেবল এনএ মান ধারণ করে)। বর্তমান কক্ষের জন্য '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)
}
})শেষ অবধি, আপনি গণনাকারী দৈর্ঘ্য (যা কিলোমিটারে রূপান্তরিত হয়) রাস্টার টেম্পলেটে sertোকাতে এবং আপনার ফলাফলগুলি দৃশ্যত যাচাই করতে পারেন।
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(যদিও আমার মেশিনের উপরের
rasterize()ফাংশনটিতে এমন সমস্ত লাইন অন্তর্ভুক্ত রয়েছে যা প্রদত্ত কক্ষে স্পর্শ করে । লাইন বিভাগের দৈর্ঘ্যের ফলস্বরূপ কিছু ক্ষেত্রে দু'বার গণনা করা হচ্ছে: একবার সেলটিতে তাদের ধারণা করা হয় এবং একবার সংলগ্ন ঘরে যে লাইনটি শেষ পয়েন্টটি কেবল স্পর্শ করে।
এখানে আরও একটি উপায়। এটি spatstatপ্যাকেজ ব্যবহার করে ইতিমধ্যে প্রদত্তদের থেকে বিচ্যুত হয় । আমি যতদূর বলতে পারি, এই প্যাকেজটির স্থানিক অবজেক্টগুলির নিজস্ব সংস্করণ রয়েছে (যেমন imবনাম। rasterঅবজেক্টস), তবে maptoolsপ্যাকেজটি spatstatঅবজেক্ট এবং স্ট্যান্ডার্ড স্পেসিয়াল অবজেক্টগুলির মধ্যে পিছনে রূপান্তর করতে দেয় ।
এই পন্থাটি এই আর-সিগ-জিও পোস্ট থেকে নেওয়া হয়েছে ।
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) রূপান্তর করছে । এটি শেষ হয়ে গেলে প্রকৃত দৈর্ঘ্যের গণনার অংশগুলি বেশ দ্রুত, এমনকি অনেক উচ্চ রেজোলিউশনের জন্যও। উদাহরণস্বরূপ, আমার পুরানো ২০০৯ ম্যাকবুকটিতে:
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')পারে সাহায্য করতে পারে।