diff --git a/DESCRIPTION b/DESCRIPTION index f90b305..190f67e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: MODIS Title: Acquisition and Processing of MODIS Products -Version: 1.2.13 +Version: 1.2.13.9002 URL: https://github.com/fdetsch/MODIS BugReports: https://github.com/fdetsch/MODIS/issues Authors@R: c( diff --git a/NEWS b/NEWS index f61644b..3b733e2 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,20 @@ +MODIS 1.2.13.9002 (2025-08-25) + +features and improvements + + * Support local .hdf file input in runGdal(), bypassing Earthdata + authentication (#143) + +bug fixes + + * Fix "warp: options error" caused by incorrectly specified -co options in + sf::gdal_warp() (#145) + +documentation etc + +miscellaneous + + MODIS 1.2.13 (2025-07-07) documentation etc @@ -107,7 +124,7 @@ bug fixes * Curl-based download from LP DAAC. * "Error: object 'tid' not found" from climate modeling grids (CMG) not being identified as such, but treated as tiled products. - * Wrong dimension and resolution of images created by runGdal() when working with whole tiles instead of spatial subsets (i.e. 'tileH,tileV' specified; see ). + * Wrong dimension and resolution of images created by runGdal() when working with whole tiles instead of spatial subsets (i.e. 'tileH,tileV' specified; see #46). miscellaneous @@ -115,7 +132,7 @@ miscellaneous * EarthdataLogin() now allows multiple entries in a .netrc file in case users have other servers not related to Earthdata. * Disabled retrieval of MOD16 products from NTSG server, which is no longer updated. * When 'extent' is a country name, 'outProj' is taken from MODISoptions() rather than hard-coded EPSG:4326. - * If 'begin' falls in between two composite release dates, it is set back to start date of preceding release (see ). + * If 'begin' falls in between two composite release dates, it is set back to start date of preceding release (#43). * When working with Extent (raster) or bbox objects (sf) and 'outProj' and 'pixelSize' are "asIn", the output grid and resolution is aligned with the original MODIS Sinusoidal grid. * Replaced 'XML' package dependency through regular expression matching. @@ -138,7 +155,7 @@ miscellaneous * Disabled use of EPSV (see ) when downloading structure from LP DAAC, LAADS. The latter didn't work anymore with EPSV enabled. * getProduct() and getCollection() are now compatible with more than one input 'product' provided using eg. c(). - * At the same time, pattern matching for a distinct set of products (see ) is switched off as long as a proper regular expression is omitted. + * At the same time, pattern matching for a distinct set of products is switched off as long as a proper regular expression is omitted (#22). * The MODIS package is now licensed under the MIT license (). diff --git a/NEWS.md b/NEWS.md index 0ef018e..7612855 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,20 @@ +# MODIS 1.2.13.9002 (2025-08-25) + +#### ✨ features and improvements + + * Support local `.hdf` file input in `runGdal()`, bypassing Earthdata + authentication (#143) + +#### 🐛 bug fixes + + * Fix "warp: options error" caused by incorrectly specified `-co` options in + `sf::gdal_warp()` (#145) + +#### 💬 documentation etc + +#### 🍬 miscellaneous + + # MODIS 1.2.13 (2025-07-07) #### 💬 documentation etc @@ -188,7 +205,7 @@ * Curl-based download from LP DAAC. * "Error: object 'tid' not found" from climate modeling grids (CMG) not being identified as such, but treated as tiled products. - * Wrong dimension and resolution of images created by runGdal() when working with whole tiles instead of spatial subsets (i.e. 'tileH,tileV' specified; see ). + * Wrong dimension and resolution of images created by runGdal() when working with whole tiles instead of spatial subsets (i.e. 'tileH,tileV' specified; see #46). #### 🍬 miscellaneous @@ -196,7 +213,7 @@ * EarthdataLogin() now allows multiple entries in a .netrc file in case users have other servers not related to Earthdata. * Disabled retrieval of MOD16 products from NTSG server, which is no longer updated. * When 'extent' is a country name, 'outProj' is taken from MODISoptions() rather than hard-coded EPSG:4326. - * If 'begin' falls in between two composite release dates, it is set back to start date of preceding release (see ). + * If 'begin' falls in between two composite release dates, it is set back to start date of preceding release (#43). * When working with Extent (raster) or bbox objects (sf) and 'outProj' and 'pixelSize' are "asIn", the output grid and resolution is aligned with the original MODIS Sinusoidal grid. * Replaced 'XML' package dependency through regular expression matching. @@ -205,7 +222,7 @@ #### ✨ features and improvements - * Added remaining products from the LP DAAC MODIS Products Table (). + * Added remaining products from the LP DAAC MODIS Products Table (). * Explicit specification of 'pos1','pos2' arguments passed to extractDate() and orgTime() is no longer required when dealing with standard MODIS file names. #### 🐛 bug fixes @@ -217,9 +234,9 @@ #### 🍬 miscellaneous - * Disabled use of EPSV (see ) when downloading structure from LP DAAC, LAADS. The latter didn't work anymore with EPSV enabled. + * Disabled use of EPSV (see ) when downloading structure from LP DAAC, LAADS. The latter didn't work anymore with EPSV enabled. * getProduct() and getCollection() are now compatible with more than one input 'product' provided using eg. c(). - * At the same time, pattern matching for a distinct set of products (see ) is switched off as long as a proper regular expression is omitted. + * At the same time, pattern matching for a distinct set of products is switched off as long as a proper regular expression is omitted (#22). * The MODIS package is now licensed under the MIT license (). diff --git a/R/MODISoptions.R b/R/MODISoptions.R index bac7df2..2beb423 100644 --- a/R/MODISoptions.R +++ b/R/MODISoptions.R @@ -375,6 +375,7 @@ MODISoptions <- function(localArcPath, outDirPath, pixelSize, outProj, if(!missing(dataFormat)) { + # TODO: compare input against 'name' (or 'long_name') from `sf::st_drivers("raster")` opt$dataFormat <- dataFormat } if(is.null(opt$dataFormat)) diff --git a/R/getProduct.R b/R/getProduct.R index b4d6636..04eacb5 100644 --- a/R/getProduct.R +++ b/R/getProduct.R @@ -105,7 +105,10 @@ getProduct <- function(x = NULL, quiet = FALSE, ...) , PRODUCT = fname$PRODUCT , DATE = fname$DATE , TILE = fname$TILE - , CCC = fname$CCC + , CCC = stats::setNames( + fname$CCC + , nm = fname$PRODUCT + ) # imitates named 'CCC' slot when input is not a file , PROCESSINGDATE = fname$PROCESSINGDATE , FORMAT = fname$FORMAT , SENSOR = info$SENSOR diff --git a/R/getSds.R b/R/getSds.R index f1301cb..e54901d 100644 --- a/R/getSds.R +++ b/R/getSds.R @@ -24,17 +24,16 @@ #' , package = "MODIS" #' ) #' -#' getSds( -#' hdf -#' ) +#' ## list all sds +#' getSds(hdf) #' +#' ## list selected sds #' getSds( #' hdf -#' , SDSstring = 1 +#' , SDSstring = "1" #' ) #' -#' @export getSds -#' @name getSds +#' @export getSds = function( HdfName , SDSstring = NULL diff --git a/R/runGdal.R b/R/runGdal.R index c8b2192..8d41b6b 100644 --- a/R/runGdal.R +++ b/R/runGdal.R @@ -109,9 +109,33 @@ runGdal <- function(product, collection=NULL, # absolutely needed product <- getProduct(product, quiet=TRUE, collection = collection) - - # optional and if missing it is added here: - tLimits <- transDate(begin=begin,end=end) + is_modfile = inherits(product, what = "MODISfile") + + if (is_modfile) { + + # early exit: 2+ local files + if (length(product@request) > 1L) { + stop( + "Processing of 2+ local `.hdf` files not supported, yet." + , call. = FALSE + ) + } + + # TODO: raise `warning()` in case of specified 'begin', 'end', 'tileH', 'tileV' + begin = end = as.Date( + product@DATE + , format = "A%Y%j" + ) + + tile = substring( + product@TILE + , first = c(2L, 5L) + , last = c(3L, 6L) + ) + + tileH = tile[1L] + tileV = tile[2L] + } dataFormat <- toupper(opts$dataFormat) @@ -142,6 +166,11 @@ runGdal <- function(product, collection=NULL, args = args[names(args) %in% c("extent", "tileH", "tileV")] names(args)[names(args) == "extent"] = "x" + if (is_modfile) { + args$tileH = tileH + args$tileV = tileV + } + if (missing(extent) || !inherits(extent, "MODISextent")) { extent = if (product@TYPE[1] == "Tile" || (product@TYPE[1] == "CMG" && @@ -174,9 +203,18 @@ runGdal <- function(product, collection=NULL, ### PRODUCT PROCESSING ==== + # optional and if missing it is added here: + tLimits = transDate( + begin = begin + , end = end + ) + lst_product <- vector("list", length(product@PRODUCT)) for (z in seq_along(product@PRODUCT)) { - # z=1 + + # # debug: + # z = 1L + todo <- paste(product@PRODUCT[[z]], product@CCC[[product@PRODUCT[z]]], sep = ".") if(z==1) @@ -196,104 +234,129 @@ runGdal <- function(product, collection=NULL, lst_todo <- vector("list", length(todo)) for (u in seq_along(todo)) { - # u=1 - ftpdirs <- list() - - server = product@SOURCE[[z]] - - jnk = strsplit(todo[u],"\\.")[[1]] - prodname = jnk[1] - coll = jnk[2] - - # cycle through available servers - idx = stats::na.omit( - match( - opts$MODISserverOrder - , server - ) - ) - - struc = try( - log("e") - , silent = TRUE - ) - - n = 1L - for (i in server[idx]) { - jnk = utils::capture.output( - struc <- try( - getStruc( - product = prodname - , collection = coll - , begin = tLimits$begin - , end = tLimits$end - , server = i - ) - , silent = TRUE + + # # debug: + # u = 1L + + if (is_modfile) { + avDates = begin + us = TRUE + } else { + + ftpdirs <- list() + + server = product@SOURCE[[z]] + + jnk = strsplit(todo[u],"\\.")[[1]] + prodname = jnk[1] + coll = jnk[2] + + # cycle through available servers + idx = stats::na.omit( + match( + opts$MODISserverOrder + , server ) ) - if (!inherits(struc, "try-error")) { - opts$MODISserverOrder = server[idx][n:length(idx)] - break - } + struc = try( + log("e") + , silent = TRUE + ) - n = n + 1L - } - - if (inherits(struc, "try-error")) { - stop( - sprintf( - paste0( - "'%s.%s' is not available on %s or the server is currently not " - , "reachable. If applicable, try another server or collection." + n = 1L + for (i in server[idx]) { + jnk = utils::capture.output( + struc <- try( + getStruc( + product = prodname + , collection = coll + , begin = tLimits$begin + , end = tLimits$end + , server = i + ) + , silent = TRUE ) - , prodname - , coll - , paste( - opts$MODISserverOrder - , collapse = ", " + ) + + if (!inherits(struc, "try-error")) { + opts$MODISserverOrder = server[idx][n:length(idx)] + break + } + + n = n + 1L + } + + if (inherits(struc, "try-error")) { + stop( + sprintf( + paste0( + "'%s.%s' is not available on %s or the server is currently not " + , "reachable. If applicable, try another server or collection." + ) + , prodname + , coll + , paste( + opts$MODISserverOrder + , collapse = ", " + ) ) + , call. = FALSE ) - , call. = FALSE + } + + ftpdirs[[1]] = as.Date( + struc$dates ) + + avDates <- ftpdirs[[1]] + avDates <- avDates[avDates!=FALSE] + avDates <- avDates[!is.na(avDates)] + + sel <- as.Date(avDates) + + st = correctStartDate(tLimits$begin, sel, prodname, quiet = opts$quiet) + us = sel >= st & sel <= tLimits$end } - ftpdirs[[1]] = as.Date( - struc$dates - ) - - avDates <- ftpdirs[[1]] - avDates <- avDates[avDates!=FALSE] - avDates <- avDates[!is.na(avDates)] - - sel <- as.Date(avDates) - - st = correctStartDate(tLimits$begin, sel, prodname, quiet = opts$quiet) - us = sel >= st & sel <= tLimits$end if (sum(us,na.rm=TRUE)>0) { avDates <- avDates[us] lst_ofile <- as.list(rep(NA, length(avDates))) - for (l in seq_along(avDates)) { - # l=1 - files <- unlist( - getHdf(product = prodname, collection = coll - , begin = avDates[l], end = avDates[l] - , extent = extent, checkIntegrity = checkIntegrity - , stubbornness = opts$stubbornness, quiet = opts$quiet - , MODISserverOrder = opts$MODISserverOrder - , forceDownload = forceDownload, wait = opts$wait) - ) + for (l in seq_along(avDates)) { + + files = if (is_modfile) { + product@request + } else { + unlist( + getHdf(product = prodname, collection = coll + , begin = avDates[l], end = avDates[l] + , extent = extent, checkIntegrity = checkIntegrity + , stubbornness = opts$stubbornness, quiet = opts$quiet + , MODISserverOrder = opts$MODISserverOrder + , forceDownload = forceDownload, wait = opts$wait) + ) + } files <- files[basename(files)!="NA"] # is not a true NA so it need to be like that na not !is.na() # silently remove empty or invalid files from list if (checkIntegrity) files <- files[checkIntegrity(files)] - if(length(files)>0) - { + # early exit: no leftover files + if (length(files) == 0L) { + warning( + paste( + "No file found for date:" + , avDates[l] + ) + , call. = FALSE + ) + + next + } + SDS = lapply( files , getSds @@ -329,7 +392,10 @@ runGdal <- function(product, collection=NULL, ofiles <- character(length(SDS[[1]]$SDSnames)) for (i in seq_along(SDS[[1]]$SDSnames)) { - # i=1 + + # # debug: + # i = 1L + outname <- paste0(paste0(strsplit(basename(files[1]),"\\.")[[1]][1:2],collapse="."), ".", gsub(SDS[[1]]$SDSnames[i],pattern=" ",replacement="_"), xtn) @@ -355,18 +421,32 @@ runGdal <- function(product, collection=NULL, } ## create first set of gdal options required by subsequent step - lst = list(dataFormat, co, rt, srcnodata) - names(lst) = paste0( + lst0 = list(dataFormat, co, rt, srcnodata) + names(lst0) = paste0( "-" , c("of", "co", "r", "srcnodata") ) - lst = Filter(Negate(is.null), lst) + lst0 = Filter(Negate(is.null), lst0) + nms = rep( + names(lst0) + , times = lengths(lst0) + ) + + vls = unlist( + lst0 + , use.names = FALSE + ) + params = character() - for (j in seq(lst)) { - params = c(params, names(lst)[j], lst[[j]]) + for (j in seq(nms)) { + params = c( + params + , nms[j] + , vls[j] + ) } - + qt = !is.null(opts$quiet) && opts$quiet ## if required, adjust pixel size and/or target extent @@ -409,11 +489,11 @@ runGdal <- function(product, collection=NULL, } ## extract layers - lst = c(lst, list("-t_srs" = if (t_srs != s_srs) t_srs, "-te" = te, "-tr" = tr)) - lst = Filter(Negate(is.null), lst) + lst1 = c(lst0, list("-t_srs" = if (t_srs != s_srs) t_srs, "-te" = te, "-tr" = tr)) + lst1 = Filter(Negate(is.null), lst1) - for (j in (j+1):length(lst)) { - params = c(params, names(lst)[j], lst[[j]]) + for (j in (length(lst0)+1):length(lst1)) { + params = c(params, names(lst1)[j], lst1[[j]]) } jnk = file.remove(ofile) @@ -441,10 +521,6 @@ runGdal <- function(product, collection=NULL, } lst_ofile[[l]] <- ofiles - } else { - warning(paste0("No file found for date: ",avDates[l])) - lst_ofile[[l]] <- NA - } } names(lst_ofile) <- avDates diff --git a/dev_history.R b/dev_history.R index eb2965f..6ff7872 100644 --- a/dev_history.R +++ b/dev_history.R @@ -439,3 +439,50 @@ plot( ) ## --> resample/reproject afterwards + + +# 2025-07-15 ==== + +fl = system.file( + "external/MOD13A2.A2016145.h18v04.006.2016166145124.hdf" + , package = "MODIS" +) + +isHDF = function(x) { + file.exists(x) & + grepl( + # https://darktarget.gsfc.nasa.gov/content/how-are-modis-files-named + "^[A-Z0-9_]+\\.A\\d{7}\\.h\\d{2}v\\d{2}\\.\\d{3}\\.\\d{13}\\.hdf$" + , basename(x) + ) +} + +tinytest::expect_true( + isHDF(fl) + , info = "Local MODIS `.hdf` file is identified as such." +) + +## `getTile()` based on `.hdf` input +bn = basename(fl) + +tiles = regmatches( + bn + , m = regexpr( + pattern = "\\.h\\d{2}v\\d{2}\\." + , text = bn + ) +) + +selected = substring( + tiles + , first = c(3L, 6L) + , last = c(4L, 7L) +) + +MODIS::getTile( + tileH = selected[1L] + , tileV = selected[2L] +) + +## `runGdal()` based on `.hdf` input -> fails (#143) +# MODIS::runGdal(fl) diff --git a/inst/tinytest/_test-getProduct.R b/inst/tinytest/test-getProduct.R similarity index 59% rename from inst/tinytest/_test-getProduct.R rename to inst/tinytest/test-getProduct.R index 0d5cb22..41264eb 100644 --- a/inst/tinytest/_test-getProduct.R +++ b/inst/tinytest/test-getProduct.R @@ -1,3 +1,5 @@ +## PRODUCT INPUT ==== + ### available ---- expect_stdout( @@ -47,3 +49,35 @@ expect_null( res2 , info = "`NULL` output is returned in case product is not available" ) + + +## FILE INPUT ==== + +fl = system.file( + "external/MOD13A2.A2016145.h18v04.006.2016166145124.hdf" + , package = "MODIS" +) + +expect_inherits( + res3 <- getProduct(fl) + , class = "MODISfile" + , info = "output inherits from class 'MODISfile' if request is a file" +) + +nfo = strsplit( + basename(fl) + , "\\." +)[[1L]] + +## investigate collection slot +expect_equivalent( + res3@CCC + , target = nfo[4L] + , info = "'CCC' content is the collection of the requested file" +) + +expect_identical( + names(res3@CCC) + , target = nfo[1L] + , info = "'CCC' content is named according to product" +) diff --git a/inst/tinytest/test-runGdal.R b/inst/tinytest/test-runGdal.R index 2b5e0ed..af242aa 100644 --- a/inst/tinytest/test-runGdal.R +++ b/inst/tinytest/test-runGdal.R @@ -1,3 +1,5 @@ +## PRODUCT INPUT ==== + ## early exit: product not available from a particular server jnk = utils::capture.output( expect_error( @@ -14,17 +16,57 @@ jnk = utils::capture.output( ) ) + +## FILE INPUT ==== + +sysfile = system.file( + "external/MOD13A2.A2016145.h18v04.006.2016166145124.hdf" + , package = "MODIS" +) + +jnk = suppressWarnings( + utils::capture.output( + tifs <- runGdal( + sysfile + , overwrite = TRUE + ) + ) +) + +## investigate output +expect_inherits( + tifs + , class = "list" +) + +expect_true( + all( + file.exists( + unlist( + tifs + , use.names = FALSE + ) + ) + ) + , info = "writes layers to temporary `.tif` files." +) + +## early exit: 2+ input files +expect_error( + runGdal( + rep( + sysfile + , 2L + ) + ) + , pattern = "^Processing of 2\\+ local .* files not supported, yet\\.$" +) + ## early exit: `length(maskValue)` not `1L` or matching 'SDSstring' jnk = utils::capture.output( expect_error( runGdal( - "MCD15A2H" - , collection = "061" - , tileH = 21 - , tileV = c(7, 8) - , begin = "2003001" - , end = "2003010" - , SDSstring = "110100" + sysfile , maskValue = c(254L, 255L) , quiet = TRUE ) diff --git a/man/getSds.Rd b/man/getSds.Rd index f64df0b..3d99db8 100644 --- a/man/getSds.Rd +++ b/man/getSds.Rd @@ -30,13 +30,13 @@ hdf = system.file( , package = "MODIS" ) -getSds( - hdf -) +## list all sds +getSds(hdf) +## list selected sds getSds( hdf - , SDSstring = 1 + , SDSstring = "1" ) }