Tengo un valor de trama:
m <- matrix(c(2,4,5,5,2,8,7,3,1,6,
5,7,5,7,1,6,7,2,6,3,
4,7,3,4,5,3,7,9,3,8,
9,3,6,8,3,4,7,3,7,8,
3,3,7,7,5,3,2,8,9,8,
7,6,2,6,5,2,2,7,7,7,
4,7,2,5,7,7,7,3,3,5,
7,6,7,5,9,6,5,2,3,2,
4,9,2,5,5,8,3,3,1,2,
5,2,6,5,1,5,3,7,7,2),nrow=10, ncol=10, byrow = T)
r <- raster(m)
extent(r) <- matrix(c(0, 0, 10, 10), nrow=2)
plot(r)
text(r)
A partir de esta trama, ¿cómo puedo asignar valores (o valores de cambio) a las 8 celdas adyacentes de la celda actual de acuerdo con esta ilustración ? Me coloca un punto rojo dentro de la celda actual de esta línea de código:
points(xFromCol(r, col=5), yFromRow(r, row=5),col="red",pch=16)
Aquí, el resultado esperado será:
donde el valor de la celda actual (i.e, 5 en el valor de trama) se sustituye por 0.
En general, los nuevos valores para el 8 celdas adyacentes debe ser calculada de la siguiente manera:
Nuevo valor = promedio de los valores de las celdas contenidas en el rectángulo rojo * la distancia entre la celda actual (punto rojo) y la celda adyacente (es decir, sqrt(2) para diagonalmente adyacentes a las células o 1 en caso contrario)
Actualización
Cuando los límites de las células adyacentes que están fuera de la trama de los límites, necesito calcular nuevos valores para las celdas adyacentes que respetar las condiciones. Las células adyacentes que no respeten las condiciones será igual a "NA".
Por ejemplo, si la posición de referencia es c(1,1) en lugar de c(5,5) mediante el uso de [fila, col] la notación, sólo el nuevo valor en la esquina inferior derecha se puede calcular. Por lo tanto, el resultado esperado será:
[,1] [,2] [,3]
[1,] NA NA NA
[2,] NA 0 NA
[3,] NA NA New_value
Por ejemplo, si la posición de referencia es c(3,1), sólo los nuevos valores en la parte superior-derecha, derecha y abajo a la derecha de las esquinas puede ser calculado. Por lo tanto, el resultado esperado será:
[,1] [,2] [,3]
[1,] NA NA New_value
[2,] NA 0 New_value
[3,] NA NA New_value
Aquí está mi primer intento en esto mediante el uso de la función focal pero tengo cierta dificultad para hacer una automática de código.
Seleccione las celdas adyacentes
mat_perc <- matrix(c(1,1,1,1,1,
1,1,1,1,1,
1,1,0,1,1,
1,1,1,1,1,
1,1,1,1,1), nrow=5, ncol=5, byrow = T)
cell_perc <- adjacent(r, cellFromRowCol(r, 5, 5), directions=mat_perc, pairs=FALSE, sorted=TRUE, include=TRUE)
r_perc <- rasterFromCells(r, cell_perc)
r_perc <- setValues(r_perc,extract(r, cell_perc))
plot(r_perc)
text(r_perc)
si la celda adyacente se encuentra en la esquina superior izquierda de la celda actual
focal_m <- matrix(c(1,1,NA,1,1,NA,NA,NA,NA), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)*sqrt(2)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
si la celda adyacente se encuentra en la mitad superior de la esquina de la celda actual
focal_m <- matrix(c(1,1,1,1,1,1,NA,NA,NA), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
si la celda adyacente se encuentra en la esquina superior izquierda de la celda actual
focal_m <- matrix(c(NA,1,1,NA,1,1,NA,NA,NA), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)*sqrt(2)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
si la celda adyacente se encuentra en la esquina izquierda de la celda actual
focal_m <- matrix(c(1,1,NA,1,1,NA,1,1,NA), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
si la celda adyacente se encuentra en la esquina derecha de la celda actual
focal_m <- matrix(c(NA,1,1,NA,1,1,NA,1,1), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
si la celda adyacente se encuentra en la esquina inferior izquierda de la celda actual
focal_m <- matrix(c(NA,NA,NA,1,1,NA,1,1,NA), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)*sqrt(2)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
si la celda adyacente se encuentra en la parte inferior media de la esquina de la celda actual
focal_m <- matrix(c(NA,NA,NA,1,1,1,1,1,1), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
si la celda adyacente se encuentra en la esquina inferior derecha de la celda actual
focal_m <- matrix(c(NA,NA,NA,NA,1,1,NA,1,1), nrow=3, ncol=3, byrow = T)
focal_function <- function(x) mean(x,na.rm=T)*sqrt(2)
test <- as.matrix(focal(r_perc, focal_m, focal_function))
