R GSIF package buffer.dist(): 'subscript out of bounds' - r

Question

I which to use the buffer.dist() function of the GSIF package developed by Tomislav Hengl et al. (2018). It has not been updated since 2019 and was taken down from CRAN.
I downloaded the latest version of GSIF (v0.5-5 - 2019-01-04) from the CRAN repository and loaded the functions manually into the R workspace. All functions can be found in the folder "R".
> sessionInfo()
R version 4.2.1 (2022-06-23)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Big Sur 11.6
# Manually load GSIF environment (manually download from CRAN repository)
source("AAAA.R") # needs to be loaded first
# Manually load function buffer.dist()
source("buffer.dist.R")
# Load library
library(sp)
library(plotKML)
library(raster)
library(gstat)
## Follow the workflow in the tutorial: https://peerj.com/articles/5518/GeoMLA_README_thengl.pdf
# Load example data from gstat package
data(meuse, echo = FALSE)
data(meuse.grid)
# transform into SpatialPoints objects (input data requirement for buffer.dist() )
meuse.sp <- SpatialPointsDataFrame(meuse[1:2], meuse[3:14], proj4string = CRS('+init=epsg:4326'))
meuse.grid.spdf <- SpatialPixelsDataFrame(meuse.grid[1:2], meuse.grid[6], proj4string = CRS('+init=epsg:4326'))
# derive buffer distances for each individual point, using the buffer function in the raster package which derives a gridded map for each observation point ()
grid.dist0 <- buffer.dist(meuse.sp["zinc"],
meuse.grid.spdf[1],
as.factor(1:nrow(meuse.sp)))
This gives me the following error message:
Error in x#coords[i, , drop = FALSE] : subscript out of bounds
Here is the buffer.dist() function (Hengl et al., 2018):
setMethod("buffer.dist", signature(observations = "SpatialPointsDataFrame", predictionDomain = "SpatialPixelsDataFrame"), function(observations, predictionDomain, classes, width, ...){
if(missing(width)){ width <- sqrt(areaSpatialGrid(predictionDomain)) }
if(!length(classes)==length(observations)){ stop("Length of 'observations' and 'classes' does not match.") }
## remove classes without any points:
xg = summary(classes, maxsum=length(levels(classes)))
selg.levs = attr(xg, "names")[xg > 0]
if(length(selg.levs)<length(levels(classes))){
fclasses <- as.factor(classes)
fclasses[which(!fclasses %in% selg.levs)] <- NA
classes <- droplevels(fclasses)
}
## derive buffer distances
s <- list(NULL)
for(i in 1:length(levels(classes))){
s[[i]] <- raster::distance(rasterize(observations[which(classes==levels(classes)[i]),1]#coords, y=raster(predictionDomain)), width=width, ...)
}
s <- s[sapply(s, function(x){!is.null(x)})]
s <- brick(s)
s <- as(s, "SpatialPixelsDataFrame")
s <- s[predictionDomain#grid.index,]
return(s)
})
I went through all steps of the function manually. It is in the second last row where the bug seems to occur:
s <- s[predictionDomain#grid.index,]
Error in x#coords[i, , drop = FALSE] : subscript out of bounds
Do you have any suggestion how to fix the issue?

Answer 1

You do not describe what that method does, but it seems that it does something like this:
bufdist <- function(obs, r, classes, width) {
s <- list()
cls <- sort(unique(classes))
for (i in 1:length(cls)) {
obsi <- obs[classes==cls[i], ]
x <- rasterize(obsi, r)
s[[i]] <- buffer(x, width, background=NA)
}
names(s) <- cls
rast(s)
}
library(terra)
f <- system.file("ex/elev.tif", package="terra")
r <- rast(f)
set.seed(1)
v <- spatSample(r, 50, as.points=TRUE)
cls <- sample(LETTERS[1:4], 50, replace=TRUE)
b <- bufdist(v, r, cls, 7500)
plot(b, col="red")