Умовне присвоєння значень сусіднім растровим клітинам?

У мене є растрове значення:

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)

Як можна з цього растру призначити значення (або змінити значення) 8 сусідніх комірок поточної комірки відповідно до цієї ілюстрації? Я розмістив червону крапку в поточній комірці з цього кодового рядка:

points(xFromCol(r, col=5), yFromRow(r, row=5),col="red",pch=16)

Тут очікуваний результат буде:

де значення поточної комірки (тобто 5 у значенні растра) замінено на 0.

Загалом нові значення для 8 сусідніх комірок повинні бути обчислені так:

Нове значення = середнє значення комірок, що міститься у червоному прямокутнику * відстань між поточною коміркою (червоною точкою) та сусідньою коміркою (тобто sqrt (2) для діагонально сусідніх комірок або 1 іншим чином)

Оновлення

Коли межі для сусідніх комірок виходять за межі растру, мені потрібно обчислити нові значення для сусідніх комірок, які відповідають умовам. Суміжні комірки, які не відповідають умовам, дорівнюватимуть "NA".

Наприклад, якщо опорне положення дорівнює c (1,1) замість c (5,5), використовуючи позначення [рядок, стовпчик], можна обчислити лише нове значення в правому нижньому куті. Таким чином, очікуваний результат буде:

     [,1] [,2] [,3]       
[1,] NA   NA   NA         
[2,] NA   0    NA         
[3,] NA   NA   New_value

Наприклад, якщо опорне положення дорівнює c (3,1), можна обчислити лише нові значення у верхньому правому, правому та нижньому правому кутах. Таким чином, очікуваний результат буде:

     [,1] [,2] [,3]       
[1,] NA   NA   New_value         
[2,] NA   0    New_value         
[3,] NA   NA   New_value

Ось моя перша спроба цього зробити за допомогою функції, focalале у мене виникли труднощі зробити автоматичний код.

Виберіть сусідні комірки

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)

якщо сусідня комірка розташована у верхньому лівому куті поточної комірки

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))

якщо сусідня комірка розташована у верхньому-середньому куті поточної комірки

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))

якщо сусідня комірка розташована у верхньому лівому куті поточної комірки

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))

якщо сусідня комірка розташована в лівому куті поточної комірки

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))

якщо сусідня комірка розташована в правому куті поточної комірки

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))

якщо сусідня комірка розташована в нижньому лівому куті поточної комірки

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))

якщо сусідня комірка розташована в нижньому та середньому куті поточної комірки

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))

якщо сусідня комірка розташована в правому нижньому куті поточної комірки

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))

Функція AssignValuesToAdjacentRasterCellsнижче повертає новий об'єкт RasterLayer з потрібними значеннями, призначеними з оригінального растрового введення. Функція перевіряє, чи розташовані сусідні комірки з опорного положення всередині растрових меж. Він також відображає повідомлення, якщо деякі зв’язані немає. Якщо вам потрібно перенести опорну позицію, ви можете просто написати ітерацію, змінивши вхідне положення на c ( i , j ).

Введення даних

# Load packages
library("raster")

# Load matrix data
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 = TRUE)

# Convert matrix to RasterLayer object
r <- raster(m)

# Assign extent to raster
extent(r) <- matrix(c(0, 0, 10, 10), nrow=2)

# Plot original raster
plot(r)
text(r)
points(xFromCol(r, col=5), yFromRow(r, row=5), col="red", pch=16)

Функція

# Function to assigning values to the adjacent raster cells based on conditions
# Input raster: RasterLayer object
# Input position: two-dimension vector (e.g. c(5,5))

AssignValuesToAdjacentRasterCells <- function(raster, position) {

  # Reference position
  rowPosition = position[1]
  colPosition = position[2]

  # Adjacent cells positions
  adjacentBelow1 = rowPosition + 1
  adjacentBelow2 = rowPosition + 2
  adjacentUpper1 = rowPosition - 1
  adjacentUpper2 = rowPosition - 2
  adjacentLeft1 = colPosition - 1 
  adjacentLeft2 = colPosition - 2 
  adjacentRight1 = colPosition + 1
  adjacentRight2 = colPosition + 2

  # Check if adjacent cells positions are out of raster positions limits
  belowBound1 = adjacentBelow1 <= nrow(raster)
  belowBound2 = adjacentBelow2 <= nrow(raster)
  upperBound1 = adjacentUpper1 > 0
  upperBound2 = adjacentUpper2 > 0
  leftBound1 = adjacentLeft1 > 0 
  leftBound2 = adjacentLeft2 > 0 
  rightBound1 = adjacentRight1 <= ncol(raster)
  rightBound2 = adjacentRight2 <= ncol(raster) 

  if(upperBound2 & leftBound2) {

    val1 = mean(r[adjacentUpper2:adjacentUpper1, adjacentLeft2:adjacentLeft1]) * sqrt(2)

  } else {

    val1 = NA

  }

  if(upperBound2 & leftBound1 & rightBound1) {

    val2 = mean(r[adjacentUpper1:adjacentUpper2, adjacentLeft1:adjacentRight1])

  } else {

    val2 = NA

  }

  if(upperBound2 & rightBound2) {

    val3 = mean(r[adjacentUpper2:adjacentUpper1, adjacentRight1:adjacentRight2]) * sqrt(2)

  } else {

    val3 = NA

  }

  if(upperBound1 & belowBound1 & leftBound2) {

    val4 = mean(r[adjacentUpper1:adjacentBelow1, adjacentLeft2:adjacentLeft1])

  } else {

    val4 = NA

  }

  val5 = 0

  if(upperBound1 & belowBound1 & rightBound2) {

    val6 = mean(r[adjacentUpper1:adjacentBelow1, adjacentRight1:adjacentRight2])

  } else {

    val6 = NA

  }

  if(belowBound2 & leftBound2) {

    val7 = mean(r[adjacentBelow1:adjacentBelow2, adjacentLeft2:adjacentLeft1]) * sqrt(2)

  } else {

    val7 = NA

  }

  if(belowBound2 & leftBound1 & rightBound1) {

    val8 = mean(r[adjacentBelow1:adjacentBelow2, adjacentLeft1:adjacentRight1])

  } else {

    val8 = NA

  }

  if(belowBound2 & rightBound2) {

    val9 = mean(r[adjacentBelow1:adjacentBelow2, adjacentRight1:adjacentRight2]) * sqrt(2)

  } else {

    val9 = NA

  }

  # Build matrix
  mValues = matrix(data = c(val1, val2, val3,
                            val4, val5, val6,
                            val7, val8, val9), nrow = 3, ncol = 3, byrow = TRUE)    

  if(upperBound1) {

    a = adjacentUpper1

  } else {

    # Warning message
    cat(paste("\n Upper bound out of raster limits!"))
    a = rowPosition
    mValues <- mValues[-1,]

  }

  if(belowBound1) {

    b = adjacentBelow1

  } else {

    # Warning message
    cat(paste("\n Below bound out of raster limits!"))
    b = rowPosition
    mValues <- mValues[-3,]

  }

  if(leftBound1) {

    c = adjacentLeft1

  } else {

    # Warning message
    cat(paste("\n Left bound out of raster limits!"))
    c = colPosition
    mValues <- mValues[,-1]

  }

  if(rightBound1) {

    d = adjacentRight1

  } else {

    # Warning
    cat(paste("\n Right bound out of raster limits!"))
    d = colPosition
    mValues <- mValues[,-3]

  }

  # Convert matrix to RasterLayer object
  rValues = raster(mValues)

  # Assign values to raster
  raster[a:b, c:d] = rValues[,]  

  # Assign extent to raster
  extent(raster) <- matrix(c(0, 0, 10, 10), nrow = 2)

  # Return raster with assigned values
  return(raster)      

}

Виконайте приклади

# Run function AssignValuesToAdjacentRasterCells

# reference position (1,1)
example1 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(1,1))

# reference position (1,5)
example2 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(1,5))

# reference position (1,10)
example3 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(1,10))

# reference position (5,1)
example4 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(5,1))

# reference position (5,5)
example5 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(5,5))

# reference position (5,10)
example6 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(5,10))

# reference position (10,1)
example7 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(10,1))

# reference position (10,5)
example8 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(10,5))

# reference position (10,10)
example9 <- AssignValuesToAdjacentRasterCells(raster = r, position = c(10,10))

Сюжетні приклади

# Plot examples
par(mfrow=(c(3,3)))

plot(example1, main = "Position ref. (1,1)")
text(example1)
points(xFromCol(example1, col=1), yFromRow(example1, row=1), col="red", cex=2.5, lwd=2.5)

plot(example2, main = "Position ref. (1,5)")
text(example2)
points(xFromCol(example2, col=5), yFromRow(example2, row=1), col="red", cex=2.5, lwd=2.5)

plot(example3, main = "Position ref. (1,10)")
text(example3)
points(xFromCol(example3, col=10), yFromRow(example3, row=1), col="red", cex=2.5, lwd=2.5)

plot(example4, main = "Position ref. (5,1)")
text(example4)
points(xFromCol(example4, col=1), yFromRow(example4, row=5), col="red", cex=2.5, lwd=2.5)

plot(example5, main = "Position ref. (5,5)")
text(example5)
points(xFromCol(example5, col=5), yFromRow(example5, row=5), col="red", cex=2.5, lwd=2.5)

plot(example6, main = "Position ref. (5,10)")
text(example6)
points(xFromCol(example6, col=10), yFromRow(example6, row=5), col="red", cex=2.5, lwd=2.5)

plot(example7, main = "Position ref. (10,1)")
text(example7)
points(xFromCol(example7, col=1), yFromRow(example7, row=10), col="red", cex=2.5, lwd=2.5)

plot(example8, main = "Position ref. (10,5)")
text(example8)
points(xFromCol(example8, col=5), yFromRow(example8, row=10), col="red", cex=2.5, lwd=2.5)

plot(example9, main = "Position ref. (10,10)")
text(example9)
points(xFromCol(example9, col=10), yFromRow(example9, row=10), col="red", cex=2.5, lwd=2.5)

Приклад рисунка

Примітка: середні NAзначення білих клітин

Для матричного оператора на малій матриці це має сенс і простежується. Однак ви можете по-справжньому переосмислити свою логіку, застосовуючи подібну функцію до великого растру. Концептуально це не дуже простежується в загальному застосуванні. Ви говорите про те, що традиційно називають блок-статистикою. Однак статистика блоків за своєю природою починається з одного кута растру і замінює блоки значень у визначеному розмірі вікна оператором. Зазвичай цей тип операторів призначений для агрегації даних. Було б значно прослідковувати, якби ви думали з точки зору використання умов для обчислення центрального значення матриці. Таким чином ви могли легко використовувати фокусну функцію.

Тільки майте на увазі, що растрова фокусна функція - це зчитування в блоках даних, які представляють фокусні значення у визначеному сусідстві на основі матриці, переданої аргументу w. Результат - вектор для кожного мікрорайону, а результат фокусного оператора присвоюється лише фокусному осередку, а не всій околиці. Подумайте про це як захоплення матриці, яка оточує значення комірки, оперування нею, присвоєння новій величині комірки, а потім перехід до наступної комірки.

Якщо ви переконаєтесь, що na.rm = FALSE, то вектор завжди буде представляти точне сусідство (тобто, той самий вектор довжини) і буде примусовий до матричного об'єкта, яким можна керувати в межах функції. Через це ви можете просто записати функцію, яка приймає вектор очікування, примушує до матриці, застосовує логіку позначення вашого сусідства і потім призначає одне значення як результат. Потім ця функція може бути передана до функції raster :: фокус.

Ось, що відбуватиметься в кожній клітці на основі простого примусу та оцінки фокусного вікна. Об'єкт "w" був би по суті тим самим визначенням матриці, яке передало б аргумент w фокусно. Саме це визначає розмір вектора підмножини у кожному фокусному оцінюванні.

w=c(5,5)
x <- runif(w[1]*w[2])
x[25] <- NA
print(x)
( x <- matrix(x, nrow=w[1], ncol=w[2]) ) 
( se <- mean(x, na.rm=TRUE) * sqrt(2) )
ifelse( as.vector(x[(length(as.vector(x)) + 1)/2]) <= se, 1, 0) 

Тепер створимо функцію, яка може бути застосована до фокусному застосує вищевказану логіку. У цьому випадку ви можете призначити se об'єкту як значення або використовувати його як умову в чомусь на зразок "ifelse", щоб призначити значення на основі оцінки. Я додаю твердження ifelse, щоб проілюструвати, як можна було б оцінити декілька умов сусідства і застосувати умову положення матриці (нотації сусідства). У цій манекеновій функції примус x до матриці зовсім непотрібний і існує просто для ілюстрації того, як це було б зроблено. Можна застосувати умови позначення сусідства безпосередньо до вектора без матричного примусу, оскільки положення у векторі застосовуватиметься до його розташування у фокусному вікні та залишатиметься фіксованим.

f.rast <- function(x, dims=c(5,5)) {
  x <- matrix(x, nrow=dims[1], ncol=dims[2]) 
  se <- mean(x, na.rm=TRUE) * sqrt(2)
  ifelse( as.vector(x[(length(as.vector(x)) + 1)/2]) <= se, 1, 0)   
}  

І нанесіть його на растр

library(raster)
r <- raster(nrows=100, ncols=100)
  r[] <- runif( ncell(r) )
  plot(r)

( r.class <- focal(r, w = matrix(1, nrow=w[1], ncol=w[2]), fun=f.rast) )
plot(r.class)  

Ви можете легко оновлювати растрові значення за допомогою підрозділу растра, використовуючи позначення [рядок, стовпчик]. Просто зауважте, що рядки та стовпці починаються з верхнього лівого кута растра; r [1,1] - верхній лівий індекс пікселя, а r [2,1] - той, що знаходиться під r [1,1].

# the function to update raster cell values
focal_raster_update <- function(r, row, col) {
  # copy the raster to hold the temporary values
  r_copy <- r
  r_copy[row,col] <- 0
  #upper left
  r_copy[row-1,col-1] <- mean(r[(row-2):(row-1),(col-2):(col-1)]) * sqrt(2)
  #upper mid
  r_copy[row-1,col] <- mean(r[(row-2):(row-1),(col-1):(col+1)])
  #upper right
  r_copy[row-1,col+1] <- mean(r[(row-2):(row-1),(col+1):(col+2)]) * sqrt(2)
  #left
  r_copy[row,col-1] <- mean(r[(row-1):(row+1),(col-2):(col-1)])
  #right
  r_copy[row,col+1] <- mean(r[(row-1):(row+1),(col+1):(col+2)])
  #bottom left
  r_copy[row+1,col-1] <- mean(r[(row+1):(row+2),(col-2):(col-1)]) * sqrt(2)
  #bottom mid
  r_copy[row+1,col] <- mean(r[(row+1):(row+2),(col-1):(col+1)])
  #bottom right
  r_copy[row+1,col+1] <- mean(r[(row+1):(row+2),(col+1):(col+2)]) * sqrt(2)
  return(r_copy)
}
col <- 5
row <- 5
r <- focal_raster_update(r,row,col)

dev.set(1)
plot(r)
text(r,digits=2)