reformatDOY.R 2.8 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. #' Reformat MODIS "composite_day_of_the_year" SDS
  2. #'
  3. #' @description
  4. #' In order to create custom temporal aggregation levels (e.g., half-monthly,
  5. #' monthly) from native 16-day MODIS composites, a convenient representation of
  6. #' the pixel-wise acquisition date is urgently required. Since the MODIS
  7. #' "composite_day_of_the_year" SDS merely includes the day of the year (DOY),
  8. #' but not the year itself, this function creates complete date information from
  9. #' both the respective MODIS layer name and the pixel-wise DOY information.
  10. #'
  11. #' @param x \code{character} or \code{Raster*}. MODIS
  12. #' "composite_day_of_the_year" layer(s).
  13. #' @param cores \code{integer}. Number of cores for parallel processing.
  14. #' @param ... Additional arguments passed to \code{\link{extractDate}}.
  15. #'
  16. #' @return
  17. #' A \code{Raster*} object.
  18. #'
  19. #' @author
  20. #' Florian Detsch
  21. #'
  22. #' @seealso
  23. #' \code{\link{repDoy}}.
  24. #'
  25. #' @examples
  26. #' \dontrun{
  27. #' tfs = runGdal("MOD13Q1", collection = "006",
  28. #' begin = "2000353", end = "2000366", extent = "Luxembourg",
  29. #' job = "reformatDOY", SDSstring = "000000000010")
  30. #'
  31. #' ## raw doy
  32. #' raw <- raster(unlist(tfs))
  33. #' unique(raw[])
  34. #'
  35. #' ## reformatted dates
  36. #' rfm <- reformatDOY(raw)
  37. #' unique(rfm[])
  38. #' }
  39. #'
  40. #' @export reformatDOY
  41. #' @name reformatDOY
  42. reformatDOY <- function(x, cores = 1L, ...) {
  43. ## if 'x' represents filename(s), import as 'Raster*'
  44. if (inherits(x, "character"))
  45. x <- raster::stack(x)
  46. ## extract required date information
  47. dts <- extractDate(x, ...)$inputLayerDates
  48. yrs <- as.numeric(substr(dts, 1, 4))
  49. dys <- as.numeric(substr(dts, 5, 7))
  50. ## initialize parallel cluster and export required objects
  51. cl <- parallel::makePSOCKcluster(cores)
  52. on.exit(parallel::stopCluster(cl))
  53. parallel::clusterExport(cl, c("x", "yrs", "dys"), envir = environment())
  54. ## loop over layers
  55. rfm <- do.call(
  56. raster::stack,
  57. parallel::parLapply(cl, 1:raster::nlayers(x), function(i) {
  58. # get doy values
  59. rst <- raster::subset(x, i)
  60. val <- raster::getValues(rst)
  61. # if required (i.e., if file date and pixel-based doy differ by more than
  62. # 300 days), add +1 to year information of the respective pixel
  63. yr <- rep(yrs[i], length(val))
  64. dff <- unique(val) - dys[i]
  65. if (any(dff < (-300), na.rm = TRUE)) {
  66. ids <- which(dff < (-300))
  67. nxt <- unique(val)[ids]
  68. ids <- which(val %in% nxt)
  69. yr[ids] <- yr[ids] + 1
  70. }
  71. # insert new date values into raster layer
  72. val <- formatC(val, width = 3, flag = "0")
  73. val <- suppressWarnings(as.integer(paste0(yr, val)))
  74. raster::setValues(rst, val)
  75. })
  76. )
  77. ## if length(x) == 1, return 'RasterLayer'
  78. if (raster::nlayers(rfm) == 1) {
  79. rfm[[1]]
  80. ## else return 'RasterStack'
  81. } else {
  82. rfm
  83. }
  84. }