Search code examples
rmatrixrasternearest-neighborr-sp

How to replace every element in a matrix with the maximum of the values within a variable moving widow of size = n?


So essentially, what I want to do is replace every element in a matrix with the maximum of neighboring cells within a window that is determined by the value in that cell.

The window size would be determined by this function: 'fitlwr' (below), where Tree_Height calls a linear model that was fit to a dataset of Tree Height and Crown Diameter data:

RoundOdd <- function(x) {2*floor(x/2)+1} #makes sure window size is an odd number

fitlwr <- function(x){for(i in x){
  if(i > 13){
    m <- RoundOdd(Tree_Heights[Tree_Heights$Tree_Height == i, "fit.lwr"]) 
  return(matrix(1, nrow = m, ncol = m))
    }
  else {
    return(matrix(1, 3, 3))
    }
}}

I then want to replace every value in that matrix with the maximum of the values within that window, the raster focal functions were my go-to, but they don't let you use a variable window size.

The matrix was derived from a raster layer and the values represent the height above ground for a given cell. The dimensions are 6,571 x 5,764. A section of the data might look like this:

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    9   47  103   58   80   55   72   56   14    52
 [2,]   68   49   49   43   62   80   62   23   55    82
 [3,]   58   10   79   70   75   49   68   60   74    79
 [4,]   78   19   51   26   61   77   57   70   51    43
 [5,]   47   88   57   80   25   33   24   30   56    63
 [6,]   73   36   53   25   63   30   19   59   17    63
 [7,]   95    9   49   95    6   13   21   75   60    34
 [8,]   36   65   47   64   22   66   52    9   71    20
 [9,]   45   53   31   47  114   55   44   42   44    44
[10,]   47   23  102   34   67   60    5   23   61    32

Solution

  • Thanks Ibilgen, your solution worked and I modified it slightly to take the maximum of a circular moving window as well.

    This is for a rectangular moving window:

    Y <- X
    for (i in 1:nrow(X)){ 
       for (j in 1:ncol(X)){ 
          N <- fitlwr(X[i,j])
          Y[i,j] = max(X[max(1, i-N):min(nrow(X), i+N), max(1, j-N):min(ncol(X), j+N)]) 
      }
    }
    

    fitlwr() #is a custom function that calls a linear model that matches the value of a cell to the expected radius of the moving window

    And here is for a circular moving window:

    Y <- X
    for (i in 1:nrow(X)){ 
       for (j in 1:ncol(X)){ 
          N = fitlwr(X[i,j])
          M = X[max(1, i-N):min(nrow(X), i+N), max(1, j-N):min(ncol(X), j+N)]
          W = reshape2::melt(M)
          W$d2 = sqrt((W$Var1-mean(W$Var1))^2 + (W$Var2-mean(W$Var2))^2)
          Y[i,j] = max(X[i,j], max(subset(W, d2 <= N, select = value)))}
    }