calcolo della correlazione media per pixel adiacenti nel tempo

Question

Ho una pila di 4 raster. Vorrei la correlazione media nel tempo tra un pixel e ciascuno dei suoi 8 vicini.

alcuni dati:

library(raster) 

r1=raster(matrix(runif(25),nrow=5)) 
r2=raster(matrix(runif(25),nrow=5)) 
r3=raster(matrix(runif(25),nrow=5)) 
r4=raster(matrix(runif(25),nrow=5)) 
s=stack(r1,r2,r3,r4) 

così per un pixel alla posizione x, che ha 8 vicini al NE, E, SE, S ecc posizioni, voglio che la media di

cor(x,NE) 
cor(x,E) 
cor(x,SE) 
cor(x,S) 
cor(x,SW) 
cor(x,W) 
cor(x,NW) 
cor(x,N) 

e il valore medio salvato nella posizione x nel raster risultante. Le celle di bordo sarebbero NA o, se possibile, una bandiera per calcolare la correlazione media solo con le celle che tocca (3 o 5 celle). Grazie!

Answer 1

Non credo che il suggerimento di @ Pascal di utilizzare focal() potrebbe funzionare perché focal() accetta un singolo livello raster come argomento, non come una pila. Questa è la soluzione più facile da capire. Potrebbe essere reso più efficiente riducendo al minimo il numero di volte in cui estrai i valori per ogni cella focale:

library(raster) 

set.seed(2002) 
r1 <- raster(matrix(runif(25),nrow=5)) 
r2 <- raster(matrix(runif(25),nrow=5)) 
r3 <- raster(matrix(runif(25),nrow=5)) 
r4 <- raster(matrix(runif(25),nrow=5)) 
s <- stack(r1,r2,r3,r4) 

## Calculate adjacent raster cells for each focal cell: 
a <- adjacent(s, 1:ncell(s), directions=8, sorted=T) 

## Create column to store correlations: 
out <- data.frame(a) 
out$cors <- NA 

## Loop over all focal cells and their adjacencies, 
## extract the values across all layers and calculate 
## the correlation, storing it in the appropriate row of 
## our output data.frame: 
for (i in 1:nrow(a)) { 
    out$cors[i] <- cor(c(s[a[i,1]]), c(s[a[i,2]])) 
} 

## Take the mean of the correlations by focal cell ID: 
r_out_vals <- aggregate(out$cors, by=list(out$from), FUN=mean) 

## Create a new raster object to store our mean correlations in 
## the focal cell locations: 
r_out <- s[[1]] 
r_out[] <- r_out_vals$x 

plot(r_out)