sf and stars: polygonize categorical raster - r

I'd like to draw the raster countour (l) just only for the "target" categorical in x raster without considering NA values. I try to do:
# Packages
library(stars)
library(sf)
#Vectorizing a raster object to an sf object
tif = system.file("tif/L7_ETMs.tif", package = "stars")
x = read_stars(tif)[, 1:50, 1:50, 1:2]
x[[1]] = round(x[[1]]/5)
x[[1]] = ifelse(x[[1]]<10,NA,"target")
str(x[[1]])
#Polygonizing
l = st_contour(x)
plot(l[1])
Error in CPL_write_gdal(mat, file, driver, options, type, dims, from, :
Not compatible with requested type: [type=character; target=double].
But, doesn't work. Please, any help with it?
Thanks in advance,
Alexandre

There are several errors with your script, first, st_contour is indicating that it is not compatible with the character type (referring to the "target" string you set in the raster). Secondly, I would suggest using the breaks argument inside st_contour to set the target value for which you wish to obtain the contours. Additionally, you might want to use x[rule] <- NA to mask certain values in the raster. I made other modifications to your code that might help:
# Let's stay with only the first band, indicated in the final dimension
x = read_stars(tif)[, 1:50, 1:50, 1]
x = round(x/5)
# Calculate the min and max of the raster values
purrr::map(x, min)
# 10
purrr::map(x, max)
# 28
# Mask values lower than 10
# However, this does not make any change, because the lowest value is 10
x[x<10] <- NA
# Take a look at the image
plot(x)
# Obtain the contours
l = st_contour(x,
# Remove NA
na.rm = T,
# Obtain contour lines instead of polygons
contour_lines = TRUE,
# raster values at which to draw contour levels
breaks = 12)
# Plot the contours
plot(l)

Related

Calculate Topographic Position Index for coordinates stored in a dataframe in R

I'm trying to calculate Topographic Position Index (TPI) for 177 points of interest. I have their coordinates stored in a data.frame and elevation in a raster of 7.5 arc sec spatial resolution. And the TPIs I'm calculating is basically: the elevation of point of interest minus the average elevation of its surrounding cells, then the intermediate result is divided by the spatial resolution of the raster. (resolution(dem)) to account for differences in the spatial scale of the DEM and the TPI values.
And since studies usually calculate two TPIs (a small scale + a large scale), I'm also using two windows, where in the small one the surrounding 55 cells are used, and in the large one the surrounding 1010 cells are used.
I am getting this error message
Error in .focal_fun(v, w, as.integer(c(tr$nrows[1] + addr, nc)), runfun, :
Evaluation error: could not find function "resolution"
Code:
library(raster)
library(sp)
library(terra)
library(haven)
# Make a dataframe with longitudes and latitudes
df <- data.frame(lon = coords$longitude, lat = coords$latitude)
# Convert the dataframe to a SpatialPointsDataFrame
coordinates(df) <- c("lon", "lat")
proj4string(df) <- CRS("+proj=longlat +datum=WGS84")
# Extract the elevation values at the points
elev <- extract(dem, df)
# Define the scales for TPI calculation
scales <- c(5, 10)
# Loop over the scales and calculate TPI
tpi_list <- list()
for (scale in scales) {
# Define the size of the moving window
win_size <- scale * 5
# Calculate TPI
tpi <- focal(dem, w = matrix(1, win_size, win_size), fun = function(x) {
(elev - mean(x)) / resolution(dem) * 5
})
# Extract TPI values at the points
tpi_vals <- extract(tpi, df)
# Store the TPI values in a list
tpi_list[[as.character(scale)]] <- tpi_vals
}
#Error in .focal_fun(v, w, as.integer(c(tr$nrows[1] + addr, nc)), runfun, : Evaluation error: could not find function "resolution"
# Combine the TPI values for different scales into a dataframe
tpi_df <- data.frame(tpi_list, row.names = rownames(df))
The error you get is clear:
Evaluation error: could not find function "resolution"
You are using a function resolution, but R does not know about that function. It does not exist in the current workspace. I suppose you were looking for res.
Here is a working example.
library(terra)
dem <- rast(system.file("ex/elev.tif", package="terra"))
df <- data.frame(lon=c(5.9, 6.0, 6.2), lat=c(49.9, 49.6, 49.7))
tpifun <- \(x, f) x[f] - mean(x[-f], na.rm=TRUE)
scales <- c(5, 11)
tpilst <- vector("list", length(scales))
for (i in seq_along(scales)) {
win_size <- scales[i] * 5
mid <- ceiling(win_size^2 / 2)
tpi <- focal(dem, w=win_size, fun=tpifun, f=mid, wopt=list(names="tpi"))
tpilst[[i]] <- data.frame(scale=scales[i], extract(tpi, df))
}
tpi <- do.call(rbind, tpilst)
tpi$tpi <- tpi$tpi / (mean(res(dem)) * 5)
tpi
# scale ID tpi
#1 5 1 -1330.6184
#2 5 2 340.1538
#3 5 3 -135.3077
#4 11 1 -585.7952
#5 11 2 255.3344
#6 11 3 292.0155
A couple of things:
res returns two numbers, the x and y resolution. In the example above I take the mean.
What you were doing in the function supplied to focal is not possible. You supplied a data.frame with elevation data for a few points. How can focal understand what that is all about? Instead, you can compute the TPI for each cell and extract these values.
You cannot use a value of 10 for scale because the weights matrix must have odd size. Otherwise it is not clear how it should be centered on the focal cell.
You say that if scale is 5, the "surrounding 55 cells are used". But that is not the case. The number of surrounding cells used is 624.
scale <- 5
(scale * 5)^2 - 1
#[1] 624

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")

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]

Using R intersections to create a polygons-inside-a-polygon key using two shapefile layers

The data
I have two shapefiles marking the boundaries of national and provincial electoral constituencies in Pakistan.
The objective
I am attempting to use R to create a key that will generate a list of which provincial-level constituencies are "contained within" or otherwise intersecting with which national-level constituencies, based on their coordinates in this data. For example, NA-01 corresponds with PA-01, PA-02, PA-03; NA-02 corresponds with PA-04 and PA-05, etc. (The key will ultimately be used to link separate dataframes containing electoral results at the national and provincial level; that part I've figured out.)
I have only basic/intermediate R skills learned largely through trial and error and no experience working with GIS data outside of R.
The attempted solution
The closest solution I could find for this problem comes from this guide to calculating intersection areas in R. However, I have been unable to successfully replicate any of the three proposed approaches (either the questioner's use of a general TRUE/FALSE report on intersections, or the more precise calculations of area of overlap).
The code
# import map files
NA_map <- readOGR(dsn = "./National_Constituency_Boundary", layer = "National_Constituency_Boundary")
PA_map <- readOGR(dsn = "./Provincial_Constituency_Boundary", layer = "Provincial_Constituency_Boundary")
# Both are now SpatialPolygonsDataFrame objects of 273 and 577 elements, respectively.
# If relevant, I used spdpylr to tweak some of data attribute names (for use later when joining to electoral dataframes):
NA_map <- NA_map %>%
rename(constituency_number = NA_Cons,
district_name = District,
province = Province)
PA_map <- PA_map %>%
rename(province = PROVINCE,
district_name = DISTRICT,
constituency_number = PA)
# calculate intersections, take one
Results <- gIntersects(NA_map, PA_map, byid = TRUE)
# this creates a large matrix of 157,521 elements
rownames(Results) <- NA_map#data$constituency_number
colnames(Results) <- PA_map#data$constituency_number
Attempting to add the rowname/colname labels, however, gives me the error message:
Error in dimnames(x) <- dn :
length of 'dimnames' [1] not equal to array extent
Without the rowname/colname labels, I'm unable to read the overlay matrix, and unsure how to filter them so as to produce a list of only TRUE intersections that would help make a NA-PA key.
I also attempted to replicate the other two proposed solutions for calculating exact area of overlap:
# calculate intersections, take two
pi <- intersect(NA_map, PA_map)
# this generates a SpatialPolygons object with 273 elements
areas <- data.frame(area=sapply(pi#polygons, FUN = function(x) {slot(x, 'area')}))
# this calculates the area of intersection but has no other variables
row.names(areas) <- sapply(pi#polygons, FUN=function(x) {slot(x, 'ID')})
This generates the error message:
Error in `row.names<-.data.frame`(`*tmp*`, value = c("2", "1", "4", "5", :
duplicate 'row.names' are not allowed
In addition: Warning message:
non-unique value when setting 'row.names': ‘1’
So that when I attempt to attach areas to attributes info with
attArrea <- spCbind(pi, areas)
I get the error message
Error in spCbind(pi, areas) : row names not identical
Attempting the third proposed method:
# calculate intersections, take three
pi <- st_intersection(NA_map, PA_map)
Produces the error message:
Error in UseMethod("st_intersection") :
no applicable method for 'st_intersection' applied to an object of class "c('SpatialPolygonsDataFrame', 'SpatialPolygons', 'Spatial', 'SpatialPolygonsNULL', 'SpatialVector')"
I understand that my SPDF maps can't be used for this third approach, but wasn't clear from the description what steps would be needed to transform it and attempt this method.
The plea for help
Any suggestions on corrections necessary to use any of these approaches, or pointers towards some other method of figuring this, would be greatly appreciated. Thanks!
Here is some example data
library(raster)
p <- shapefile(system.file("external/lux.shp", package="raster"))
p1 <- aggregate(p, by="NAME_1")
p2 <- p[, 'NAME_2']
So we have p1 with regions, and p2 with lower level divisions.
Now we can do
x <- intersect(p1, p2)
# or x <- union(p1, p2)
data.frame(x)
Which should be (and is) the same as the original
data.frame(p)[, c('NAME_1', 'NAME_2')]
To get the area of the polygons, you can do
x$area <- area(x) / 1000000 # divide to get km2
There are likely to be many "slivers", very small polygons because of slight variations in borders. That might not matter to you.
But another approach could be matching by centroid:
y <- p2
e <- extract(p1, coordinates(p2))
y$NAME_1 <- e$NAME_1
data.frame(y)
Your code isn't self-contained, so I didn't try to replicate the errors you report.
However, getting the 'key' you want is very simple using the sf package (which is intended to supercede rgeos, rgdal and sp in the near future). See here:
library(sf)
# Download shapefiles
national.url <- 'https://data.humdata.org/dataset/5d48a142-1f92-4a65-8ee5-5d22eb85f60f/resource/d85318cb-dcc0-4a59-a0c7-cf0b7123a5fd/download/national-constituency-boundary.zip'
provincial.url <- 'https://data.humdata.org/dataset/137532ad-f4a9-471e-8b5f-d1323df42991/resource/c84c93d7-7730-4b97-8382-4a783932d126/download/provincial-constituency-boundary.zip'
download.file(national.url, destfile = file.path(tempdir(), 'national.zip'))
download.file(provincial.url, destfile = file.path(tempdir(), 'provincial.zip'))
# Unzip shapefiles
unzip(file.path(tempdir(), 'national.zip'), exdir = file.path(tempdir(), 'national'))
unzip(file.path(tempdir(), 'provincial.zip'), exdir = file.path(tempdir(), 'provincial'))
# Read map files
NA_map <- st_read(dsn = file.path(tempdir(), 'national'), layer = "National_Constituency_Boundary")
PA_map <- st_read(dsn = file.path(tempdir(), 'provincial'), layer = "Provincial_Constituency_Boundary")
# Get sparse list representation of intersections
intrs.sgpb <- st_intersects(NA_map, PA_map)
length(intrs.sgpb) # One list element per national constituency
# [1] 273
print(intrs.sgpb[[1]]) # Indices of provnicial constituencies intersecting with first national constituency
# [1] 506 522 554 555 556
print(PA_map$PROVINCE[intrs.sgpb[[1]]])[1] # Name of first province intersecting with first national constituency
# [1] KHYBER PAKHTUNKHWA

Plotting netcdf in R with correct grid

My goal is to plot nitrate (no3) data on a world map, using the correct longitude and latitude for these data.
There are two netcdf files:
1. with the data
2. with the grid information
Summary info on the data:
no3 is an array of length x*y*sigma
no3_df is 'x*y obs. of 3 variables'
x = integer [180]
y = integer [193]
sigma = array[53]
I want to look at sigma ('depth') 20. I therefore did the following:
# Load the needed libraries to handle netcdf files
library(ncdf)
library(akima)
# Open data and grid files
file1 <- open.ncdf(file.choose())
grid <- open.ncdf(file.choose())
# Read relevant variables/parameters from data file1
x <- get.var.ncdf(file1,varid="x")
y <- get.var.ncdf(file1,varid="y")
sigma <- get.var.ncdf(file1,varid="sigma")
no3 <- get.var.ncdf(file1,varid="no3")
sigma_plot <- no3[,,sigma=20]
# Read relevant variables/parameters from grid file
plon <- get.var.ncdf(grid,varid="plon")
plat <- get.var.ncdf(grid,varid="plat")
# Each cell of sigma_plot corresponds to one cell of plon and plat.
A <- array(c(plon,plat,sigma_plot),dim=c(180,193,3))
# Now B is an array containing for each row: (longitude, latitude, value).
B <- apply(A, 3, cbind)
# But it is not a regular grid, so interpolate to a regular grid. akima library
C <- interp(B[,1],B[,2],B[,3],
xo=seq(-180,180,1),yo=seq(-90,90,by=1), # tweak here the resolution
duplicate='mean') # extra y values are duplicates
#########
# PLOTTING
#########
# This one works, but doesn't have a correct longitude and latitude:
filled.contour(x,y,sigma_plot, col=rich.colors(18))
# Try to plot with lon and lat
filled.contour(C, col=rich.colors(30))
Since the filled.contour plot doesn't have correct longitude and latitude, I would like to use ggplot. However, I don't know how to do this...
# And the plotting with ggplot
ggplot(aes(x=plon_datafrm,y=plat_datafrm),data=no3_df) +
geom_raster() +
coord_equal() +
scale_fill_gradient()
This doesn't seem to work. I am net to ggplot so that might be the reason, I would truly appreciate any help.
library(ncdf)
data <- open.ncdf(file1)
no3 <- get.var.ncdf(data,varid="no3")
sigma_plot <- no3[,,20]
grid <- open.ncdf(file2)
plon <- get.var.ncdf(grid,varid="plon")
plat <- get.var.ncdf(grid,varid="plat")
Contrary to what I previously understood, each cell of sigma_plot corresponds to one cell of plon and plat.
A <- array(c(plon,plat,a),dim=c(180,193,3))
B <- apply(A, 3, cbind)
Now B is an array containing for each row: (longitude, latitude, value). But it is not a regular grid, so you need to interpolate a regular grid. Easiest way would be using interp from package akima:
library(akima)
C <- interp(B[,1],B[,2],B[,3],
xo=seq(-180,180,1),yo=seq(-90,90,by=1), #you can tweak here the resolution
duplicate='mean') #for some reasons some entries are duplicates, i don t know how you want to handle it.
image(C) #for instance, or filled.contour if you prefer
library(maptools)
data(wrld_simpl)
plot(wrld_simpl, add=TRUE, col="white") #To add a simple world map on top

Resources