terra::distance only reports distance to NA raster cells - r

I am attempting to use terra::distance as I would use raster::distanceFromPoints. However, terra::distance only reports the distance from the point(s) to NA cells. Is this the intended result? I include sample code with my workaround.
Raster plot with point for distance calculation
Plot of terra::distance for point
Desired output
r <- terra::rast(ncols=10, nrows=10)
valR <- rep(1, length = 100)
valR[c(1,12,23,34,45,56,67,78,89,100)] <- NA
terra::values(r) <- valR
xp <- c(50)
yp <- c(50)
xyp <- cbind(xp, yp)
vecP <- terra::vect(xyp)
terra::plot(r)
terra::plot(vecP, add=T)
rDist <- terra::distance(r, vecP)
terra::plot(rDist) #only NA cells have the distance value
# WORKAROUND
r1 = r*0
r1[is.na(r1)] <- 100
r1[r1<1] <- NA
r1Dist <- terra::distance(r1, vecP)
terra::plot(r1Dist)
####################
# using raster::distanceFromPoints
####################
rR <- raster::raster(ncols=10, nrows=10)
raster::values(rR) <- valR
raster::plot(rR)
rRDist <- raster::distanceFromPoints(rR, xyp)
rRDist <- raster::mask(rRDist, rR)
raster::plot(rRDist)

I tested this using distance to a SpatVector of lines rather than points. That seems to work as expected. I assume that maybe it has not been implemented for points yet.
So, another workaround you could use is to calculate distance to lines of zero length (which are basically equivalent to points):
x1 <- rbind(c(50,50), c(50,50))
colnames(x1) <- c('x', 'y')
lns <- vect(x1, "lines")
rDist <- distance(r, lns)
plot(rDist)

Related

Coordinate values in R

I'm new to R and trying to learn how it's done for some species distribution modeling. I'm trying to create a mask of Italy using the wrld_simpl map included with the maptools package. When I run the code, I get "Error in .local(obj, ...) : NA values in coordinates" when I'm trying to create spxy. I suspect that this issue might be rooted in the rasterization step but I'm not sure... What am I doing wrong?
Apologies for the code dump
# Create library
library(raster)
library(dismo)
library(sf)
library(maptools)
library(rgdal)
library(sp)
library(rgeos)
# Call the cleaned nivale csv
nivale <- read.table('C:/Users/David/Documents/nival_1980_GeoDat.csv', header=T, sep = ',')
nivale <- nivale[,2:3]
# Create a simple map of Italy, plot nivale data points
data(wrld_simpl)
plot(wrld_simpl, xlim=c(0,20), ylim=c(40,50), axes=TRUE, col="light yellow")
box()
points(nivale$lon, nivale$lat, col='orange', pch=20, cex=0.75)
points(nivale$lon, nivale$lat, col='black', cex=0.75)
# set CRS of nivale equal to wrld_simpl
coordinates(nivale) <- ~lon+lat
crs(nivale) <- crs(wrld_simpl)
projection(nivale) <- CRS('+proj=longlat +datum=WGS84')
class(nivale)
class(wrld_simpl)
# Sampling Bias Assessment
r <- raster(nivale)
res(r) <- 1
r <- extend(r, extent(r)+1)
nisel <- gridSample(nivale, r, n=1)
p <- rasterToPolygons(r)
plot(p, border='blue')
points(nivale)
points(nisel, cex=1, col='red', pch='x')
# Pseudo-Absences
# Create shapefile from wrld_simpl
italy <- wrld_simpl[is.element(wrld_simpl$NAME, 'Italy'),]
set.seed(1963)
crsi = crs('+proj=longlat +datum=WGS84')
exti = extent(italy)
# Create template for rasterization
rst_temp <- raster(ncols = 1000, nrows = 1000,
crs = crsi,
ext = exti)
# Rasterize italy
rst_italy <- rasterize(italy, rst_temp)
# Random point generation
rand_point <- randomPoints(rst_italy, 250)
#Pseudo-Absence Points
x <- circles(nivale, d=50000, lonlat=TRUE)
pol <- polygons(x)
samp1 <- spsample(pol, 250, type='random', iter=25)
cells <- cellFromXY(rst_italy, samp1)
xy <- xyFromCell(rst_italy, cells)
plot(pol, axes=TRUE)
points(xy, cex=0.75, pch=20, col='blue')
#
# Error - NA values in coordinates
spxy <- SpatialPoints(xy, proj4string=CRS('+proj=longlat +datum=WGS84'))
o <- over(spxy, geometry(x))
xyInside <- xy[!is.na(o), ]
v <- extract(mask, x#polygons, cellnumbers=T)
v <- do.call(rbind, v)
v <- unique(v[,1])
head(v)
m <- italy
m[] <- NA
m[v] <- 1
plot(m, ext=extent(x#polygons)+1)
plot(x#polygons, add=T)
I don't have your nivale dataset, so I am not 100% sure, but I think the error arises after you are sampling points within polygons (spsample(pol, 250, type='random', iter=25)) created using circle() and not because of the rasterization, which looks fine to me. My guess is that, after this, you sample random points in these polygons, which may fall outside the raster of Italy (samp1 <- spsample(pol, 250, type='random', iter=25)). Possibly, you can just remove such points by excluding NAs values in xy:
xy <- xy[!is.na(xy[, 1]) & !is.na(xy[, 2])]
Try this and see if it works. If you need a certain number of points (e.g. xy needs to have 250 lines), you can put a while loop until you have what you want; this may take (a lot of) time, though.
/Emilio

How to rasterize linestrings by summing length?

I would like to calculate the total length of the linestrings within each raster cell. I have a cumbersome workaround, but I think there is a more efficient way to do this directly with the rasterize function. The following MWE shows what I would like and my working solution thus far.
library(sf)
library(raster)
## Base Raster
base_rast <- raster( matrix(runif(100, max=10),10,10))
## LineStrings
ls <- st_linestring(rbind(c(0,0),c(1,1),c(2,1)))
mls <- st_multilinestring(list(rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1))))
sfc <- st_sf( geometry=st_sfc(ls,mls) )
sfc$ID <- 1:length(sfc)
## Would Like To Do Something Like
new_fun <- function(j){ sum(sapply(j, st_length)) }
i_length <- rasterize(sfc, base_rast, fun=new_fun)
## Cumbersome Workaround
base_polygon <- rasterToPolygons(base_rast)
base_polygon <- st_as_sf(base_polygon)
base_polygon$baseID <- 1:nrow(base_polygon)
i_poly <- st_intersection(i_poly, sfc)
i_poly_list <- split(i_poly, i_poly$baseID)
i_length <- sapply(i_poly_list, function(j) sum(st_length(j)))
i_mat <- cbind(baseID=as.numeric(names(i_poly_list)), i_length)
lengths <- merge(base_polygon, i_mat, by='baseID', all=T)
i_df <- data.frame(
st_coordinates(st_centroid(lengths))[,c('X','Y')],
river_length=lengths$i_length)
coordinates(i_df) <- ~X+Y
gridded(i_df) <- TRUE
i_length <- raster(i_df)

Counting spatialpoints in gridcells

SO-gurues!
I am trying to count the densities of surviving units in different gridcells.
I have two shapefiles with points from the two survey periods in question (one before and one after the mortality event). What I intend is to see whether there is a difference in survival rates and link the proportion of survival to any climatic variable obtained from the raster value of the desired grid. In the code snippet below I have created some random raster and shapefiles.
packs = c('raster', 'rgdal', 'spatstat', 'sp' ,'dplyr')
sapply(packs, FUN = 'require', character.only = TRUE)
xy <- matrix(rnorm(1024),32,32) #Creating the desired raster
image(xy)
rast <- raster(xy)
extent(rast) <- c(36,37,-3,-2)
projection(rast) <- CRS("+proj=longlat +datum=WGS84")
points <- runifpoint(n =4000, c(36,37,-3,-2)) # Creating the points
x <- points$x
y <- points$y
values <- c(rep(1, 900), rep(0, 3100))
xy <- cbind(x, y)
points <- cbind(x, y, values)
points <- data.frame(points)
shp <- SpatialPointsDataFrame(coords = xy, data = data.frame(values) ) # creating shpfiles
projection(shp) <- CRS("+proj=longlat +datum=WGS84")
subs <- filter(points, values == 1)
suxy <- select(subs, x,y)
shpsub <- SpatialPointsDataFrame(coords = suxy, data = data.frame(subs$values)) # creating shpfiles
projection(shpsub) <- CRS("+proj=longlat +datum=WGS84")
When I attempt to extract the points I use the following lines of code
shp <- spTransform(shp, projection(rast)) # make sure they have same transformation
shpsub <- spTransform(shpsub, projection(rast))
XY <- xyFromCell(rast, cell = 1:ncell(rast))
v <- as.data.frame(rast) #Extract values from raster
XY <- data.frame(XY, v) # Creating a data frame containing coord., cellno and value
XY$cell <- c(1:ncell(rast))
cells <- cellFromXY(rast,shp) # find which cells the points are in
cells <- rle(cells) # returns a value and a length, fast for counting
cellsfound <- cellFromXY(rast,shpsub)
cellsfound <- rle(cellsfound)
Proportion <- data.frame(cell = cells$values, shp = cells$lengths)
test <- data.frame(cell = rep(NA,NROW(Proportion)), shpsub = rep(NA, NROW(Proportion)))
test$cell <- c(cellsfound$values, rep(NA, nrow(test) - length(cellsfound$values)))
test$shpsub <- c(cellsfound$lengths, rep(NA, NROW(test) - length(cellsfound$lengths)))
Proportion <- full_join(Proportion, test, by = "cell")
test.Proportion <- mutate(Proportion, Proportion = shpsub/shp) #Calculating Proportion
XY <- left_join(XY, test.Proportion, by = "cell") # Adding Proportion to coord and cell no.
XY.m <- summarise(XY, )
XY <- na.omit(XY) ; XY <- XY[,-4]
As I see it. Using rle() returns the same cells multiple times instead of counting the no of points within each individual cell as was my intention. Can anyone please explain me how to do this in a way that retrieves the information on the number of occurrences in the individual cells?

R Crop no-data of a raster

I would like to crop the no-data part of some rasters (example of the image in 1 where no-data is in black) without defining the extent manually.
Any idea?
You can use trim to remove exterior rows and columns that only have NA values:
library(raster)
r <- raster(ncols=18,nrows=18)
r[39:49] <- 1
r[205] <- 6
s <- trim(r)
To change other values to or from NA you can use reclassify. For example, to change NA to 0:
x <- reclassify(r, cbind(NA, 0))
[ subsetting and [<- replacement methods are defined for raster objects so you can simply do r[ r[] == 1 ] <- NA to get rid of the values where 1 is your nodata value (use NAvalue(r) to find out what R considers your nodata value is supposed to be if you aren't sure).
Note you have to use r[] inside the [ subsetting command to access the values. Here is a worked example...
Example
# Make a raster from system file
logo1 <- raster(system.file("external/rlogo.grd", package="raster"))
# Copy to see difference
logo2 <- logo1
# Set all values in logo2 that are > 230 to be NA
logo2[ logo2[] > 230 ] <- NA
# Observe difference
par( mfrow = c( 1,2 ) )
plot(logo1)
plot(logo2)
I have 2 slightly different solutions. The first requires to manually identify the extent but uses predefined functions. The second is more automatic, but a bit more handmade.
Create a reproducible raster for which the first 2 rows are NA
library(raster)
# Create a reproducible example
r1 <- raster(ncol=10, nrow=10)
# The first 2 rows are filled with NAs (no value)
r1[] <- c(rep(NA,20),21:100)
Solution #1
Manually get the extent from the plotted figure using drawExtent()
plot(r1)
r1CropExtent <- drawExtent()
Crop the raster using the extent selected from the figure
r2 <- crop(r1, r1CropExtent)
Plot for comparison
layout(matrix(1:2, nrow=1))
plot(r1)
plot(r2)
Solution #2
It identifies the rows and columns of the raster that only have NA values and remove the ones that are on the margin of the raster. It then calculate the extent using extent().
Transform the raster into a matrix that identifies whether the values are NA or not.
r1NaM <- is.na(as.matrix(r1))
Find the columns and rows that are not completely filled by NAs
colNotNA <- which(colSums(r1NaM) != nrow(r1))
rowNotNA <- which(rowSums(r1NaM) != ncol(r1))
Find the extent of the new raster by using the first ans last columns and rows that are not completely filled by NAs. Use crop() to crop the new raster.
r3Extent <- extent(r1, rowNotNA[1], rowNotNA[length(rowNotNA)],
colNotNA[1], colNotNA[length(colNotNA)])
r3 <- crop(r1, r3Extent)
Plot the rasters for comparison.
layout(matrix(1:2, nrow=1))
plot(r1)
plot(r3)
I have written a small function based on Marie's answer to quickly plot cropped rasters. However, there may be a memory issue if the raster is extremely large, because the computer may not have enough RAM to load the raster as a matrix.
I therefore wrote a memory safe function which will use Marie's method if the computer has enough RAM (because it is the fastest way), or a method based on raster functions if the computer does not have enough RAM (it is slower but memory-safe).
Here is the function:
plotCroppedRaster <- function(x, na.value = NA)
{
if(!is.na(na.value))
{
x[x == na.value] <- NA
}
if(canProcessInMemory(x, n = 2))
{
x.matrix <- is.na(as.matrix(x))
colNotNA <- which(colSums(x.matrix) != nrow(x))
rowNotNA <- which(rowSums(x.matrix) != ncol(x))
croppedExtent <- extent(x,
r1 = rowNotNA[1],
r2 = rowNotNA[length(rowNotNA)],
c1 = colNotNA[1],
c2 = colNotNA[length(colNotNA)])
plot(crop(x, croppedExtent))
} else
{
xNA <- is.na(x)
colNotNA <- which(colSums(xNA) != nrow(x))
rowNotNA <- which(rowSums(xNA) != ncol(x))
croppedExtent <- extent(x,
r1 = rowNotNA[1],
r2 = rowNotNA[length(rowNotNA)],
c1 = colNotNA[1],
c2 = colNotNA[length(colNotNA)])
plot(crop(x, croppedExtent))
}
}
Examples :
library(raster)
r1 <- raster(ncol=10, nrow=10)
r1[] <- c(rep(NA,20),21:100)
# Uncropped
plot(r1)
# Cropped
plotCroppedRaster(r1)
# If the no-data value is different, for example 0
r2 <- raster(ncol=10, nrow=10)
r2[] <- c(rep(0,20),21:100)
# Uncropped
plot(r2)
# Cropped
plotCroppedRaster(r2, na.value = 0)
If you use the rasterVis package (any version after Jun 25, 2021), it will automatically crop the NA values out for terra's SpatRaster
Install rasterVis development version from GitHub
if (!require("librarian")) install.packages("librarian")
librarian::shelf(raster, terra, oscarperpinan/rastervis)
# Create a reproducible example
r1 <- raster(ncol = 10, nrow = 10)
# The first 2 rows are filled with NAs (no value)
r1[] <- c(rep(NA, 20), 21:100)
levelplot() for r1
rasterVis::levelplot(r1,
margin = list(axis = TRUE))
Convert to terra's SpatRaster then plot again using levelplot()
r2 <- rast(r1)
rasterVis::levelplot(r2,
margin = list(axis = TRUE))
Created on 2021-06-26 by the reprex package (v2.0.0)

get coordinates of a patch in a raster map (raster package in R)

I have a raster map with many patches (clumps of continguous cells with the same value). What I need to do is to obtain the coordinates of the center (or close to the center) of each patch.
I am very unexperienced with raster package but it seems I can get coordinates only if I know the position of the cells in the map. Is there any way to get coordinates giving a value of the cells instead? Thank you
If by patch you mean clumps, Raster package allows you to find , and isolate, clumps. Taking the clump() raster package example, and extending it:
library(raster)
library(igraph)
detach("package:coin", unload=TRUE)
r <- raster(ncols=12, nrows=12)
set.seed(0)
r[] <- round(runif(ncell(r))*0.7 )
rc <- clump(r)
clump_id <- getValues(rc)
xy <- xyFromCell(rc,1:ncell(rc))
df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1])
df[df$is_clump == T, ]
plot(r)
plot(rc)
text(df[df$is_clump == T, 1:2], labels = df[df$is_clump == T, 3])
May not be as interesting as you could expect.
You do it all over with directions = 4
rc <- clump(r, directions = 4)
clump_id <- getValues(rc)
xy <- xyFromCell(rc,1:ncell(rc))
df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1])
df[df$is_clump == T, ]
to get
and maybe clump 'centroids'
dfm <- ddply(df[df$is_clump == T, ], .(clump_id), summarise, xm = mean(x), ym = mean(y))
plot(rc)
text(dfm[, 2:3], labels = dfm$clump_id)
Notes:
There will be an error if you try to use clump() without first
detach modeltools library. modeltools is called by coin and maybe
other statistical libraries.
You could take the mean of the coordinates of each patch:
# some dummy data
m <- matrix(c(
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,
0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,
0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,
0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,
0,0,2,3,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
0,0,2,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), nrow=20, byrow=T)
# create a raster
r <- raster(m)
# convert raster to points
p <- data.frame(rasterToPoints(r))
# filter out packground
p <- p[p$layer > 0,]
# for each patch calc mean coordinates
sapply(split(p[, c("x", "y")], p$layer), colMeans)

Resources