sliding_box.R

gistfile1.txt

library(raster)

nlm_raster <- nlm_gaussianfield(100, 100, 5)

setGeneric(
  "splitRaster",
  function(r, nx = 1, ny = 1, buffer = c(0, 0), path = file.path(getwd(), names(r)), cl) {
    standardGeneric("splitRaster")
  })

#' @export
#' @rdname splitRaster
sliding_box <-  function(r, nx, ny, buffer, path, cl) {
    # if (!is.numeric(nx) | !is.numeric(ny) | !is.numeric(buffer)) {
    #   stop("nx, ny, and buffer must be numeric")
    # }
    # if (!is.integer(nx)) nx <- as.integer(nx)
    # if (!is.integer(ny)) ny <- as.integer(ny)
    # if (is.integer(buffer)) buffer <- as.numeric(buffer)
    
    if (missing(cl)) {
      cl <- parallel::makeCluster(parallel::detectCores())
    }
    
    # if (length(buffer) > 2) {
    #   warning("buffer contains more than 2 elements - only the first two will be used.")
    #   buffer <- buffer[1:2]
    # } else if (length(buffer) == 1) {
    #   buffer <- c(buffer, buffer)
    # }
    # if (buffer[1] < 1) {
    #   buffer[1] <- ceiling((buffer[1] * (xmax(r) - xmin(r)) / nx) / xres(r)) # nolint
    # }
    # if (buffer[2] < 1) {
    #   buffer[2] <- ceiling((buffer[2] * (ymax(r) - ymin(r)) / ny) / yres(r)) # nolint
    # }
    
    ext <- extent(r)
    extents <- vector("list", length = nx * ny)
    n <- 1L
    for (i in seq_len(nx) - 1L) {
      for (j in seq_len(ny) - 1L) {
        x0 <- ext@xmin + i * ((ext@xmax - ext@xmin) / nx) - buffer[1] * xres(r) # nolint
        x1 <- ext@xmin + (i + 1L) * ((ext@xmax - ext@xmin) / nx) + buffer[1] * xres(r) # nolint
        y0 <- ext@ymin + j * ((ext@ymax - ext@ymin) / ny) - buffer[2] * yres(r) # nolint
        y1 <- ext@ymin + (j + 1L) * ((ext@ymax - ext@ymin) / ny) + buffer[2] * yres(r) # nolint
        extents[[n]] <- extent(x0, x1, y0, y1)
        n <- n + 1L
      }
    }
    
    croppy <- function(i, e, r) {
      ri <- raster::crop(r, e[[i]])
      raster::crs(ri) <-  raster::crs(r)
      return(ri)
    }
    
    tiles <- if (!is.null(cl)) {
      parallel::clusterApplyLB(cl = cl, x = seq_along(extents), fun = croppy, e = extents, r = r)
    } else {
      lapply(X = seq_along(extents), FUN = croppy, e = extents, r = r)
    }
    
    # Shutdown cluster neatly
    if(!is.null(parallelCluster)) {
      parallel::stopCluster(parallelCluster)
      parallelCluster <- c()
    }
    
    return(tiles)
  }


nlm_sliding_box<- sliding_box(nlm_raster, 10, 10, buffer = c(3,3)) 


lapply_var <- function(i, e) {
  var_lap <- var(e[[i]][], na.rm = TRUE)
  return(var_lap)
}            


lapply_mean <- function(i, e) {
  mean_lap <- mean(e[[i]][], na.rm = TRUE)
  return(mean_lap)
} 

test_var  <- lapply(X = seq_along(nlm_sliding_box), FUN =  lapply_var, e = nlm_sliding_box)

test_mean <- lapply(X = seq_along(nlm_sliding_box), FUN =  lapply_mean, e = nlm_sliding_box)


var(unlist(test_mean))
sort(unique(unlist(test_mean)))