I am having 20 raster layers and 1 shapefile. I would like to:
crop and mask each raster iteratively (i.e., first crop and mask the first raster, then the second and so on)
save each cropped raster with the same name as its original into a subfolder of the working directory.
I can do this for every raster (manually, one-by-one) but I would like to automate the process. My raster layers do not have the same extent, that's why I want to crop and mask them one-by-one (also they are large in size (mb) which means it would be difficult for my laptop to set the same extent and then clip them all together using the shapefile). Here is the code for doing this in a one-by-one manner:
library(terra)
setwd("path")
r1 = rast("path/a.tif")
r2 = rast("path/b.tif")
poly <- vect("path/poly.shp")
r1 <- crop(r1,
poly,
mask = T)
r2 <- crop(r2,
poly,
mask = T)
dir.create(file.path(getwd(), 'clip'), recursive = T)
writeRaster(r1, "path/clip/r1.tif")
writeRaster(r2, "path/clip/r2.tif")
From here you can download a small subset the data.
Perhaps something like this:
library(terra)
crop_poly <- vect(file.path(here::here(), "poly.shp"))
filenames_in <- list.files(here::here(), pattern = "\\.tif$")
corpped_rasters <- filenames_in |>
# apply rast() on each filename in filenames_in list,
# returns list of rasters
lapply(rast) |>
# apply crop(), first param from input list (of rasters),
# pass on y and mask parameters
lapply(crop, y = crop_poly, mask = T)
filenames_out <- file.path("clip", filenames_in)
dir.create(file.path(here::here(), 'clip'))
# apply writeRaster on pairs of list elements from corpped_rasters & filenames_out
# writeRaster(corpped_rasters[[1]], filenames_out[[1]])
# writeRaster(corpped_rasters[[2]], filenames_out[[2]])
# ...
mapply(writeRaster, corpped_rasters, filenames_out)
Related
I have 4 rasters I would like to crop to the same extent. In future iterations of this script I will have way more than 4, so I am trying to write a loop that will crop all rasters in a directory to the same extent. The rasters are downloaded Sentinel-2 products containing at least 4 bands that have been converted into GeoTIFFs using the sen2r() library. I've tried working with answers to similar questions posted here, but lose the bands somehow in the process, and i will need those bands to do some raster math later on.
Code so far:
raster_files <- list.files(here::here("data", "s2_rasters")) #dir with 4 rasters
raster_paths <- paste0(here::here("data", "s2_rasters", raster_files))
wp_shp <- readOGR(here::here("data", "wp_boundary.shp"))
e <- extent(wp_shp)
n <- length(raster_paths)
for (i in 1:n) {
m <- raster_paths[i]
crop(x = m, y = e)
}
EDIT:
I recognize my loop doesn't make sense. I'm new to this and idk what i'm doing. Up until this point in the script I have been using the paths to the files to do stuff (build virtual rasters, apply atmospheric corrections etc.).
Here's an example I did for a single crop that worked fine.
extent <- extent(802331.9, 802503.7, 9884986, 9885133)
ras_crop <- stack(here::here("data", "s2_rasters", "sample_raster.tif")) %>%
crop(extent) %>%
writeRaster(filename=file.path(here::here("data", "s2_rasters"), "raster1_crop.tif"))
From what I gather, you should be able to do something like this
# input filenames
inf <- list.files("data/s2_rasters", pattern="tif$", full.names=TRUE)
# create output filenames and folder
outf <- gsub("data/s2_rasters", "output", inf)
dir.create("output", FALSE, FALSE)
library(raster)
wp_shp <- shapefile("data/wp_boundary.shp")
e <- extent(wp_shp)
for (i in 1:length(inf)) {
b <- brick(inf[i])
crop(b, e, filename=outf[i])
}
I have multiple rasters in a folder. I need to extract mean of each of these rasters over a polygon shape file (has more 2500 polygons).
I came across two functions zonal and extract. It says extract can be used for points, lines and polygons too. Is it the only difference ? (Yes/No expected)
How can I extract mean from these multiple rasters and specify different column names as per their filenames for these extracted mean values ?
Edit::
I found a code somewhere and implemented it. But it is taking forever and no progress at all.
grids <- list.files("my_path", pattern = "*.tif$")
#check the number of files in the raster list (grids)
length <- length(grids)
#read-in the polygon shapefile
poly <- readShapePoly("my_path/supplimentY.shp")
#create a raster stack
s <- stack(paste0("my_path/", grids))
#extract raster cell count (sum) within each polygon area (poly)
for (i in 1:length(grids)){
ex <- extract(s, poly, fun='mean', na.rm=TRUE, df=TRUE, weights = TRUE)
# the code doesnot progress from here onwards.
# i checked it by adding this line:: print(i)
}
#write to a data frame
dfr <- data.frame(ex)
You do not need the loop (you repeat the same operation at each iteration!).
It should be like this:
library(raster)
ff <- list.files("my_path", pattern = "\\.tif$", full=TRUE)
s <- stack(ff)
poly <- shapefile("my_path/supplimentY.shp")
ex <- extract(s, poly, fun='mean', na.rm=TRUE, df=TRUE, weights = TRUE)
I used the same code to calculate the zonal mean of climatology for an area boundary, it took me 5-6mins to work on 2736 layers of raster data.
layers <- length(clim)
for (i in 1:length(clim)) {
ex <- extract(clim, shpwb, fun=mean, na.rm=TRUE, df=TRUE)
}
df <- data.frame(ex)
write.csv(df, file = "E:/Central University of Jharkhand/3rd Semester/Climatology/R Studio/CSV.csv")
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]
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.
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)