1 and 2 dimensional sliding window

A blog reader recently asked if the sliding window function could be extended to a matrix; This seemed like something that might be useful so I have provided this extension below. Furthermore, once I looked at the code I realized that I needed to add validation testing and helpful error messages. The version below has been uploaded to the GitHub version of the EvobiR package and can be loaded using devtools as described here.

SlidingWindow <- function(FUN, data, window, step, strict){
  # Validation testing
  if(strict) {
    
    if(!is.numeric(data)) stop("Please supply numeric data")

    if(sum(is.vector(data), is.matrix(data)) == 0) {
      stop("You must supply data as a vector or matrix")
    }
    
    if(is.vector(data)){
      if(window > length(data)) stop("Window size is too large")
      if((step + window) > length(data)) stop("Window and step size 
                                            should be small enough 
                                            that multiple windows 
                                            can be examined")
    }
    
    if(is.matrix(data)){
      if(window > nrow(data)) stop("Window size is too large for number of rows")
      if(window > ncol(data)) stop("Window size is too large for number of cols")
      if((step + window) > nrow(data)) stop("Window and step size 
                                            should be small enough 
                                            that multiple windows 
                                            can be examined")
    }
  }
  
  # code for vectors
  if(is.vector(data)) {
    total <- length(data)
    spots <- seq(from = 1, to = (total - window), by = step)
    result <- vector(length = length(spots))
    for(i in 1:length(spots)){
      result[i] <- match.fun(FUN)(data[spots[i]:(spots[i] + window - 1)])
    }
  }
  
  # code for matrices
  if(is.matrix(data)){
    total.x <- ncol(data)
    spots.x <- seq(from = 1, to = (total.x - window), by = step)
    total.y <- nrow(data)
    spots.y <- seq(from = 1, to = (total.y - window), by = step)
    result <- matrix(, length(spots.y), length(spots.x))
    for(i in 1:length(spots.y)){
      for(j in 1:length(spots.x)){
        result[i, j] <- match.fun(FUN)(data[spots.y[i]:(spots.y[i] + window - 1),
                                            spots.x[j]:(spots.x[j] + window - 1)])
      }
    }
  }
  
  # complete failure message
  if(!exists("result")) stop("Hmmm unknown error... Sorry")
  
  # return the result to the user
  return(result)
}

Here is an example of this in action. First, let us simulate a bit of interesting data:

x <- seq(-pi, pi, len = 600)
y <- seq(-pi, pi, len = 600)
g <- expand.grid(x = x, y = y)
g$z <- sin(sqrt(g$x^2 + g$y^2)) + rnorm(600^2, sd=2)
ex.dat <- matrix(g$z,600,600)
image(ex.dat)

This data looks like this when we plot it as a heat map:

That looks interesting but we have far too much data and it looks like there is quite a bit of very small-scale noise in the data. Let us try using our window function and see if it makes things a bit clearer:

reduced.ex.dat <- SlidingWindow(FUN="mean", data=ex.dat, window=10, step=5, strict=T)
image(reduced.ex.dat)

And now we can produce the same plot on our data after applying a sliding window:

Hopefully, that is helpful!

Coleopterists Corner

Using Coleoptera to understand evolution; and lots of R

View comments