Fill the gaps in raster stack using subsequent layers - r

Suppose I have a raster stack that each layer has data gap in. I want to use the next two layers in the stack to fill the gaps of each layer:
library(raster)
r1 <- raster(ncol=20,nrow=20, xmn=0, xmx=20, ymn=0,ymx=20)
r1[] <- 1:20
r2 <- r3 <- r4 <- r5 <- r1
set.seed(0)
r1[sample(1:ncell(r1), size = 20)] <- NA
r2[sample(1:ncell(r2), size = 30)] <- NA
r3[sample(1:ncell(r3), size = 10)] <- NA
r4[sample(1:ncell(r4), size = 18)] <- NA
r5[sample(1:ncell(r5), size = 18)] <- NA
s <- stack(r1, r2, r3, r4, r5)
In this case r2 and r3 will be used to fill the gaps in r1 and so forth.

MikeJewski's solution might work, but the cover function is designed for this and more direct. It is not clear how you want to use the next two layers. The mean:
for(i in 1:(nlayers(s) - 2) ){
s[[i]] <- cover( s[[i]], mean( s[[(i+1):(i+2)]], na.rm=TRUE))
}
Or first the closest (as MikeJewski assumed):
for(i in 1:(nlayers(s) - 2) ){
s[[i]] <- cover( s[[i]], s[[(i+1)]])
s[[i]] <- cover( s[[i]], s[[(i+2)]])
}
This would be another, but probably inefficient, approach:
f <- function(x) {
for(i in 1:((ncol(x)-2)) ){
x[is.na(x[,i]),i] <- x[is.na(x[,i]),i+1]
x[is.na(x[,i]),i] <- x[is.na(x[,i]),i+2]
}
x
}
ss <- calc(s, f)

Not sure if this is what you want, but it will give you a start. I'm still new to R, so there is probably another way to do it.
library(raster)
r1 <- raster(ncol=20,nrow=20, xmn=0, xmx=20, ymn=0,ymx=20)
r1[] <- 1:20
r2 <- r3 <- r4 <- r5 <- r1
set.seed(0)
r1[sample(1:ncell(r1), size = 20)] <- NA
r2[sample(1:ncell(r2), size = 30)] <- NA
r3[sample(1:ncell(r3), size = 10)] <- NA
r4[sample(1:ncell(r4), size = 18)] <- NA
r5[sample(1:ncell(r5), size = 18)] <- NA
s <- stack(r1, r2, r3, r4, r5)
for(i in 1:(nlayers(s) - 2) ){
s[[i]] <- merge( s[[i]], mask( s[[(i+1)]], s[[i]], inverse = TRUE))
s[[i]] <- merge( s[[i]], mask( s[[(i+2)]], s[[i]], inverse = TRUE))
}

Here is an adaptation for those who want to fill gaps with a moving window. This is using the average of the pixel values before and after the gap. The code also makes sure to fill in the gaps in the beginning and at the end of the RasterStack:
fill_gaps <- function(IMG, WINDOW=2){
# Arguments:
# IMG: RasterStack or RasterBrick containing the datacube with gaps. The empty pixels must be NA value, not 0.
# WINDOW: (integer) the number of images before and after the gap used to fill the gap. By default WINDOW=2.
# Note that the NA values will be replaced by the mean value of the images in ''window''.
# If your empty pixels are stored as 0 use: img <- img[img < 0] <- NA before applying the function.
if (!require("raster")) install.packages("raster")
library(raster)
s <- raster::stack(IMG)
for(i in 1:nlayers(s)){
if(i <= WINDOW) {
s[[i]] <- cover(s[[i]], mean(s[[WINDOW+1]]:s[[WINDOW*2]]), na.rm=TRUE)}
if(i >= (nlayers(s)-WINDOW)) {
s[[i]] <- cover(s[[i]], mean(s[[nlayers(s)-(WINDOW*2+1)]]:s[[nlayers(s)-WINDOW]]), na.rm=TRUE)}
else {
s[[i]] <- cover( s[[i]], mean(s[[(i-WINDOW):(i+WINDOW)]], na.rm=TRUE))}
}
return(s)
}

Related

Applying complex mathematical functions on Raster Stacks/Bricks in R and creating two different Raster stacks which are dependent on each other

I have a raster brick (ncell=28536 and nlayers=181). I need to run mathematical functions on the original brick and create two more bricks of same size. Where both output bricks are dependent on each other.
inputBrick has 181 layers and 28536 cells per layer. outputBrick1 will calculate values of its 1st layer by analyzing outputBrick2's 1st layer. Then outputBrick2 will calculate values of its 2nd layer by analyzing outputBricks1's 1st layer and so on.
I created a function that works fine with 24 cells and 181 layers. But takes forever for 28000 cells and 181 layers. I know I shouldn't be using for loops for this but as I'm not a programmer I'm struggling.
Here is some example data for a much smaller dataset. There are 3 RasterBricks. Input has values while both outputs are empty
library(raster)
b <- brick(ncols=5, nrows=5, nl=5)
inBrick <- setValues(b, runif(ncell(b) * nlayers(b)))
inBrick[c(1,2,3,22,23,24,25)] <- NA
outBrick1 <- inBrick
outBrick1[] <- NA
outBrick2 <- outBrick1
ini <- 0.3
p <- 0.15
p1 <- p/3
p2 <- p-(p/3)
fc <- 0.3
var1 <- which(!is.na(inBrick[[1]][]))
outBrick2[[1]][var1] <- ini
### now outBrick2 has initial values in 1st layer
weather <- c(0.1, 0, 0, 0, 0.3)
Calculations that I want to do and have no idea how to do it efficiently without using for loops
var3 <- 1:ncell(inBrick)
### outBrick1 Calculations
for (i in 1:nlayers(inBrick)) {
varr1 <- inBrick[[i]][]*(((outBrick2[[i]][]-p1)/(p2))^2)
for (j in 1:ncell(inBrick)) {
if(!is.na(outBrick2[[i]][j])){
if(outBrick2[[i]][j]>p){
outBrick1[[i]][j] <- inBrick[[i]][j]
}else{
outBrick1[[i]][j] <- varr1[j]
}
}
}
###outBrick2 Calculations
for (k in 2:nlayers(inBrick)) {
var2 <- outBrick2[[k-1]][] + (weather[k-1]-outBrick1[[k-1]][])/100
for(l in 1:ncell(inBrick)){
var3[l] <- min(fc, var2[l])
}
outBrick2[[k]][] <- var3
}
}
Now, I want to basically understand what the best approach is to deal with situations like this. I tried increasing memory too by following commands
rasterOptions(maxmemory = 5.17e+10)
rasterOptions(memfrac = 0.8)
rasterOptions(chunksize = 5.17e+10)
but when I see CPU and RAM usage its barely 6% and 10% respectively. R uses only 5% CPU and 1GB RAM. My system has 64GB RAM, 16GB GPU.
Here is an attempt. This is much more concise. It is only three times faster on this example, but the gain may be larger on your real data.
library(terra)
b <- r1 <- r2 <- rast(ncols=5, nrows=5, nl=5, vals=NA)
set.seed(0)
values(b) <- runif(size(b))
b[c(1,2,3,22,23,24,25)] <- NA
p <- 0.15
p1 <- p/3
p2 <- p-(p/3)
fc <- 0.3
weather <- c(0.1, 0, 0, 0, 0.3)
r2[[1]] <- ifel(is.na(b[[1]]), NA, 0.3)
for (i in 1:nlyr(b)) {
varr1 <- b[[i]] * (((r2[[i]] - p1)/p2)^2)
r1[[i]] <- ifel(r2[[i]] > p, b[[i]], varr1)
for (k in 2:nlyr(b)) {
r2[[k]] <- min(r2[[k-1]] + (weather[k-1] - r1[[k-1]]) /100, fc)
}
}
If speed is the issue, and the raster data can be loaded into RAM, this may be much faster:
db <- values(b)
dr1 <- values(r1)
dr2 <- values(r2)
for (i in 1:ncol(db)) {
varr1 <- db[, i] * (((dr2[, i] - p1)/p2)^2)
dr1[,i] <- ifelse(dr2[, i] > p, db[, i], varr1)
for (k in 2:ncol(b)) {
dr2[,k] <- pmin(dr2[, k-1] + (weather[k-1] - dr1[, k-1]) /100, fc)
}
}
values(r1) <- dr1
values(r2) <- dr2

Replace in a list rasters with 'NA' values

I have a list of raster files in GeoTIFF files, and I've like to remove each file and if one has more than 50% of NA values.
I wanna delete it from the list my new list (f2). In my code:
library(raster)
# example data
r <- raster(ncol=10, nrow=10)
set.seed(0)
# 10 layers
s <- stack(lapply(1:10, function(i) setValues(r, runif(ncell(r)))))
# set about half the values to NA
s[s < .5] <- NA
#Create GeoTIFF for each layer
sl<-1:10
for (i in 1:length(sl)){
writeRaster(s[[i]],filename=paste(sl[i],sep=""),
format="GTiff",datatype="FLT4S",overwrite=TRUE)
}
#Take images in batch
f <- list.files(getwd(), pattern = ".tif")
ras <- lapply(f,raster)
#Remove from my list when I have more than 50% of cells that are NA
class <- vector()
for (j in 1:length(ras)){
i <- cellStats(is.na(ras[[j]]), sum) # count the NA values in each layer
i <- i/ncell(ras[[j]]) # fraction that is NA
ss <- ras[[j]][[which(i>.5)]] # Select the layers that more than half the cells with values
class<-c(class,ss)
}
Here, I have my problem, the output class has all my images and not the layers that more than 50% of the cells with values
I've like to apply this conditon for:
#Remove target images
f2 <- list.files(getwd(), pattern = ".tif")
f2<- f[f!=class]
ras2 <- lapply(f2,raster)
Your example data
library(raster)
r <- raster(ncol=10, nrow=10)
set.seed(0)
s <- stack(lapply(1:10, function(i) setValues(r, runif(ncell(r)))))
s[s < .5] <- NA
# I skip the file writing bit. But from these files I would make a RasterStack again
#f <- list.files(getwd(), pattern = ".tif")
#ras <- stack(f)
Count the number of cells with NA and divide by the number of cells
f <- freq(s, value=NA) / ncell(s)
# equivalent to cellStats(is.na(s), "mean")
i <- which(f <= 0.5)
i
#layer.2 layer.6 layer.7
# 2 6 7
use these indices to subset the RasterStack
ss <- s[[i]]
If you cannot make a RasterStack from your real data (perhaps the rasters do not align), you can use a list and a loop like this
ras <- as.list(s)
result <- rep(NA, length(ras))
for (i in 1:length(ras)){
result[i] <- freq(ras[[i]], value=NA) / ncell(ras[[i]])
}
# equivalent to
# result <- sapply(1:length(ras), function(i) freq(ras[[i]], value=NA) / ncell(ras[[i]]))
j <- result < 0.5
sras <- ras[j]

Mosaic rasterstacks using minimum of certain layer

I am trying to mosaic 42 remote sensing rasterstacks (with 250 bands) based on the criterion that in overlapping areas, the pixel should be taken that has the most nadir viewing angle
Beside my rasterstacks I also have 42 rasters (so one for each stack) with the corresponding viewing angle for each pixel.
Any idea how to solve this?
I tried to include the viewing angle raster in the stack, and use something similar to
mosaic(a,b,fun=function(x)(min(x[[251]]))
but that didn't work...
Any advice?
Thanks in advance,
R.
When asking an R question like this, you should set up a simple example with code to better illustrate your problem and to make it easier to answer.
Here is the problem
library(raster)
r <- raster(ncol=100, nrow=100)
r1 <- crop(r, extent(-10, 11, -10, 11))
r2 <- crop(r, extent(0, 20, 0, 20))
r3 <- crop(r, extent(9, 30, 9, 30))
# reflectance values
r1[] <- 1:ncell(r1)
r2[] <- 1:ncell(r2)
r3[] <- 1:ncell(r3)
set.seed(0)
# nadir values
n1 <- setValues(r1, runif(ncell(r1)))
n2 <- setValues(r2, runif(ncell(r2)))
n3 <- setValues(r3, runif(ncell(r3)))
Your question is how to merge/mosaic r based on values in n (when there are overlapping cells with values, use the value of r(i) that that has the highest corresponding value of n(i) ).
Here is a general approach to solve it:
r <- list(r1, r2, r3)
n <- list(n1, n2, n3)
whichmax <- function(x, ...) {
ifelse(all(is.na(x)), NA, which.max(x))
}
n$fun <- whichmax
# which layer has the highest nadir value?
m <- do.call(mosaic, n)
q <- list()
for (i in 1:length(r)) {
y <- r[[i]]
x <- crop(m, y)
y[x != i] <- NA
q[i] <- y
}
M <- do.call(merge, q)

Getting coordinates of pixels which values are equal to 0

I have a raster map with 202 rows and 201 columns
there are some grids in this map which pixel values is 0
I want to write a function that return all the pixel values 0 grids' coordinate
how can I do it
I was trying to use if loop and while loop
but it always says TRUE/FALSE need
here is my sample code
library(raster)
library(rgdal)
library(maptools)
library(sp)
setwd("E:/Landsat-data-NASA atm-corrected/sample_day1")
restdir2 <- ("E:/Landsat-data-NASA atm-corrected/sample_day1")
n3 <- list.files(restdir2, pattern="*band4_clip_1.tif", full.names=TRUE)
n4 <- list.files(restdir2, pattern="*cloud_qa_clip_1.tif", full.names=TRUE)
n5 <- list.files(restdir2, pattern="*cloud.tif", full.names=TRUE)
create<- function(x,y)
{
layer <- raster(n4)
layer2 <- raster(n3)
for(c in 1:x)
{
for(r in 1:y)
{
nl<- layer2
if(layer[c,r]==0)
return layer[c,r]
}
}
}
create (10,10)
Here are two (very similar) approaches
library(raster)
# set up example data
r <- raster(nrow=18, ncol=36)
set.seed(0)
r[] <- round(runif(ncell(r)) * 10 - 5)
# approach 1, for a single layer
p <- rasterToPoints(r, fun=function(x){x == 0})
# approach 2, also works for multiple layers
# first remove all non zero cells
z <- subs(r, data.frame(0, 1))
p <- rasterToPoints(z)
# results
plot(r)
points(p[,1:2])
if you have multiple layers with the same spatial parameters (extent and resolution)
# create example data
x1 <- setValues(r, round(runif(ncell(r)) * 10 - 5))
x2 <- setValues(r, round(runif(ncell(r)) * 10 - 5))
x3 <- setValues(r, round(runif(ncell(r)) * 10 - 5))
# combine layers
s <- stack(x1, x2, x3)
z <- subs(r, data.frame(0, 1))
p <- rasterToPoints(z)

Combine two raster layers, setting NA values in non-mask layer to 0 where mask layer is not NA

I have two raster layers that I wish to combine into one. Let's call them mask (with values 1 and NA), and vrs.
library(raster)
mask <- raster(ncol=10, nrow=10)
mask[] <- c(rep(0, 50), rep(1, 50))
mask[mask < 0.5] <- NA
vrs <-raster(ncol=10, nrow=10)
vrs[] <- rpois(100, 2)
vrs[vrs >= 4] <- NA
I wish to combine two big layers, but for the sake of understanding these small examples are ok. What I wish to do is to set the pixel values of my output layer to zero for those pixels where mask layer is 1 and vrs layer is NA. All other pixels should remain with the values of original vrs.
This is my only thought as to how:
zero.for.NA <- function(x, y, filename){
out <- raster(y)
if(canProcessInMemory(out, n = 4)) { #wild guess..
val <- getValues(y) #values
NA.pos <- which(is.na(val)) #positiones for all NA-values in values-layer
NA.t.noll.pos<-which(x[NA.pos]==1) #Positions where mask is 1 within the
#vector of positions of NA values in vrs
val[NA.pos[NA.t.noll.pos]] <- 0 #set values layer to 0 where condition met
out <- setValues(out, val)
return(out)
} else { #for large rasters the same thing by chunks
bs <- blockSize(out)
out <- writeStart(out, filename, overwrite=TRUE)
for (i in 1:bs$n) {
v <- getValues(y, row=bs$row[i], nrows=bs$nrows[i])
xv <- getValues(x, row=bs$row[i], nrows=bs$nrows[i])
NA.pos <- which(is.na(v))
NA.t.noll.pos <- which(xv[NA.pos]==1)
v[NA.pos[NA.t.noll.pos]] <- 0
out <- writeValues(out, v, bs$row[i])
}
out <- writeStop(out)
return(out)
}
}
This function did work on the small example and seems to work on the bigger ones. Is there a faster/better way of doing this? Some way that is better for larger files? I will have to use this on many sets of layers and I would appreciate any help in making the process safer and or quicker!
I'd use cover():
r <- cover(vrs, mask-1)
plot(r)
You can do this with overlay, as well:
r <- overlay(mask, vrs, fun=function(x, y) ifelse(x==1 & is.na(y), 0, y))

Resources