R sample a raster with square polygons - r

I would like to sample a big raster by creating In small raster 100x100 cells.
I don't know how to do that so any ideas are welcome
My actual lead :
library(raster)
library(spatstat)
library(polyCub)
r <- raster(ncol=1000,nrow=1000) # create empty raster
r[] <- 1:(1000*1000) # Raster for testing
e <- extent(r) # get extend
# coerce to a SpatialPolygons object
p <- as(e, 'SpatialPolygons')
nc <- as.owin.SpatialPolygons(p) #polyCub
pts <- rpoint(50, win = nc)
plot(pts)
Now I need to generate 100x100 cell square around my 50 points and I would like to crop r using those square and stack each small raster individually ...

The answer by #adrian-baddeley basically has the ingredients to do what
you want. If you simply want a list of small im objects that contain
the 100x100 box you simply subset im objects by owin objects to
extract the relevant region. Here is an example (with fewer points to
avoid overplotting)
library(raster)
library(spatstat)
library(maptools)
r <- raster(ncol=1000,nrow=1000) # create empty raster
r[] <- 1:(1000*1000) # Raster for testing
e <- extent(r) # get extend
# coerce to a SpatialPolygons object
p <- as(e, 'SpatialPolygons')
nc <- as.owin.SpatialPolygons(p)
set.seed(42)
pts <- rpoint(7, win = nc)
rim <- as.im.RasterLayer(r)
Box <- owin(c(-50,50) * rim$xstep, c(-50,50) * rim$ystep)
The following is a list of im objects of size 100x100
imlist <- solapply(seq_len(npoints(pts)),
function(i) rim[shift(Box, pts[i])])
Here is a plot of the im objects in the region and the points on top
plot(pts)
for(i in imlist) plot(i, add = TRUE)
plot(pts, pch = 19, add = TRUE)
You can convert to a list of raster layers with
rasterList <- lapply(imlist, as, Class = "RasterLayer")
PS: The following is a list of im objects of the original size with
NA outside the 100x100 box if you need that format instead
imlist <- solapply(seq_len(npoints(pts)),
function(i) rim[shift(Box, pts[i]), drop = FALSE])

If you want to use spatstat then you need to convert the raster object r into an object of class im supported by spatstat. You can do this conversion in the maptools package. Call this image object rim. Then you can do as follows
Box <- owin(c(-50,50) * rim$xstep, c(-50,50) * rim$ystep)
BoxesUnion <- MinkowskiSum(pts, Box)
W <- intersect.owin(as.mask(rim), BoxesUnion)
This would give you the subset of the raster that is covered by the squares.
If you want to keep the squares separate, do something like
M <- as.mask(rim)
BoxList <- solapply(seq_len(npoints(pts)),
function(i) intersect.owin(M, shift(Box, pts[i])))
Then BoxList is a list of the individual sub-rasters.

Related

How to select one point per raster grid cell?

I have a point shapefile ("search_effort.shp") that is highly clustered and an NDVI raster (resolution in m: 30.94948, 30.77829). I would like to subset my search_effort.shp by selecting 1 point per raster grid cell and create a new search_effort shapefile. I am using R version 4.0.3
I think I could have used Package ‘gridsample’ (in 'raster' v1.3-1), but it was removed from the CRAN repository and I would prefer not to use the archived version. Is there another way to do this in R?
I have also tried sample.grid but I do not know how to specify my raster as the grid, and have tried the following:
# NDVI raster to be used as the reference extent
NDVI_extent <-readGDAL('C:/Model_layers/NDVI.tif')
# Load the file names
layername <- "SearchEffort"
# Read in the shapefile
search_effort <- readOGR(dsn= ".", layer = layername)
plot(search_effort)
# Set the reference extent
r <- raster(NDVI_extent)
# Extract coordinates from the shapefile
search_effort#coords <- search_effort#coords[, 1:2]
#Subset points
sample.grid(search_effort, cell.size = c(30.94948, 30.77829), n = 1)
I get the following error:
"Error in validObject(.Object) : invalid class “GridTopology” object: cellsize has incorrect dimension."
I get the same error regardless of the cell.size I specify.
Example data
library(raster)
r <- raster(res=30)
values(r) <- 1:ncell(r)
x <- runif(1000,-180,180)
y <- runif(1000,-90,90)
xy <- cbind(x, y)
Solution
library(dismo)
s <- gridSample(xy, r, n=1)
Illustration
plot(as(r, "SpatialPolygons"))
points(s, col="red")
points(xy, cex=.1, col="blue")

Streamlining binary rasterization in R

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)

Grid points within polygon: previous solution does not work for me

For some reason I can't get the solution provided by #RichPauloo to work and do appreciate some help.
I have a SpatialPolygonsDataFrame called "spdf" (in the dropbox link below)
https://www.dropbox.com/s/ibhp5mqbgfmmntz/spdf.Rda?dl=0
I used the code from below post to get the grid data within the boundary.
Create Grid in R for kriging in gstat
library(sp)
grd <- makegrid(spdf, n = 10000)
colnames(grd) <- c('x','y');
outline <- spdf#polygons[[1]]#Polygons[[1]]#coords
library(splancs)
new_grd <- grd[inout(grd,outline), ]
Here is what I get:
Black dots are "grd" from makegrid
Blue dots are "outline" as boundary
Red dots are"new-grd" as the grid within the boundary
As you can see it does not capture all the data within the boundary? What am I doing wrong?
Try this:
# packages
library(sp)
# make grid
grd <- makegrid(spdf, n = 100)
colnames(grd) <- c('x','y') # assign names to columns
# check the class
class(grd)
# transform into spatial points
grd_pts <- SpatialPoints(coords = grd,
proj4string=CRS(as.character(NA)))
# check the class again
class(grd_pts)
# show that points fall outside of polygon
plot(spdf)
points(grd_pts)
# subset for points within the polygon
grd_pts_in <- grd_pts[spdf, ]
# visualize
plot(spdf)
points(grd_pts_in)
# transform grd_pts_in back into a matrix and data frame
gm <- coordinates(grd_pts_in) # matrix
gdf <- as.data.frame(coordinates(grd_pts_in)) # data frame

Line density function in R equivalent to Line density tool in ArcMap (arcpy)

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]

error in mask a raster by a spatialpolygon

I have raster of the following features:
library(raster)
library(rgeos)
test <- raster(nrow=225, ncols=478, xmn=-15.8, xmx=32, ymn=-9.4, ymx=13.1)
I want to mask in this raster the cells that are within a given distance of a point.
I create the spatial points as followed:
p2=readWKT("POINT(31.55 -1.05)")
Then I create a spatial polygon object by adding a 0.5 buffer:
p2_Buffered <- gBuffer(p2, width = 0.5)
mask(test, mask=p2_Buffered,inverse=T)
When I mask my raster given this spatial object, I have the following error message:
Error in .polygonsToRaster(x, y, field = field, fun = fun, background
= background, : number of items to replace is not a multiple of replacement length
I do not understand because this is script I have been running many many times with different point and different buffer width without any problem.
What is strange is that when I change the width of the buffer, it works fine:
p2_Buffered <- gBuffer(p2, width = 0.4)
mask(test, mask=p2_Buffered,inverse=T)
This is also true for a different focal point:
p2=readWKT("POINT(32.55 -1)")
p2_Buffered <- gBuffer(p2, width = 0.5)
mask(test, mask=p2_Buffered,inverse=T)
I would like to identify the specific problem I have for that point because this is a script I should run in a routine (I have been doing it without any problem so far).
Thanks a lot
This is indeed a bug with polygons that go over the edge of a raster. It has been fixed in version 2.3-40 (now on CRAN), so it should go away if you update the raster package.
Here is a workaround (removing the part of the polygon that goes over the edge).
library(raster)
library(rgeos)
r <- raster(nrow=225, ncols=478, xmn=-15.8, xmx=32, ymn=-9.4, ymx=13.1)
e <- as(extent(r), 'SpatialPolygons')
p <- readWKT("POINT(31.55 -1.05)")
pb <- gBuffer(p, width = 0.5)
pbe <- intersect(pb, e)
values(r)
x <- mask(r, mask=pbe, inverse=TRUE)
You usually need to set some values to the raster layer. For a mask layer its always best to set values to 1.
library(raster)
library(rgeos)
# make sample raster
test <- raster(nrow=225, ncols=478, xmn=-15.8, xmx=32, ymn=-9.4, ymx=13.1)
# set values of raster for mask
test <- setValues(test, 1)
# make point buffer
p2=readWKT("POINT(15 5)")
p2_Buffered <- gBuffer(p2, width = 1.5)
# name projection of buffer (assume its the same as raster)
projection(p2_Buffered) <- projection(test)
# visual check
plot(test); plot(p2_Buffered, add=T)
If you want to trim down your raster layer to the just the single polygon then try this workflow.
step1 <- crop(test, p2_Buffered) # crop to same extent
step2 <- rasterize(p2_Buffered, step1) # rasterize polygon
final <- step1*step2 # make your final product
plot(final)
If you just want to poke a hole in your raster layer then use the mask function
# rasterize your polygon
p2_Buffered <- rasterize(p2_Buffered, test, fun='sum')
# now mask it
my_mask <- mask(test, mask=p2_Buffered,inverse=T) # try changing the inverse argument
plot(my_mask)

Resources