R - Function to combine index from vector and raster stack layers - r

I am trying to write an efficient script to calibrate hundreds of Landsat 8 images. At a certain point of the calibration steps, I need to apply some coefficients in each layer of a raster stack.
This is one sample stack:
fn <- system.file("external/test.grd", package="raster")
s <- stack(fn, fn)
And these are sample coefficients:
mult <- c(0.0003342, 0.0005534)
add <- c(0.1, 0.2)
What I need to is to apply each index of the coefficients to the correspondent index of the stack layer, like in this example:
s[[1]] <- (s[[1]] * mult[1]) + add[1]
s[[2]] <- (s[[2]] * mult[2]) + add[2]
This is my poor attempt, which obviously does not work:
cal.fun <- function(x) {
x <- (x * mult) + add
}
s.cal <- calc(s, cal.fun, progress='text')
Any ideas on how to do that?
Many thanks.

raster is a phenomenally well-constructed package and you can simply do:
s2 <- s * mult + add
For quick visual confirmation that that vectorized call "just works", do something like this:
library(gridExtra)
library(rasterVis)
grid.arrange(levelplot(s), levelplot(s2), nrow=2)

Related

foreach doesn't change value of raster cell in R

I'm trying to simulate herding behavior in R.
Here's the code
library(raster)
library(sp)
library(foreach)
K=100
sig=0.2
G=0.3
x <- raster(ncol=2000,nrow=2000)
values(x) <- sign(rnorm(4000000,mean=0,sd=0.3))
y <- raster(ncol=2000,nrow=2000)
values(y) <- sign(rnorm(4000000,mean=0,sd=0.3))
#plot(x)
ei <- rnorm(4000000)
j=0
while(j < 30) {
for(i in 1:4000000){
ad <- adjacent(x,cell=c(i))[,2]
y[i] <- sign(K*sum(x[ad])+sig*ei[i]+G)
}
x <- y
plot(x)
j = j+1
}
The classic loop approach is too slow.
If I use a foreach loop instead of a classic for loop it doesn't change the values of y in every iteration.
I can't fix it at all.
Can someone please help about this?
Thank you
You have a dynamic model in which the output of each (time) step is input for the next step. It is not possible to do that in parallel. But that does not mean you cannot make the model run faster.
Looping over raster cells in R is always going to be slow, so we need to avoid that. Normally a problem like this could be solved with focal (see code a the bottom) --- but in this case it is difficult because you effectively use two rasters (x and ei) --- I will look at implementing multi-layer focal operations in the terra package.
Here is an approach with getFocalValues. It is much faster (and I use Sys.sleep to slow it down a bit).
library(raster)
set.seed(0)
x <- raster(ncol=200, nrow=200)
values(x) <- sign(rnorm(ncell(x),mean=0,sd=0.3))
y <- raster(x)
values(y) <- sign(rnorm(ncell(x),mean=0,sd=0.3))
ei <- rnorm(ncell(x))
K=100
sig=0.2
G=0.3
for (j in 1:29) {
# with large rasters, you may need to do the below in chunks
v <- getValuesFocal(x, 1, nrow(x), c(3,3))
# only keep the rook neighbors
v <- v[, c(2,4,6,8)]
v <- rowSums(v, na.rm=TRUE)
values(x) <- sign(K*v+sig*ei+G)
plot(x)
Sys.sleep(0.1)
}
This how you could use focal in similar cases
w <- matrix(c(0,1,0,1,0,1,0,1,0), 3, 3)
y <- focal(x, w, fun=function(i)sign(K*sum(i)+sig+G))
Also see the cellular automata examples in ?focal

raster calculation with condition of each cell by layers in R

I have stack raster dataset with several layers, however, I want to calculate the sum of each cell with for different layer selection, and finally generate a new layer, anyone has some good suggestion by using calc or overlay or some other raster calculation in R?
I can do by loops and make the calculation, but it will consume many times when I have many layers, and also use many of the storage, my script as follows,
## library(raster)
make_calc <- function(rr, start, end) {
rr <- as.array(rr)
start <- as.array(start)
end <- as.array(end)
dms <- dim(raster)
tmp <- array(NA, dim = dms[1:2])
for (i in 1:dms[1]) {
for (j in 1:dms[2]) {
tmp[i,j] <- sum(raster[i,j,start[i,j,1]:end[i,j,1]], na.rm = TRUE)
}
}
return(tmp)
}
rr <- raster(res = 10)
rr[] <- 1
rr <- stack(rr, rr, rr, rr)
start <- raster(res = 10)
start[] <- sample(1:2, ncell(start), replace = TRUE)
end <- raster(res = 10)
end[] <- sample(3:4, ncell(end), replace = TRUE)
result <- make_calc(rr, start, end)
Why are you coercing into arrays? You can easily collapse a raster into a vector but, that does not even seem necessary here. In the future, please try to be more clear on what your expected outcome is.
Based on your code, I really don't know what you are getting at. I am going to take a few guesses on summing specified rasters in the stack, drawing a random sample, across rasters to be summed and finally, drawing a random sample of cells to be summed.
For a sum on specified rasters in a stack, you can just index what you are after in the stack using a double bracket. In this case, rasters 1 and 3 in the stack would be the only ones summed.
library(raster)
rr <- raster(res = 10)
rr[] <- 1
rr <- stack(rr, rr, rr, rr)
( sum_1_3 <- calc(rr[[c(1,3)]], sum) )
If you are wanting a random sample of the values across rasters, for every cell, you could write a function that is passed to calc. Here is an example that grabs a random sample of n size, across the raster layers values and sums them.
rs.sum <- function(x, n=2) {sum( x[sample(1:length(x),n)], na.rm=TRUE)}
rs.sum.raster <- calc(rr, rs.sum)
If you are wanting to apply a function to a limited random selection of cells, you could create a random sample of the raster that would be used as an index. Here we create a random sample of cells, create an empty raster and pipe the sum of rasters 1 and 2 (in the stack) based on the random sample cell index. A raster in the stack is indexed using the double bracket and the raster values are indexed using a single bracket so, for raster 1 in the stack with limiting to the values in the random sample you would use: rr[[1]][rs]
rs <- sample(1:ncell(rr[[1]]), 300)
r.sum <- rr[[1]]
r.sum[] <- NA
r.sum[rs] <- rr[[1]][rs] + rr[[2]][rs]
plot(r.sum)

overlay rasters at a given value

I am relatively new to using R and working with GIS data.
I am trying to create a function to overlay two Raster layers, only when one of the rasters (in this case raster1) is at a certain value (in this case 0). I have tried numerous options in doing this but they don't seem to work. My last attempt is provided below, and it runs but the output just says NULL and it does not plot.
library(raster)
raster1 <- raster(ncols=10,nrows=10)
raster2 <- raster(ncols=10,nrows=10)
values(raster1) <- round(runif(ncell(raster1)))
values(raster2) <- round(runif(ncell(raster2)))
plot(raster1)
plot(raster2)
overlay_zero <- function (x, y) {
if (isTRUE(x == 0)) {
overlay(x, y, fun=function(x,y) {return(x+y)})}
}
z <- overlay_zero(raster1, raster2)
z
plot(z)
overlay_ras <- function(ras1,ras2,value=0){
result <- ras1
result[ras1==value] <- ras1[ras1==value] + ras2[ras1==value]
return(result)
}
overlaid <- overlay_ras(raster1,raster2,0)
This will do the trick. The function takes two rasters and a value which will be used to determine the cells affected by the overlay (addition).

How to make use of rollapply or filter functions in R to create the moving average of a specific size in a 2D matrix

Considering that we have a padded matrix with window size k ready for getting smoothed using the moving average, I want to know if the filter or rollapply or other R functions I am not aware of can be used to find the moving average of a submatrix. Looking at R manuals I saw they have been used for MA in 1D but just wanted to know if they can be used for MA in 2D as well or not.
mat.pad<-function(X,k){
dims<-dim(X)
n<-dims[1]
m<-dims[2]
pad.X <- matrix(0, n + 2 * k, m + 2 * k)
pad.X[(k + 1):(n + k), (k + 1):(m + k)] <- X
return(pad.X)
}
If you are asking if a moving average can be applied to a multiple dimensional object, the answer is yes.
Example
library(zoo)
#
a <- 1:10
b <- 11:20
c <- cbind(a,b)
#
rollapply(c,
FUN = mean,
width = 3)

R: pairwise Euclidean distance between columns of two matrices

The following loop takes too lonng to run (2mins/iteration)
The tumor_signals is size 950000x422
The normal_signals is size 950000x772
Any ideas for how to speed it up?
for(i in 1:ncol(tumor_signals)){
x <- as.vector(tumor_signals[,i])
print("Assigned x")
y <- t((t(normal_signals) - x)^2)
print("assigned y")
y <- t(sqrt(colSums(y)))
print("done")
#all_distance <- cbind(all_distance,matrix(distance))
print(i)
}
There's a bug in your code -- you don't need to take the transpose of normal_signals. As I understand it, you are trying to compute, for all i = 1,2,...422, and j=1,2,...,772, the Euclidean distance between tumor_signals[,i] and normal_signals[,j]. You would probably want the results in a 422 x 772 matrix. There's a function rdist() in the package fields that will do this for you:
require(fields)
result <- rdist(t(tumor_signals), t(normal_signals))
Incidentally, a Google search for [R Euclidean distance] would have easily found this package.

Resources