0
votes

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
2
Do you want to replace every element in a matrix or vector? Can you give an example of your X ?ibilgen
@ibilgen see above, I added an example, I want to replace every value in a matrix.Anthony

2 Answers

0
votes

For a vector, you can do it as follows:

Say,

x = c(1,3,2,1,4,2) 
y = x # copy the vector
N=2 # window size, you can set any number you want.
for (i in 1:length(x)){ 
   y[i] = max(x[i-N:i+N]) 
} 

The result is

> y
[1] 3 3 3 3 4 4

For a matrix,

It is a little bit more complicated, Say X is,

X = matrix(sample(100, 36), ncol=6)
> X
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    9   72   17   62   41   47
[2,]   18   33   61   30   16   35
[3,]   38   96   37   60   13   70
[4,]    4   44   69   78   80   90
[5,]   39   81   65   24   28   11
[6,]   73   75   25   98   64  100

You can solve it as below:

Y=X # copy the matrix
N=2 # any window size 
for (i in 1:nrow(X)){ 
   for (j in 1:ncol(X)){ 
      Y[i,j] = max( X[ max(1,i-N):min(nrow(X),i+N), max(1,j-N):min(ncol(X),j+N)] ) 
   }
}

The result is

> Y
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]   96   96   96   96   70   70
[2,]   96   96   96   96   90   90
[3,]   96   96   96   96   90   90
[4,]   96   98   98  100  100  100
[5,]   96   98   98  100  100  100
[6,]   81   98   98  100  100  100
0
votes

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