Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

If raster value NA search and extract the nearest non-NA pixel

Tags:

r

r-raster

On extracting values of a raster to points I find that I have several NA's, and rather than use a buffer and fun arguments of extract function, instead I'd like to extract the nearest non-NA Pixel to a point that overlaps NA.

I am using the basic extract function:

data.extr<-extract(loc.thr, data[,11:10])
like image 956
Joe Avatar asked Dec 19 '14 08:12

Joe


3 Answers

Here's a solution without using the buffer. However, it calculates a distance map separately for each point in your dataset, so it might be ineffective if your dataset is large.

set.seed(2)

# create a 10x10 raster
r <- raster(ncol=10,nrow=10, xmn=0, xmx=10, ymn=0,ymx=10)
r[] <- 1:10
r[sample(1:ncell(r), size = 25)] <- NA

# plot the raster
plot(r, axes=F, box=F)
segments(x0 = 0, y0 = 0:10, x1 = 10, y1 = 0:10, lty=2)
segments(y0 = 0, x0 = 0:10, y1 = 10, x1 = 0:10, lty=2)

# create sample points and add them to the plot
xy = data.frame(x=runif(10,1,10), y=runif(10,1,10))
points(xy, pch=3)
text(x = xy$x, y = xy$y, labels = as.character(1:nrow(xy)), pos=4, cex=0.7, xpd=NA)

# use normal extract function to show that NAs are extracted for some points
extracted = extract(x = r, y = xy)

# then take the raster value with lowest distance to point AND non-NA value in the raster
sampled = apply(X = xy, MARGIN = 1, FUN = function(xy) r@data@values[which.min(replace(distanceFromPoints(r, xy), is.na(r), NA))])

# show output of both procedures
print(data.frame(xy, extracted, sampled))

#          x        y extracted sampled
#1  5.398959 6.644767         6       6
#2  2.343222 8.599861        NA       3
#3  4.213563 3.563835         5       5
#4  9.663796 7.005031        10      10
#5  2.191348 2.354228        NA       2
#6  1.093731 9.835551         2       2
#7  2.481780 3.673097         3       3
#8  8.291729 2.035757         9       9
#9  8.819749 2.468808         9       9
#10 5.628536 9.496376         6       6
like image 52
koekenbakker Avatar answered Oct 20 '22 13:10

koekenbakker


This is a raster-based solution, by first filling the NA pixels with the nearest non-NA pixel value. Note however, that this does not take into account the position of a point within a pixel. Instead, it calculates the distances between pixel centers to determine the nearest non-NA pixel.

First, it calculates for each NA raster pixel the distance and direction to the nearest non-NA pixel. The next step is to calculate the coordinates of this non-NA cell (assumes projected CRS), extract its value and to store this value at the NA location.

Starting data: a projected raster, with identical values as in the answer from koekenbakker:

set.seed(2)
# set projected CRS
r <- raster(ncol=10,nrow=10, xmn=0, xmx=10, ymn=0,ymx=10, crs='+proj=utm +zone=1') 
r[] <- 1:10
r[sample(1:ncell(r), size = 25)] <- NA

# create sample points
xy = data.frame(x=runif(10,1,10), y=runif(10,1,10))

# use normal extract function to show that NAs are extracted for some points
extracted <- raster::extract(x = r, y = xy)

Calculate the distance and direction from all NA pixels to the nearest non-NA pixel:

dist <- distance(r)  
# you can also set a maximum distance: dist[dist > maxdist] <- NA
direct <- direction(r, from=FALSE)

Retrieve coordinates of NA pixels

# NA raster
rna <- is.na(r) # returns NA raster

# store coordinates in new raster: https://stackoverflow.com/a/35592230/3752258 
na.x <- init(rna, 'x')
na.y <- init(rna, 'y')

# calculate coordinates of the nearest Non-NA pixel
# assume that we have a orthogonal, projected CRS, so we can use (Pythagorean) calculations
co.x <- na.x + dist * sin(direct)
co.y <- na.y + dist * cos(direct)

# matrix with point coordinates of nearest non-NA pixel
co <- cbind(co.x[], co.y[]) 

Extract values of nearest non-NA cell with coordinates 'co'

# extract values of nearest non-NA cell with coordinates co
NAVals <- raster::extract(r, co, method='simple') 
r.NAVals <- rna # initiate new raster
r.NAVals[] <- NAVals # store values in raster

Fill the original raster with the new values

# cover nearest non-NA value at NA locations of original raster
r.filled <- cover(x=r, y= r.NAVals)

sampled <- raster::extract(x = r.filled, y = xy)

# compare old and new values
print(data.frame(xy, extracted, sampled))

#           x        y extracted sampled
# 1  5.398959 6.644767         6       6
# 2  2.343222 8.599861        NA       3
# 3  4.213563 3.563835         5       5
# 4  9.663796 7.005031        10      10  
# 5  2.191348 2.354228        NA       3
# 6  1.093731 9.835551         2       2
# 7  2.481780 3.673097         3       3
# 8  8.291729 2.035757         9       9
# 9  8.819749 2.468808         9       9 
# 10 5.628536 9.496376         6       6

Note that point 5 takes another value than the answer of Koekenbakker, since this method does not take into account the position of the point within a pixel (as mentioned above). If this is important, this solution might not be appropriate. In other cases, e.g. if the raster cells are small compared to the point accuracy, this raster-based method should give good results.

like image 4
Lennert Avatar answered Oct 20 '22 12:10

Lennert


For a raster stack, use @koekenbakker's solution above, and turn it into a function. A raster stack's @layers slot is a list of rasters, so, lapply it across and go from there.

#new layer
r2 <- raster(ncol=10,nrow=10, xmn=0, xmx=10, ymn=0,ymx=10)
r2[] <- 1:10
r2[sample(1:ncell(r2), size = 25)] <- NA

#make the stack
r_stack <- stack(r, r2)

#a function for sampling
sample_raster_NA <- function(r, xy){
  apply(X = xy, MARGIN = 1, 
        FUN = function(xy) r@data@values[which.min(replace(distanceFromPoints(r, xy), is.na(r), NA))])

}

#lapply to get answers
lapply(r_stack@layers, function(a_layer) sample_raster_NA(a_layer, xy))

Or to be fancy (speed improvements?)

purrr::map(r_stack@layers, sample_raster_NA, xy=xy)

Which makes me wonder if the whole thing can be sped up even more using dplyr...

like image 1
jebyrnes Avatar answered Oct 20 '22 13:10

jebyrnes