R/resample.grid.R

In HMMoce: Improved Analysis of Marine Animal Movement Data Using Hidden Markov Models

#' Resample likelihood rasters to common resolution/extent
#' 
#' @param L.rasters list of individual likelihood rasters generated by calc 
#'   functions
#' @param L.res raster or raster brick indicating desired output resolution of 
#'   all likelihood rasters.
#' @param mle.res is desired resolution (in degrees) of the coarse output grid
#'   to be used in parameter estimation.
#' @param bound is a raster extent object that can be passed in order to 
#'   restrict the input raster likelihoods to a certain spatial domain. Default 
#'   is null and thus uses the full extent of input rasters. For more 
#'   information on the extent object see \code{raster::extent}
#'   
#' @return a list of all resampled likelihood rasters and g, the common grid
#' @export
#' 

resample.grid <- function(L.rasters, L.res, mle.res=0.75, bound=NULL){
  
  start.t <- Sys.time()
  
  L.rasters.old <- L.rasters
  
  for (i in 1:length(L.rasters)){
    r <- L.rasters[[i]]
    
    if (i == 1){
      resol <- raster::res(r)[1]
    } else{
      resol <- c(resol, raster::res(r)[1])
    }
    
    t <- Sys.time()
    r <- raster::resample(r, L.res)
    print(Sys.time() - t)
    r[r == 0] <- NA
    L.rasters[[i]] <- r
    
  }
  
  if(!is.null(bound)){
    if(class(bound) != 'Extent') stop('Error: input bound is not of class raster::extent.')
    for (ii in 1:length(L.rasters)) L.rasters[[ii]] <- raster::crop(L.rasters[[ii]], bound)
    #L.rasters <- lapply(L.rasters, FUN=function(x) raster::crop(L.rasters[[x]], bound))
  }
  
  L.mle.res <- L.rasters[1][[1]]
  agg <- round(mle.res / raster::res(L.mle.res)[1])
  is.odd <- function(x) x %% 2 != 0
  if(!is.odd(agg)) agg <- agg + 1
  if(agg != 1) L.mle.res <- raster::aggregate(L.mle.res, agg)
  
  g <- setup.grid.raster(L.rasters[[1]])
  g.mle <- setup.grid.raster(L.mle.res)
  
  print(paste('Raster resample took ', Sys.time() - start.t, '.'))
  
  list(L.rasters, L.mle.res = L.mle.res, g = g, g.mle = g.mle)
  
}