Given:
library(terra)
r <- rast(nrows=512, ncols=640,nlyrs=1, res=1,crs="local",extent=c(0,640,0,512))
values(r) <- rnorm(ncell(r),100,10)
x <- c(r, r*2, r*3, r*0.5)
plotRGB(x, stretch="lin")
and
weirds <- data.frame(bands=c(1,3), mincol=c(5,100), maxcol=c(7,103))
weirds
> weirds
bands mincol maxcol
1 5 7
3 100 103
I have to set as NA those cells within mincol and maxcol in weirds for the given bands.
I achieve in this way:
y <- x
for (i in 1:nrow(weirds)) {
y[[weirds$bands[i]]][,weirds$mincol[i]:weirds$maxcol[i]] <- NA
}
plotRGB(y, stretch="lin")
But I am sure there are more efficient ways. Can anyone make suggestions?
With terra 1.6-24 (currently the development version) you can use indexing for layers.
Example data
library(terra)
#terra 1.6.24
r <- rast(nrows=30, ncols=30, nlyrs=1,extent=c(0,640,0,512))
values(r) <- rnorm(ncell(r), 100, 10)
x <- c(r, r*2, r*3)
w <- data.frame(bands=c(1,3), mincol=c(5,20), maxcol=c(7,23))
First approach. This is very similar to what you had, but perhaps a little cleaner.
y <- x
for (i in 1:nrow(w)) {
y[ , w$mincol[i]:w$maxcol[i], w$bands[i]] <- NA
}
plot(y)
Second approach. Using a list for one or more of the indices i (row), j (col), or k (lyr) you can do multiple replacements at once.
z <- x
cols <- lapply(1:nrow(w), function(i) seq(w[i, 2], w[i, 3]))
z[ , cols, w$bands] <- NA
plot(z, nc=3)
I would assume that this is the better approach and that you can probably directly create the cols list, instead of deriving it from w
You can install the development version of "terra" with install.packages('terra', repos='https://rspatial.r-universe.dev')
Related
I have raster files that have the same resolution and extent but differ in the number of NA. I want to unify the number of NA between all of them. Is it possible to do it by considering a cell as non-NA if it's not NA in all the raster files?
Here an example :
library(raster)
library(terra)
f <- system.file("external/test.grd", package="raster")
r1 <- raster(f)
r2 <- calc(r1, fun=function(x){ x[x < 500] <- NA; return(x)} )
r1 <- calc(r1, fun=function(x){ x[x > 1200] <- NA; return(x)} )
raste <- rast(r1)
rNA <- terra:: global(!(is.na(raste)), sum, na.rm=TRUE)
print(paste0("Non-NA of r1", rNA))
raste <- rast(r2)
rNA <- terra:: global(!(is.na(raste)), sum, na.rm=TRUE)
print(paste0("Non-NA of r2", rNA))
I want both r1 and r2 to have the same number of non-NA cells. I have more than two rasters, so I wonder if I can do it for a large number of files.
It can be a bit confusing to use raster and terra together, so I will just use terra (but you can do the same with raster, using stack in stead of c and cellStats in stead of global.
Your example data
library(terra)
f <- system.file("external/test.grd", package="raster")
r <- rast(f)
r1 <- clamp(r, upper=1200, values=FALSE)
r2 <- clamp(r, lower=500, values=FALSE)
global(!(is.na(r1)), sum)
# sum
#lyr.1 3145
global(!(is.na(r2)), sum)
# sum
#lyr.1 802
Solution:
r <- c(r1, r2)
names(r) <- c("r1", "r2")
m <- any(is.na(r))
x <- mask(r, m, maskvalue=1)
global(!(is.na(x)), sum, na.rm=TRUE)
# sum
#r1 769
#r2 769
I like the use of any(is.na()) because it makes clear what the intent is.
But you could combine the layers in one of many other ways. As long as you do not use na.rm=TRUE the cells with an NA in one of the layers will be NA in the output. For example with sum, diff, prod, mean or app.
m <- sum(r)
x <- mask(r, m)
global(!(is.na(x)), sum, na.rm=TRUE)
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]
I'm trying to run an overlay function with rasters where I want to meet all of 3 different conditions at each cell (using == and > or < operators) and produce a single raster as output.
Running ifelse with the & operator seems to look at the conditions in a linear fashion from left to right - If the first two conditions are met then it will produce the if condition as output, regardless of the third condition. && can't be used here because the result is not vectorized.
You can see this with this example below where with the resulting raster it's clear that it is not evaluating all three arguments. First clue is that it produces results even if some values are NA in the third raster.
I think I can get the result I want by first checking the condition of x and y and then with this result separately checking the condition of z with a different function, but I was hoping to be able to do it all in one function (seems like this should be possible, at least).
Hoping someone can point me in the right direction.
library(raster)
fn <- system.file("external/test.grd", package="raster")
s <- stack(fn, fn,fn)
#Create grids
s[[1]] <- round(runif(ncell(s), 1, 2))
s[[2]] <- round(runif(ncell(s), 1, 2))
s[[3]] <- round(runif(ncell(s), 1, 2))
#convert some values in s[[3]] to NA
s[[3]][s[[3]] == 1]<- NA
#run overlay function
result.rast <- overlay(s[[1]], s[[2]], s[[3]], fun =
function(x,y,z) {
ifelse( x == 2 & y == 1 & z ==2, 1, 0)
} )
I do not see evidence for the third condition not being used. NA values are a special case. See function f2 for some things you can do.
It is easier to see what's going on with a smaller raster
library(raster)
set.seed(0)
r <- raster(ncol=10, nrow=10, xmn=0, xmx=10, ymn=0, ymx=10)
r1 <- setValues(r, round(runif(ncell(r), 1, 2)))
r2 <- setValues(r, round(runif(ncell(r), 1, 2)))
r3 <- setValues(r, round(runif(ncell(r), 1, 2)))
r3[r3 == 1] <- NA
s <- stack(r1, r2, r3)
res1 <- overlay(s, fun =
function(x,y,z) {
ifelse( x == 2 & y == 1 & z ==2, 1, 0)
} )
#A more complex function, that keeps NAs
f2 <- function(x,y,z) {
a <- rep(0, length(x))
a[x == 2 & y == 1 & z ==2] <- 1
a[is.na(x) | is.na(y) | is.na(z)] <- NA
a
}
res2 <- overlay(s, fun = f2)
Did you try stackApply?
You can also use each layer of the raster stack as vectors.
Here is an example (it might be a better way to reference the cells in the rasterStack, though)
tt <- raster(ncol=4,nrow=5)
tt[] <- 1
tts <- stack(tt,tt,tt)
tts[[1]][4,2]<-NA
# now the condition
tt2 <- (tts[[1]] == 1 & tts[[2]] == 1 & tts[[3]] == 1)
plot(tt2)
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))
I'm having trouble efficiently loading data into a sparse matrix format in R.
Here is an (incomplete) example of my current strategy:
library(Matrix)
a1=Matrix(0,5000,100000,sparse=T)
for(i in 1:5000)
a1[i,idxOfCols]=x
Where x is usually around length 20. This is not efficient and eventually slows to a crawl. I know there is a better way but wasn't sure how. Suggestions?
You can populate the matrix all at once:
library(Matrix)
n <- 5000
m <- 1e5
k <- 20
idxOfCols <- sample(1:m, k)
x <- rnorm(k)
a2 <- sparseMatrix(
i=rep(1:n, each=k),
j=rep(idxOfCols, n),
x=rep(x, k),
dims=c(n,m)
)
# Compare
a1 <- Matrix(0,5000,100000,sparse=T)
for(i in 1:n) {
a1[i,idxOfCols] <- x
}
sum(a1 - a2) # 0
You don't need to use a for-loop. Yu can just use standard matrix indexing with a two column matrix:
a1[ cbind(i,idxOfCols) ] <- x