Toy data
library(terra)
template_raster <- rast(xmin=0, xmax=10, ymin=0, ymax=10, crs="+proj=longlat +datum=WGS84 +no_defs +type=crs", resolution = 0.1)
values(template_raster) <- c(rep(NA,4000),rep(10,2000),rep(NA,4000))
polygon_to_rasterize <- as.polygons(ext(3, 6, 3, 6), crs="+proj=longlat +datum=WGS84")
polygon_to_rasterize$polygon_val <- 20
plot(template_raster)
plot(polygon_to_rasterize, add=T)
Problem
I want to rasterize my polygon, but only in the area where there is data in my template raster, also I want my resultant raster to have the same dimensions as the template. I can do it in two steps here I think.
rasterized_polygon <- rasterize(polygon_to_rasterize, template_raster, filename = "temp.tif")
rasterized_polygon_only_where_template_data <- mask(rasterized_polygon, template_raster, filename = "temp2.tif")
plot(rasterized_polygon_only_where_template_data)
The result looks correct. But as I have to do this for over 50,000 layers, I am hoping it can be done in one line, rather than writing an intermediate file (temp.tif). Any ideas please?
Your example data (with more agreeable variable names)
library(terra)
r <- rast(xmin=0, xmax=10, ymin=0, ymax=10, crs="+proj=longlat +datum=WGS84 +no_defs +type=crs", resolution = 0.1)
values(r) <- c(rep(NA,4000),rep(10,2000),rep(NA,4000))
p <- as.polygons(ext(3, 6, 3, 6), crs="+proj=longlat +datum=WGS84")
p$val <- 20
Here are three approaches.
a)
x <- rasterize(p, r) |> mask(r)
b)
y <- rasterize(p, r, "val") |> mask(r)
c)
z <- mask(r, p)
(a) is your two-step approach. The values of x are 1.
(b) is a slightly modified approach to transfer the values of p to the raster (the values of y are 20)
(c) is in one step, and the result is similar in that it gets you the same area (cells with a value; and this is what Allan Cameron suggested). The remaining values of z are what they were in r (10).
It is not entirely clear if the output cell values matter to you; or what you would like them to be.
I understand it could be nice to mask and change the values in one step, but it may be better to have two methods with clear arguments that are easy to understand?
If you are working with many rasters with the same extent and resolution, but only one polygon, then it would be much more efficient to rasterize the polygons once and use that raster for masking.
Of course, you are not required to write the intermediate rasters to files, but I assume that you are working with large datasets and these will be written automatically if you do not do so yourself.
Related
I'm putting together some training materials for a workshop on R for spatial data analysis in archaeology, and need to anonymize the true site locations (confidential information) while keeping the spatial integrity of the features within the site's bounding box.
My initial thought is to subtract the minimum X & Y values of the bounding box (all are in UTM coords) from all of the geometries - i.e., make the whole thing an arbitrary relative grid.
I have ESRI point and polygon shapefiles imported to R with sf, and some rasters loaded with terra but not sure how to go about doing the global spatial adjustment for either.
I also use QGIS, so some solution through there to pre-process the geometries before loading to R would work as well - but again, don't know how to do that.
Here is how you can do that.
Original data:
library(terra)
r <- rast(system.file("ex/elev.tif", package="terra"))
v <- vect(system.file("ex/lux.shp", package="terra"))
p <- spatSample(v, 10)
plot(r)
lines(v)
points(p)
Shift and rotate
# move to different location
rs <- shift(r, -10, 10)
vs <- shift(v, -10, 10)
ps <- shift(p, -10, 10)
# rotate
rst <- t(rs)
e <- ext(rst)
x0 = e[2] + (e[2]-e[2])/2
x1 = e[3] + (e[4]-e[3])/2
vst <- t(vs) |> spin(180, x0, x1)
pst <- t(ps) |> spin(180, x0, x1)
plot(rst)
lines(vst)
points(pst)
Of course if you know the true location of some places on the map, e.g. if you know this is Luxembourg, it is not too difficult to reverse engineer and get the original data.
You could also add some jitter to the points:
xy <- crds(pst)
xy <- xy + runif(length(xy), -0.05, 0.05)
pstj <- vect(xy)
Set a fake coordinate reference system to all the datasets, like
crs(pstj) <- "+proj=utm +zone=23"
And save the data like this
writeVector(pstj, "sites.shp")
writeRaster(rst, "grid.shp")
I have a few very small country-level polygon and point shapefiles that I would like to rasterize in R. The final product should be one global binary raster (indicating whether grid cell center is covered by a polygon / point lies within cell or not). My approach is to loop over the shapefiles and do the following for each shapefile:
# load shapefile
shp = sf::read_sf(shapefile_path)
# create a global raster template with resolution 0.0083
ext = extent(-180.0042, 180.0042, -65.00417, 75.00417)
gridsize = 0.008333333
r = raster(ext, res = gridsize)
# rasterize polygon or point shapefile to raster
rr = rasterize(shp, r, background = 0) #all grid cells that are not covered get 0
# convert to binary raster
values(rr)[values(rr)>0] = 1
Here, rr is the raster file where the polygons / points in shp are coded as 1 and all other grid cells are coded as 0. Afterwards, I take the sum over all rr to arrive at one global binary raster file including all polygons / points.
The final two steps are incredibly slow. In addition, I get RAM problems when I try to replace the all positive values in rr with 1 as the cell count is very large due to the fine resolution. I was wondering whether it is possible to come up with a smarter solution for what I'd like to achieve.
I have already found the fasterize package that has a speedy implementation of rasterize which works fine. I think it would be of great help if someone has a solution where rasterize directly returns a binary raster.
This is how you can do this better with raster. Note the value=1 argument, and also that that I changed your specification of the extent -- as what you do is probably not correct.
library(raster)
v <- shapefile(shapefile_path)
ext <- extent(-180, 180, -65, 75)
r <- raster(ext, res = 1/120)
rr <- rasterize(v, r, value=1, background = 0)
There is no need for your last step, but you could have done
rr <- clamp(rr, 0, 1)
# or
rr <- rr > 0
# or
rr <- reclassify(rr, cbind(1, Inf, 1))
raster::calc is not very efficient for simple arithmetic like this
It should be much faster to rasterize all vector data in one step, rather than in a loop, especially with large rasters like this (for which the program may need to write a temp file for each iteration).
To illustrate this solution with example data
library(raster)
cds1 <- rbind(c(-180,-20), c(-140,55), c(10, 0), c(-140,-60))
cds2 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55))
cds3 <- rbind(c(-125,0), c(0,60), c(40,5), c(15,-45))
v <- spLines(cds1, cds2, cds3)
r <- raster(ncols=90, nrows=45)
r <- rasterize(v, r, field=1)
To speed things up, you can use terra (the replacement for raster)
library(raster)
f <- system.file("ex/lux.shp", package="terra")
v <- as.lines(vect(f))
r <- rast(v, ncol=75, nrow=100)
x <- rasterize(v, r, field=1)
Something that seems to work computationally and significantly improves computation time is to
Create one large shapefile shp instead of working with individual rasterized shapefiles.
Use the fasterize package to rasterize the merged shapefile.
Use raster::calc to avoid memory problems.
ext = extent(-180.0042, 180.0042, -65.00417, 75.00417)
gridsize = 0.008333333
r = raster(ext, res=gridsize)
rr = fasterize(shp, r, background = 0) #all not covered cells get 0, others get sum
# convert to binary raster
fun = function(x) {x[x>0] <- 1; return(x) }
r2 = raster::calc(rr, fun)
I've got a map with certain number of points on it. I want to (1) calculate the number of points that fall within the raster layer, and (2) extract these points to a data frame.
This is what I've done:
# Packages
library(raster)
library(ggplot2)
library(maptools)
library(tidyverse)
library(dplyr)
library(sp)
# Transform tree ring kml to dataframe
zz<-getKMLcoordinates('treering.kml', ignoreAltitude=TRUE)
l<-as.data.frame(zz)
l<-t(l)
tree <-SpatialPointsDataFrame(l, l,
proj4string = CRS(" +proj=longlat +ellps=WGS84 +datum=WGS84
+no_defs +towgs84=0,0,0"))
# Get world map
data(wrld_simpl)
# Transform World to raster
r <- raster(wrld_simpl, res = 1)
wrld_r <- rasterize(wrld_simpl, r)
# Import permafrost layer to raster
dist1<-raster("PZI.flt")
# Set CRS
dist1 <- projectRaster(from = dist1, crs = CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs
+towgs84=0,0,0"))
# Change colours
micolor <- rev(rainbow(12, alpha = 0.35))
transp <- rainbow(12, alpha = 0)
micolor[1:3] <- transp[1]
# Plot all
plot(wrld_r, col = "lightgrey")
plot(dist1, add=TRUE, legend = F, col = micolor)
plot(tree, add=T, pch = 20, col='black', cex=0.2)
I want to calculate and extract black points located on the colorful parts of this map
First raster::projectRaster does not "set" the projection but, rather reprojects the raster given a transformation and resampling. Given the computational requirements of this it is much faster to reproject the point data using sp::spTransform. Once your data is in the same projection space, you can use raster::extract to extract the raster values. Values out side the raster or in nodata (NA) areas will be assigned NA values. You can drop these observations using a simple NA index with which.
It looks like your data may have a constant value outside of the permafrost. Once you identify what this value is (eg., 0) you can remove these points as well. Here is a worked example. First we add packages and create some example data that is similar to yours.
library(sp)
library(raster)
dist1 <- raster(nrow=20, ncol=20)
dist1[] <- sample(1:10, ncell(dist1), replace=TRUE)
dist1[200:400] <- 0
trees <- sampleRandom(dist1, 100, sp=TRUE)
plot(dist1)
plot(trees,pch=20,col="red",add=TRUE)
Now, we extract the raster values and look at the dimensions of the point object (please note that I do not have to use the sp=TRUE argument in the raster::extract function).
trees#data <- data.frame(trees#data, dist1 = extract(dist1, trees))
dim(trees)
Now we create a row index indicating which rows contain zeros, make sure that we have identified rows (using an if statement) and then remove them. Looking at the object dimensions again, we can see how many points were removed from the original point data.
( idx <- which(trees$dist1 %in% 0) )
if(length(idx) > 0) trees <- trees[-idx,]
dim(trees)
I am trying to create a script that will generate a 2d topographic or contour map for a given set of coordinates. My goal is something similar to what is produced by
contour(volcano)
but for any location set by the user. This has proved surprisingly challenging! I have tried:
library(elevatr)
library(tidyr)
# Generate a data frame of lat/long coordinates.
ex.df <- data.frame(x=seq(from=-73, to=-71, length.out=10),
y=seq(from=41, to=45, length.out=10))
# Specify projection.
prj_dd <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"
# Use elevatr package to get elevation data for each point.
df.sp <- get_elev_point(ex.df, prj = prj_dd, src = "epqs")
# Convert from spatial to regular data frame, remove extra column.
# Use tidyr to convert to lat x lon table with elevation as fill.
# Sorry for the terrible code, I know this is sloppy.
df <- as.data.frame(df.sp)
df$elev_units <- NULL
df.w <- df %>% spread(y, elevation)
df.w <- as.matrix(df.w)
This creates a matrix similar to the volcano dataset but filled with NAs except for the 10 lat/lon pairs with elevation data. contour can handle NAs, but the result of contour(df.w) has only a single tiny line on it. I'm not sure where to go from here. Do I simply need more points? Thanks in advance for any help--I'm pretty new to R and I think I've bitten off more than I can chew with this project.
Sorry for delay in responding. I suppose I need to check SO for elevatr questions!
I would use elevatr::get_elev_raster(), which returns a raster object which can be plotted directly with raster::contour().
Code example below grabs a smaller area and at a pretty coarse resolution. Resultant contour looks decent though.
library(elevatr)
library(raster)
# Generate a data frame of lat/long coordinates.
ex.df <- data.frame(x=seq(from=-73, to=-72.5, length.out=10),
y=seq(from=41, to=41.5, length.out=10))
# Specify projection.
prj_dd <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"
# Use elevatr package to get elevation data for each point.
elev <- get_elev_raster(ex.df, prj = prj_dd, z = 10, clip = "bbox")
raster::contour(elev)
If it is a requirement to use graphic::contour(), you'll need to convert the raster object to a matrix first with raster::as.matrix(elev). That flips the coords though and I haven't spent enough time to try and get that part figured out... Hopefully the raster solution works for you.
I need to calculate the magnitude-per-unit area of polylines that fall within a radius around each cell. Essentially I need to calculate a km/km2 road density within a 500m pixel search radius. ArcMap has a quick and easy tool that handles this, but I need a pure R solution.
Here is a link on how line density works: http://desktop.arcgis.com/en/arcmap/10.3/tools/spatial-analyst-toolbox/how-line-density-works.htm
And this is how to use it in a python (arcpy) script: http://desktop.arcgis.com/en/arcmap/10.3/tools/spatial-analyst-toolbox/line-density.htm
I currently execute a backwards approach using raster::focal function, calculating a density of burned in road features. I then convert the km2/km2 output to km/km2.
#Import libraries
library(raster)
library(rgdal)
library(gdalUtils)
#Read-in an already created raster mask (cells are all set to 0)
mask <- raster("x://path to raster mask...")
#Make a copy of the mask to burn features in, keeping the original untouched
roads_mask <- file.copy(mask, "x://output path ...//roads.tif")
#Read-in road features (shapefile format)
roads_sldf <- readOGR("x://path to shapefile" , "roads")
#Rasterize spatial lines data frame ie. burn road features into mask
#Where road features get a value of 1, mask extent gets a value of 0
roads_raster <- gdalUtils::gdal_rasterize(src_datasource = roads_sldf,
dst_filename = "x://output path ...//roads.tif", b = 1,
burn = 1, l = "roads", output_Raster = TRUE)
#Run a 1km circular radius density function (be mindful of edge effects)
weight <- raster::focalWeight(roads_raster,1000,type = "circle")
1km_rdDensity <- raster::focal(roads_raster, weight, fun=sum, filename = '',
na.rm=TRUE, pad=TRUE, NAonly=FALSE, overwrite=TRUE)
#Convert km2/km2 road density to km/km2
#Set up the moving window
weight <- raster::focalWeight(roads_raster,1000,type = "circle")
#Count how many records in each column of the moving window are > 0
columnCount <- apply(weight,2,function(x) sum(x > 0))
#Get the sum of the column count
number_of_cells <- sum(columnCount)
#multiply km2/km2 density by number of cells in the moving window
step1 <- roads_raster * number_of_cells
#Rescale step1 output with respect to cell size(30m) and radius of a circle
final_rdDensity <- (step1*0.03)/3.14159265
#Write out final km/km2 road density raster
writeRaster(final_rdDensity,"X://path to output...", datatype = 'FLT4S', overwrite = TRUE)
After some more research I think I may be able to use a kernel function, however I don't want to apply the smoothing algorithm... As well the output is an 'im' object which I would need to write to as a 'tif'
#Import libraries
library(spatstat)
library(rgdal)
#Read-in road features (shapefile format)
roads_sldf <- readOGR("x://path to shapefile" , "roads")
#Convert roads spatial lines data frame to psp object
psp_roads <- as.psp(roads_sldf)
#Apply kernel density, however this is where I am unsure of the arguments
road_density <- spatstat::density.psp(psp_roads, sigma = 0.01, eps = 500)
Cheers.
See this question https://gis.stackexchange.com/questions/138861/calculating-road-density-in-r-using-kernel-density
Tried to mark as a duplicate but doesn't work because the other Q is on gis stack exchange
Short answer is use spatstat.geom::pixellate()
I also needed spatstat.geom::as.psp(sf::st_geometry(x)) to convert an sf lines object to the correct format and maptools::as.im.RasterLayer(r) to convert a raster. I was able to convert the result to RasterLayer with raster::raster(pix_res)
Perhaps you can use terra::rasterizeGeom which is available in the development version that you can install with install.packages('terra', repos='https://rspatial.r-universe.dev')
Example data
library(terra)
f <- system.file("ex/lux.shp", package="terra")
v <- vect(f) |> as.lines()
r <- rast(v, res=.1)
Solution
x <- rasterizeGeom(v, r, fun="length", "km")
And then use focal sum, but you would not have a perfect circle.
What you could do instead, if your dataset is not too large, is create a circle for each grid cell and use intersect. Something like this:
p <- xyFromCell(r, 1:ncell(r)) |> vect(crs="+proj=longlat")
p$id <- 1:ncell(r)
b <- buffer(p, 10000)
values(v) <- NULL
i <- intersect(v, b)
x <- aggregate(perim(i), list(id=i$id), sum)
r[x$id] <- x[,2]