Extracting pixels values and coordinates in neighborhood of given buffer with NA values

问题

I want to get values (pixels values), coordinates (x and y) and attribute (status) in the neighborhood (for example in a buffer=6 meters) of random coordinates (pts), using extract function in raster package. I try to organize the results in data.frame without NA values and this problem is solved by @Robert Hijmans in Extracting pixels values and coordinates in neighborhood of given buffer in R.

But, if I have some coordinates outside of one of raster (and I create the s2 raster with this purpose) the script doesn't work. I try to remove not complete elements in a list (NA values, different number of elements/columns), but the final results don't match.

In my new approach I make:

library(raster)  
r <- raster(ncol=10, nrow=10, crs="+proj=utm +zone=1 +datum=WGS84", xmn=0, xmx=50, ymn=0, ymx=50)
s1 <- stack(lapply(1:4, function(i) setValues(r, runif(ncell(r)))))
r2 <- raster(ncol=10, nrow=10, crs="+proj=utm +zone=1 +datum=WGS84", xmn=0, xmx=100, ymn=0, ymx=100) # Large raster for produce NAs
s2 <- stack(lapply(1:4, function(i) setValues(r2, runif(ncell(2)))))
ras <- list(s1, s2)
pts <- data.frame(pts=sampleRandom(s2, 100, xy=TRUE)[,1:2], status=rep(c("A","B"),5))

# get xy from buffer cells
cell <- extract(r, pts[,1:2], buffer=6, cellnumbers=T)
xy <- xyFromCell(r, do.call(rbind, cell)[,1])
xy<-xy[complete.cases(xy),] # Remove NA coordinates


# lopp for extract pixel values and coordinates
res <- list()
for (i in 1:length(ras)) {
    v <- raster::extract(ras[[i]], pts[,1:2], buffer=6)
    delete.NULLs1  <-  function(x.list){   # delele one single column in a list 
    x.list[unlist(lapply(x.list, function(x) length(unique(x))) != 1)]} 
    delete.NULLs2  <-  function(x.list){   # delele different number of elements in a list
    x.list[unlist(lapply(x.list, length)) >= 5]}
    delete.NULLs3  <-  function(x.list){   # delele null/empty entries in a list
    x.list[unlist(lapply(x.list, length) != 0)]}
    v <- delete.NULLs1(v)
    v <- delete.NULLs2(v)
    v <- delete.NULLs3(v)
    # add point id
    for (j in 1:length(v)) {
        v[[j]] <- cbind(point=j, v[[j]])
    }
    #add layer id and xy
    res[[i]] <- cbind(layer=i, xy, do.call(rbind, v))
}
res <- do.call(rbind, res)

And my output always is:

Error in cbind(layer = i, xy, do.call(rbind, v)) : 
  number of rows of matrices must match (see arg 3)

After delete.NULLs functions, I losing coordinates/rasters list correspondence. Any ideas, please?

回答1:

Here is how I might approach it

Example data

library(raster)  
r <- raster(ncol=10, nrow=10, crs="+proj=utm +zone=1 +datum=WGS84", xmn=0, xmx=50, ymn=0, ymx=50)
s1 <- stack(lapply(1:4, function(i) setValues(r, runif(ncell(r)))))
r2 <- raster(ncol=10, nrow=10, crs="+proj=utm +zone=1 +datum=WGS84", xmn=0, xmx=100, ymn=0, ymx=100) # Large raster for produce NAs
s2 <- stack(lapply(1:4, function(i) setValues(r2, runif(ncell(2)))))
ras <- list(s1, s2)
pts <- data.frame(pts=sampleRandom(s2, 100, xy=TRUE)[,1:2], status=rep(c("A","B"),5))

# get xy from buffer cells
cell <- extract(r, pts[,1:2], buffer=6, cellnumbers=T)
xy <- xyFromCell(r, do.call(rbind, cell)[,1])
xy<-xy[complete.cases(xy),] # Remove NA coordinates

Updated algorithm

res <- list()
for (i in 1:length(ras)) {
    v <- raster::extract(ras[[i]], pts[,1:2], buffer=6)
    # find invalid cases (NA or zero rows), a bit tricky
    k <- sapply(sapply(v, nrow), function(i) ifelse(is.null(i), FALSE, i>0))
    # jump out of loop if there is no data
    if (!any(k)) next
    # remove the elements from the list that have no data
    v <- v[k]
    k <- which(k)
    # add point id
    for (j in 1:length(k)) {
        kj <- k[j]
        v[[j]] <- cbind(point=kj, xy[kj,1], xy[kj,2], v[[j]])
    }
    v <- do.call(rbind, v)
    colnames(v)[2:3] <- c("x", "y")
    #add layer id and xy
    res[[i]] <- cbind(layer=i, v)
}
res <- do.call(rbind, res)

来源：https://stackoverflow.com/questions/57779014/extracting-pixels-values-and-coordinates-in-neighborhood-of-given-buffer-with-na

标签

raster

r-raster