Calculate all distances between two set of points using st_distance - r

I have two sets of points stored in R as sf objects. Point object x contains 204,467 and point y contains 5,297 points.
In theory, I would want to calculate the distance from all points in x to all points in y. I understand that this would create a beast of a matrix, but it is doable using st_distance(x, y, by_element=FALSE) in the sf package in about 40 minutes on my i7 desktop.
What I want to do is to calculate the distance from all of the points in x to all of the points in y, then I want to convert this into a data.frame, that contains all variables for the respective x and y pair of points. This is because I want flexibility in terms of aggregation using dplyr, for instance, I want to find the number of points in y, that is within 10, 50, 100 km from x, and where x$year < y$year.
I successfully created the distance matrix, which has around 1,083,061,699 cells. I know this is a very inefficient way of doing this, but it gives flexibility in terms of aggregation. Other suggestions are welcome.
Below is code to create two sf point objects, and measure the distance between them. Next, I would want to convert this into a data.frame with all variables from x and y, but this is where I fail to proceed.
If my suggested workflow is unfeasible, can someone provide an alternative solution to measure distance to all points within a predefined radius, and create a data.frame of the result with all variables from x and y?
# Create two sf point objects
set.seed(123)
library(sf)
pts1 <- st_as_sf(x = data.frame(id=seq(1,204467,1),
year=sample(seq(from = 1990, to = 2018, by = 1), size = 204467, replace = TRUE),
xcoord=sample(seq(from = -180, to = 180, by = 1), size = 204467, replace = TRUE),
ycoord=sample(seq(from = -90, to = 90, by = 1), size = 204467, replace = TRUE)),
coords=c("xcoord","ycoord"),crs=4326)
pts2 <- st_as_sf(x = data.frame(id=seq(1,5297,1),
year=sample(seq(from = 1990, to = 2018, by = 1), size = 5297, replace = TRUE),
xcoord=sample(seq(from = -180, to = 180, by = 1), size = 5297, replace = TRUE),
ycoord=sample(seq(from = -90, to = 90, by = 1), size = 5297, replace = TRUE)),
coords=c("xcoord","ycoord"),crs=4326)
distmat <- st_distance(pts1,pts2,by_element = FALSE)

I would consider approaching this differently. Once you have your distmat matrix, you can do the types of calculation you describe without needing a data.frame. You can use standard subsetting to find which points meet your specified criteria.
For example, to find the combinations of points where pts1$year is greater than pts2$year we can do:
subset_points = outer(pts1$year, pts2$year, `>`)
Then, to find how many of these are separated more than 100 km, we can do
library(units)
sum(distmat[subset_points] > (100 * as_units('km', 1)))
A note on memory usage
However you approach this with sf or data.frame objects, the chances are that you will start to bump up against RAM limits with 1e9 floating points in each matrix or column of a data.table. You might think about instead converting your distance matrix to a raster. Then the raster can be stored on disk rather than in memory, and you can utilise the memory-safe functions in the raster package to crunch your way through.
How we might use rasters to work from disk and save RAM
We can use memory-safe raster operations for the very large matrices like this, for example:
library(raster)
# convert our matrices to rasters, so we can work on them from disk
r = raster(matrix(as.numeric(distmat), length(pts1$id), length(pts2$id)))
s = raster(subset_points)
remove('distmat', 'subset_points')
# now create a raster equal to r, but with zeroes in the cells we wish to exclude from calculation
rs = overlay(r,s,fun=function(x,y){x*y}, filename='out1.tif')
# find which cells have value greater than x (1e6 in the example)
Big_cells = reclassify(rs, matrix(c(-Inf, 1e6, 0, 1e6, Inf, 1), ncol=3, byrow=TRUE), 'out.tiff', overwrite=T)
# and finally count the cells
N = cellStats(Big_cells, sum)

Related

How to fill NA gaps by IDW using focal (R raster/terra)?

I have a big raster with some NA cells that need to be filled. I want to fill it by Inverse Distance Weighting (IDW), by considering the 9 nearest [valid] cells. I used the idw function from the gstat package, but although it works, it takes ages to complete the task (my original raster comprises 6232186 cells that I include in the gstat call, and I have ~14000 gaps to be filled). As I have to repeat this task with several rasters, I'm looking for a faster solution. Does anyone have a suggestion?
I was thinking about using the focal from the raster or terra packages, but to be sincere I didn't understood very well how to set a matrix of weights to get a result like the IDW... Also, I would like to get the nearest valid cells (thus, suppose that in a square focal does not find valid cells, it would look further away to find more valid cells).
Just to give an example, suppose that in the following raster I need to fill the cells of number 310 and 330:
r <- raster(nrow = 20, ncol = 20)
r[1:300] <- sample(1:4, size = 300, replace = T)
plot(r)
gaps <- xyFromCell(r, c(310, 330))
points(gaps)
By using focal with a 3x3 square I would get the mean for just the cell 310 (and without the inverse weighting and also without getting 9 valid cells):
filed <- raster::focal(r, matrix(1, nrow = 3, ncol = 3), fun = mean, NAonly = T, na.rm = T)
plot(filed);points(gaps)
I appreciate any help/suggestion!
One approach would be to use a while loop to increase the window/matrix of the focal function until all NA cells are filled.
With terra it would be like this:
library(terra)
r <- rast(nrow = 20, ncol = 20)
r[1:300] <- sample(1:4, size = 300, replace = T)
gaps <- xyFromCell(r, c(310, 330))
w <- 1
filled <- r # just in case you want to keep the original
to_fill <- any(is.na(values(filled)))
# for big rasters you could use (same inside loop)
# to_fill <- global(filled, function(x) any(is.na(x)))[,1]
while(to_fill) {
w <- w + 2
filled <- focal(filled, w = w, fun = mean, na.policy = "only", na.rm = T)
to_fill <- any(is.na(values(filled)))
}
plot(filled)
points(gaps)

A function in R for plotting locations with consistent high values in multiple raster data

I have four raster files of the same extent. The pattern of low and high values differ in each raster data. I would like to plot areas in the extent (boundary) with values greater than x (where x is an integer). Can anyone help me with an r function to do this? Please find below a sample code for the raster data. In this example, let say I want to plot and identify cells with values greater 0.4 in all the four rasters. Instead of four separate images I want one image that shows cells with values greater than 4. More like overlaying the raster and identifying cells with values greater than 4 in all the images
library(raster)
r1 <- raster(nrows = 1, ncols = 1, res = 0.5, xmn = -1.5, xmx = 1.5, ymn = -1.5, ymx = 1.5, vals = 0.3)
rr <- lapply(1:4, function(i) setValues(r1,runif(ncell(r1))))
par(mfrow = c(2,2))
plot(rr[[1]])
plot(rr[[2]])
plot(rr[[3]])
plot(rr[[4]])
Thank you/
You can combine raster images with &. First threshold each individual plot:
r2 = lapply(rr, `>`, threshold)
And then combine them, retaining only fields which are all greater than the threshold:
summary = Reduce(`&`, r2)
plot(summary)
This is a super easy solution that can be easily generalized for different length of input:
myplot <- function(input,threshold){
input <- lapply(input,function(x){
x <- x>threshold
})
par(mfrow = c(2,2))
plot(input[[1]])
plot(input[[2]])
plot(input[[3]])
plot(input[[4]])
}
myplot(rr,0.4)

Raster Non-NA Cell Count

This question was asked once in the past (from what I could find), but the only response did not provide a solution. Within a RasterStack, I want to generate summary statistics for each raster (min, max, mean, SD), AND the number of cells included in these calculations (i.e., non-NA cell count). You might think the number would be the same for every raster if they are all the same extent and resolution, but these rasters have been masked by their respective QA layers, resulting in a different number of non-NA cells in each raster layer. I've been using cellStats, but that does not provide cell count as output. I could also use zonal stats, but that does not appear to have this functionality (from what I read). Does anyone know how to add this to my output?
Thanks
I think you are looking for the freq function. This function will give you the frequency of pixels by value. Here is one way you could calculate the number of non-NA pixels with some dummy data.
library(raster)
#Create 2 matrix
m1<-matrix(sample(1:10, 250, replace = T),
nrow = 50,
ncol = 50)
m2<-matrix(sample(11:20, 250, replace = T),
nrow = 50,
ncol = 50)
#Transform it to stack
r1 <- stack(raster(m1), raster(m2))
#Set pixel values == 3 and == 12 as NA
r1[r1 ==3 | r1 == 12]<-NA
#Get your cellStats
cellStats(r1, stat = "mean")
#Transform non-NA values to 1
r1[!is.na(r1)]<-1
#Get frequency of pixels by value
#1's will be the number of non-NA pixels
freq(r1)

Find the common area between two graphs with multiple intersection points

I have following simulated data of following 2 variables. I created the density plot as follows,
set.seed(1)
x1=density(rnorm(100,0.5,3))
x2=density(rnorm(100,1,3))
plot(x1)
lines(x2)
Is there any function that can use to find the common area for these 2 graphs using R ?
Do i need to perform an integration for intersecting points ?
Thank you
If you set the sequence both densities use for x values to be identical, you can use pmin on the y values. (Call str(x1) to see how they're stored.) For instance, to see how it works:
set.seed(1)
x1 <- density(rnorm(100,0.5,3), from = -10, to = 10, n = 501)
x2 <- density(rnorm(100,1,3), from = -10, to = 10, n = 501)
plot(x2, main = 'Density intersection')
lines(x1)
polygon(x1$x, pmin(x1$y, x2$y), 20, col = 'dodgerblue')
Taking the integral means just multiplying each pmin times the increment in the x sequence and summing the lot:
sum(pmin(x1$y, x2$y) * diff(x1$x[1:2]))
#> [1] 0.896468

Calculate raster with each cell equals the mean of all adjacent cells

I am working on an ecological problem, involving species distribution models. I have a raster which is essentially a landscape of probabilities of presence per cell, so to speak. I want to calculate a new raster, based on the old one, where each cell is equal to the mean of itself and all 8 adjacent cells. This is not the same as aggregating the cells by mean, which results in the border between the newly aggregated cells being calculated incorrectly.
I can do this with the bit of code provided, but the raster I am working with is way, way too big to run this calculation, as it uses too much memory. If I subdivide the raster, it will still take days to do. Does anyone have a more efficient way of calculating this? I have created a small version of the raster as an example, albeit somewhat clumsily:
require(raster)
## create raster called "ras" rather clumsily
## create raster called "ras" rather clumsily
# (UTM coordinates and a probability value for each cell, not really
# important)
s.x = seq(249990, by = 30, length.out = 20)
s.y = seq(6189390, by = 30, length.out = 20)
x.l = lapply(1:20, function(x){
rep(s.x[x], 20)
})
x.l2 = as.vector(c(x.l[[1]], x.l[[2]], x.l[[3]], x.l[[4]], x.l[[5]],
x.l[[6]], x.l[[7]], x.l[[8]], x.l[[9]], x.l[[10]],
x.l[[11]], x.l[[12]], x.l[[13]], x.l[[14]], x.l[[15]],
x.l[[16]],x.l[[17]], x.l[[18]], x.l[[19]], x.l[[20]]))
df = as.data.frame(cbind(x.l2, rep(s.y, 20), rnorm(20*20, 0.5, 0.2)))
colnames(df) = c("x", "y", "P")
coordinates(df) <- ~ x + y
gridded(df) <- TRUE
ras = raster(df)
# for each cell, make a vector of the values at
# the cell and all <=8 adjacent cells:
vl = lapply(1:length(ras), function(x){
extract(ras,
(c(x,(adjacent(ras, x, directions=8, pairs=F, sorted=F)))))
})
# find the mean for each cell
vm = sapply(1:length(ras), function(x){
as.vector(mean(vl[[x]], na.rm = T))
})
# create raster template
templ = ras/ras
# multiply into template for new raster
ras = vm*templ

Resources