├── LICENSE ├── R ├── sysdata.rda ├── MODISswath │ ├── getMxD35.R │ ├── FUSION_CloudCheck.R │ ├── AOIset_Odessa.txt │ ├── AOIset_Marchfeld.txt │ ├── AOIset_Jap.txt │ ├── AOIset_Odessa_179_27.txt │ ├── FUSION_cloudCeck_getMOD02.R │ ├── getMxD02_fromCSV.R │ └── FUSION_CloudCeck_MxD02_s2g.R ├── MODIS-deprecated.R ├── zzz.R ├── blockSizeCluster.R ├── checkIntegrity.R ├── fileSize.R ├── MODIS-package.R ├── lpdaacLogin.R ├── getPart.R ├── checkUtils.R ├── preStack.R ├── detectBitInfo.R ├── extractDate.R ├── addServer.R ├── getSds.R ├── reformatDOY.R ├── genTile.R ├── transDate.R ├── temporalComposite.R ├── aggInterval.R ├── gdalControls.R ├── repDoy.R ├── getUTMZone.R ├── aaa-classes.R ├── checkTools.R ├── downloadUtils.R ├── getGranule.R ├── getProduct.R └── orgStruc.R ├── .gitignore ├── inst ├── external │ ├── products.ods │ ├── tileNames.RData │ ├── MODIS_FTPinfo.RData │ ├── MODIS_Products.RData │ ├── MODIS_TilesPolys.RData │ ├── UTM_Zone_Boundaries.rds │ ├── modis_latlonWGS84_grid_world.dbf │ ├── modis_latlonWGS84_grid_world.shp │ ├── modis_latlonWGS84_grid_world.shx │ ├── modis_sinusoidal_grid_world.dbf │ ├── modis_sinusoidal_grid_world.shp │ ├── MOD13A2.A2016145.h18v04.006.2016166145124.hdf │ ├── modis_latlonWGS84_grid_world.prj │ ├── modis_sinusoidal_grid_world.prj │ └── MODIS_Opts.R └── tinytest │ ├── test-runMrt.R │ ├── _test-getCollection.R │ ├── test-MODISoptions.R │ ├── test-MODIScollection.R │ ├── _test-genString.R │ ├── _test-skipDuplicateProducts.R │ ├── test-runGdal.R │ ├── test-extractDate.R │ ├── _test-getProduct.R │ ├── test-minorFuns.R │ ├── _test-runGdal.R │ ├── test-MODIS_Products.R │ ├── test-getSds.R │ ├── test-getTile.R │ └── test-EarthdataLogin.R ├── tests └── tinytest.R ├── .Rbuildignore ├── MODIS.Rproj ├── man ├── fileSize.Rd ├── MODISextent-class.Rd ├── MODIS-deprecated.Rd ├── MODIS-package.Rd ├── preStack.Rd ├── detectBitInfo.Rd ├── getSds.Rd ├── lpdaacLogin-deprecated.Rd ├── MODISproduct-class.Rd ├── transDate.Rd ├── minorFuns.Rd ├── genTile.Rd ├── EarthdataLogin.Rd ├── reformatDOY.Rd ├── getProduct.Rd ├── MODISfile-class.Rd ├── delHdf.Rd ├── extractDate.Rd ├── aggInterval.Rd ├── orgStruc.Rd ├── temporalComposite.Rd ├── getCollection.Rd ├── repDoy.Rd ├── arcStats.Rd ├── orgTime.Rd ├── getHdf.Rd ├── smooth.spline.raster.Rd ├── runGdal.Rd ├── runMrt.Rd ├── whittaker.raster.Rd └── getTile.Rd ├── DESCRIPTION ├── NAMESPACE ├── exec ├── exec-modis_dl.R └── exec-modis_skip_s2.R ├── README.md └── TODO /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2018 2 | COPYRIGHT HOLDER: Matteo Mattiuzzi -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/R/sysdata.rda -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Renviron 5 | resample.log 6 | R/MODISswath -------------------------------------------------------------------------------- /R/MODISswath/getMxD35.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/R/MODISswath/getMxD35.R -------------------------------------------------------------------------------- /inst/external/products.ods: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/products.ods -------------------------------------------------------------------------------- /inst/external/tileNames.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/tileNames.RData -------------------------------------------------------------------------------- /R/MODISswath/FUSION_CloudCheck.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/R/MODISswath/FUSION_CloudCheck.R -------------------------------------------------------------------------------- /inst/external/MODIS_FTPinfo.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/MODIS_FTPinfo.RData -------------------------------------------------------------------------------- /inst/external/MODIS_Products.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/MODIS_Products.RData -------------------------------------------------------------------------------- /inst/external/MODIS_TilesPolys.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/MODIS_TilesPolys.RData -------------------------------------------------------------------------------- /inst/external/UTM_Zone_Boundaries.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/UTM_Zone_Boundaries.rds -------------------------------------------------------------------------------- /R/MODISswath/AOIset_Odessa.txt: -------------------------------------------------------------------------------- 1 | PID POS X Y 2 | 1 1 31.50 47.00 3 | 1 2 32.00 47.00 4 | 1 3 32.00 47.25 5 | 1 4 31.50 47.25 6 | -------------------------------------------------------------------------------- /tests/tinytest.R: -------------------------------------------------------------------------------- 1 | 2 | if ( requireNamespace("tinytest", quietly=TRUE) ){ 3 | tinytest::test_package("MODIS") 4 | } 5 | 6 | -------------------------------------------------------------------------------- /R/MODISswath/AOIset_Marchfeld.txt: -------------------------------------------------------------------------------- 1 | PID POS X Y 2 | 1 1 16.55 48.20 3 | 1 2 16.90 48.15 4 | 1 3 16.80 48.40 5 | 1 4 16.55 48.35 6 | -------------------------------------------------------------------------------- /inst/external/modis_latlonWGS84_grid_world.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/modis_latlonWGS84_grid_world.dbf -------------------------------------------------------------------------------- /inst/external/modis_latlonWGS84_grid_world.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/modis_latlonWGS84_grid_world.shp -------------------------------------------------------------------------------- /inst/external/modis_latlonWGS84_grid_world.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/modis_latlonWGS84_grid_world.shx -------------------------------------------------------------------------------- /inst/external/modis_sinusoidal_grid_world.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/modis_sinusoidal_grid_world.dbf -------------------------------------------------------------------------------- /inst/external/modis_sinusoidal_grid_world.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/modis_sinusoidal_grid_world.shp -------------------------------------------------------------------------------- /R/MODISswath/AOIset_Jap.txt: -------------------------------------------------------------------------------- 1 | PID POS X Y 2 | 1 1 137.9935 38.68482 3 | 1 2 141.9957 38.68482 4 | 1 3 141.9957 36.03953 5 | 1 4 137.6877 36.03953 6 | -------------------------------------------------------------------------------- /inst/tinytest/test-runMrt.R: -------------------------------------------------------------------------------- 1 | expect_error( 2 | runMrt( 3 | "MOD13Q1" 4 | , datum = "WGS85" 5 | ) 6 | , pattern = "'arg' should be one of" 7 | ) -------------------------------------------------------------------------------- /inst/external/MOD13A2.A2016145.h18v04.006.2016166145124.hdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fdetsch/MODIS/HEAD/inst/external/MOD13A2.A2016145.h18v04.006.2016166145124.hdf -------------------------------------------------------------------------------- /R/MODISswath/AOIset_Odessa_179_27.txt: -------------------------------------------------------------------------------- 1 | PID POS X Y 2 | 1 1 31.1237797 46.4107801 3 | 1 2 34.3793640 46.4178539 4 | 1 3 34.4326884 48.4202282 5 | 1 4 31.0512727 48.4126438 6 | -------------------------------------------------------------------------------- /inst/external/modis_latlonWGS84_grid_world.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137,298.257223563]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]] -------------------------------------------------------------------------------- /inst/external/modis_sinusoidal_grid_world.prj: -------------------------------------------------------------------------------- 1 | PROJCS["Sinusoidal_Sanson_Flamsteed",GEOGCS["GCS_Unknown",DATUM["D_unknown",SPHEROID["Unknown",6371007.181,"inf"]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]],PROJECTION["Sinusoidal"],PARAMETER["central_meridian",0],PARAMETER["false_easting",0],PARAMETER["false_northing",0],UNIT["Meter",1]] -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^TODO$ 4 | ^.*\NEWS.md$ 5 | ^R/addCollection\.R$ 6 | ^R/addProduct\.R$ 7 | ^R/addServer\.R$ 8 | ^resample\.log$ 9 | ^R/getUTMZone\.R$ 10 | ^inst/external/UTM_Zone_Boundaries\.rds$ 11 | ^inst/tinytest/test-runGdal\.R$ 12 | ^R/getGranule\.R$ 13 | ^R/MODISswath\.R$ 14 | ^R/MODISswath$ 15 | ^TODO$ 16 | ^dev_history\.R$ 17 | -------------------------------------------------------------------------------- /inst/tinytest/_test-getCollection.R: -------------------------------------------------------------------------------- 1 | expect_error( 2 | getCollection() 3 | , pattern = "Please provide a valid product" 4 | , info = "an error is raised if 'product' is missing" 5 | ) 6 | 7 | expect_stdout( 8 | getCollection("MCD12Q1.051", forceCheck = TRUE) 9 | , pattern = "not available in collection '051'" 10 | , info = "non-available collection creates console output" 11 | ) 12 | -------------------------------------------------------------------------------- /inst/tinytest/test-MODISoptions.R: -------------------------------------------------------------------------------- 1 | ## early exit: download method invalid 2 | expect_error( 3 | MODISoptions( 4 | dlmethod = "lynx" 5 | ) 6 | , pattern = "dlmethod %in% .* is not TRUE" 7 | ) 8 | 9 | ## early exit: download server(s) invalid 10 | expect_error( 11 | MODISoptions( 12 | MODISserverOrder = "NSDIC" 13 | , check_earthdata_login = FALSE 14 | ) 15 | , pattern = "Provide valid 'MODISserverOrder'" 16 | ) 17 | -------------------------------------------------------------------------------- /R/MODIS-deprecated.R: -------------------------------------------------------------------------------- 1 | #' Deprecated Functions in \pkg{MODIS} 2 | #' 3 | #' @description 4 | #' The functions listed below are deprecated and will be defunct in the near 5 | #' future. If applicable, alternative functions with similar or even identical 6 | #' functionality are mentioned. Help pages for deprecated functions are 7 | #' available at `help("MODIS-deprecated")`. 8 | #' 9 | #' * [lpdaacLogin-deprecated()]: use [EarthdataLogin] instead. 10 | #' 11 | #' @name MODIS-deprecated 12 | #' @keywords internal 13 | NULL 14 | -------------------------------------------------------------------------------- /MODIS.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: bd4d19fe-6790-4d4d-9826-bb6ccecf4f53 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | BuildType: Package 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageBuildArgs: --resave-data=best 19 | PackageCheckArgs: --as-cran --run-donttest 20 | PackageRoxygenize: rd,collate,namespace 21 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(lib, pkg) { 2 | packageStartupMessage( 3 | { 4 | jnk = suppressWarnings( 5 | suppressMessages( 6 | capture.output( 7 | MODISoptions( 8 | save = TRUE 9 | , checkTools = TRUE 10 | , quiet = TRUE 11 | , checkWriteDrivers = FALSE 12 | , ask = FALSE 13 | , check_earthdata_login = FALSE 14 | ) 15 | ) 16 | ) 17 | ) 18 | 19 | return(invisible()) 20 | } 21 | ) 22 | } 23 | 24 | -------------------------------------------------------------------------------- /R/blockSizeCluster.R: -------------------------------------------------------------------------------- 1 | blockSizeCluster <- function(x, var = 8) { 2 | # uses blockSize to get an idea of blockSize 3 | estim <- raster::blockSize(x)$nrows[1] 4 | at <- 1 5 | ind2 <- 0 6 | res <- list() 7 | while (at <= nrow(x)) { 8 | ind2 <- ind2 + 1 9 | atin <- at 10 | size <- sample(max(1, (estim-var)):(estim + var), 1) # min is 1 row 11 | at <- (at + size) 12 | if (at > nrow(x)) 13 | size <- nrow(x)-(atin-1) 14 | 15 | res[[ind2]] <- list(row=atin,nrows=size) 16 | } 17 | res <- matrix(unlist(res),byrow=T,ncol=2) 18 | res <- list(row=res[,1],nrows=res[,2],n=nrow(res)) 19 | return(res) 20 | } 21 | 22 | -------------------------------------------------------------------------------- /inst/tinytest/test-MODIScollection.R: -------------------------------------------------------------------------------- 1 | clc = MODIS:::MODIScollection 2 | 3 | ## class 4 | expect_inherits( 5 | clc 6 | , class = "data.frame" 7 | , info = "built-in collections data inherits from class 'data.frame'" 8 | ) 9 | 10 | ## `nrow()` 11 | expect_identical( 12 | nrow(clc) 13 | , target = max( 14 | apply( 15 | clc 16 | , MARGIN = 2 17 | , FUN = function(x) { 18 | sum(!is.na(x)) 19 | } 20 | ) 21 | ) 22 | , info = "`nrow()` of collections data equals product with most collections" 23 | ) 24 | 25 | ## `ncol()` 26 | expect_identical( 27 | ncol(clc) 28 | , target = nrow(MODIS::getProduct()) 29 | , info = "`ncol()` of collections data equals # of products in `getProduct()`" 30 | ) 31 | -------------------------------------------------------------------------------- /inst/tinytest/_test-genString.R: -------------------------------------------------------------------------------- 1 | wrn = getOption("warn") 2 | options("warn" = 0) 3 | 4 | expect_warning( 5 | MODIS:::genString(c("MYD15A2", "MOD15A2"), collection = "006") 6 | , info = "warning is thrown in case of 2+ products" 7 | ) 8 | expect_warning( 9 | MODIS:::genString("MOD14.*", collection = 6) # matches three products 10 | , info = "warning is thrown for pattern matching multiple products" 11 | ) 12 | 13 | fls = c( 14 | "MYD11A1.A2009001.h18v04.006.2015363221538.hdf", 15 | "MYD11A1.A2009009.h18v04.006.2015364055036.hdf", 16 | "MYD11A1.A2009017.h18v04.006.2015364115403.hdf" 17 | ) 18 | expect_warning( 19 | MODIS:::genString(fls) 20 | , info = "warning is thrown in case of 2+ files" 21 | ) 22 | 23 | options("warn" = wrn) 24 | -------------------------------------------------------------------------------- /R/checkIntegrity.R: -------------------------------------------------------------------------------- 1 | checkIntegrity = function(x, ...) { 2 | 3 | out = rep(NA, length(x)) 4 | 5 | for (i in seq_along(x)) { 6 | bsn = basename(x[i]) 7 | if (is.na(bsn) || bsn == "NA") { 8 | next 9 | } else { 10 | if (dirname(x[i]) == ".") { 11 | x[i] = paste0( 12 | genString( 13 | x = x[i] 14 | , remote = FALSE 15 | , collection = getCollection(x[i], quiet = TRUE) 16 | )$localPath 17 | , bsn 18 | ) 19 | } 20 | 21 | if (file.exists(x[i])) { 22 | out[i] = sf::gdal_utils( 23 | source = correctPath(x[i], isFile = TRUE) 24 | , quiet = TRUE 25 | ) != "" 26 | } 27 | } 28 | } 29 | 30 | return(out) 31 | } 32 | -------------------------------------------------------------------------------- /man/fileSize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fileSize.R 3 | \name{fileSize} 4 | \alias{fileSize} 5 | \title{Get Size of File(s)} 6 | \usage{ 7 | fileSize(file, units = c("B", "KB", "MB", "GB", "TB")) 8 | } 9 | \arguments{ 10 | \item{file}{\code{character} vector of file(s) with path.} 11 | 12 | \item{units}{\code{character}, defaults to \code{"B"}. Currently available options 13 | are \code{c("B", "KB", "MB", "GB", "TB")} for bites, kilo-, mega-, giga- and 14 | terabytes.} 15 | } 16 | \value{ 17 | A \code{numeric} vector of the same length as 'file' (in 'units'). Note that 18 | directories are excluded. 19 | } 20 | \description{ 21 | Get the size of any file. 22 | } 23 | \examples{ 24 | \dontrun{ 25 | fileSize(list.files("./")) 26 | } 27 | 28 | } 29 | \author{ 30 | Matteo Mattiuzzi 31 | } 32 | -------------------------------------------------------------------------------- /man/MODISextent-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa-classes.R 3 | \name{MODISextent-class} 4 | \alias{MODISextent-class} 5 | \title{Class MODISextent} 6 | \description{ 7 | An object of class \code{MODISextent}, typically created through \code{\link[=getTile]{getTile()}}. 8 | } 9 | \section{Slots}{ 10 | 11 | \describe{ 12 | \item{\code{tile}}{MODIS tile ID as \code{character}.} 13 | 14 | \item{\code{tileH}}{MODIS horizontal tile ID as \code{integer}.} 15 | 16 | \item{\code{tileV}}{MODIS vertical tile ID as \code{integer}.} 17 | 18 | \item{\code{extent}}{\code{Extent} information in \href{https://epsg.io/4326}{EPSG:4326}, see 19 | \code{\link[=getTile]{getTile()}}.} 20 | 21 | \item{\code{system}}{Sensor system as \code{character}.} 22 | 23 | \item{\code{target}}{If applicable, a \code{list} with additional target information.} 24 | }} 25 | 26 | -------------------------------------------------------------------------------- /man/MODIS-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/MODIS-deprecated.R, R/lpdaacLogin.R 3 | \name{MODIS-deprecated} 4 | \alias{MODIS-deprecated} 5 | \alias{lpdaacLogin} 6 | \title{Deprecated Functions in \pkg{MODIS}} 7 | \usage{ 8 | lpdaacLogin(server = "LPDAAC") 9 | } 10 | \description{ 11 | The functions listed below are deprecated and will be defunct in the near 12 | future. If applicable, alternative functions with similar or even identical 13 | functionality are mentioned. Help pages for deprecated functions are 14 | available at \code{help("MODIS-deprecated")}. 15 | \itemize{ 16 | \item \code{\link[=lpdaacLogin-deprecated]{lpdaacLogin-deprecated()}}: use \link{EarthdataLogin} instead. 17 | } 18 | } 19 | \section{\code{lpdaacLogin}}{ 20 | 21 | For \code{\link[=lpdaacLogin]{lpdaacLogin()}}, use \code{\link[=EarthdataLogin]{EarthdataLogin()}} instead. 22 | } 23 | 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /inst/tinytest/_test-skipDuplicateProducts.R: -------------------------------------------------------------------------------- 1 | ### . w/o pattern matching ---- 2 | 3 | expect_warning( 4 | out1 <- MODIS:::skipDuplicateProducts("MOD17A2H") 5 | , info = "product selection w/o pattern matching produces a warning" 6 | ) 7 | 8 | expect_identical( 9 | out1 10 | , target = "^MOD17A2H$" 11 | , info = "product selection w/o pattern matching skips derivatives" 12 | ) 13 | 14 | 15 | ### . w/pattern matching ---- 16 | 17 | expect_silent( 18 | out2 <- MODIS:::skipDuplicateProducts("MOD17A2H.*") 19 | , info = "product selection w/pattern matching produces no warning" 20 | ) 21 | 22 | expect_identical( 23 | out2 24 | , target = "MOD17A2H.*" 25 | , info = "product selection w/o pattern matching includes derivatives" 26 | ) 27 | 28 | expect_identical( 29 | length(getProduct(out2, quiet = TRUE)@PRODUCT) 30 | , target = length(grep(out2, MODIS:::MODIS_Products$PRODUCT)) 31 | , info = "expected number of products is returned" 32 | ) 33 | -------------------------------------------------------------------------------- /man/MODIS-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/MODIS-package.R 3 | \docType{package} 4 | \name{MODIS-package} 5 | \alias{MODIS} 6 | \alias{MODIS-package} 7 | \title{MODIS Acquisition and Processing} 8 | \description{ 9 | MODIS Acquisition and Processing 10 | } 11 | \details{ 12 | Download and processing functionality for the Moderate Resolution Imaging 13 | Spectroradiometer (MODIS). The package provides automated access to the 14 | global online data archives (LP DAAC and LAADS) and processing capabilities 15 | such as file conversion, mosaicking, subsetting and time series filtering. 16 | } 17 | \seealso{ 18 | Useful links: 19 | \itemize{ 20 | \item \url{https://github.com/fdetsch/MODIS} 21 | \item Report bugs at \url{https://github.com/fdetsch/MODIS/issues} 22 | } 23 | 24 | } 25 | \author{ 26 | Matteo Mattiuzzi, Florian Detsch 27 | \emph{Maintainer:} Florian Detsch \email{fdetsch@web.de} 28 | } 29 | \keyword{package} 30 | -------------------------------------------------------------------------------- /inst/tinytest/test-runGdal.R: -------------------------------------------------------------------------------- 1 | ## early exit: product not available from a particular server 2 | jnk = utils::capture.output( 3 | expect_error( 4 | runGdal( 5 | product = "MCD18C1" # only available on lpdaac 6 | , collection = "061" 7 | , tileH = 18L 8 | , tileV = 3L 9 | , begin = "2019.01.01" 10 | , end = "2019.12.31" 11 | , MODISserverOrder = c("LAADS", "NSIDC") 12 | ) 13 | , pattern = "is not available on .* try another server or collection" 14 | ) 15 | ) 16 | 17 | ## early exit: `length(maskValue)` not `1L` or matching 'SDSstring' 18 | jnk = utils::capture.output( 19 | expect_error( 20 | runGdal( 21 | "MCD15A2H" 22 | , collection = "061" 23 | , tileH = 21 24 | , tileV = c(7, 8) 25 | , begin = "2003001" 26 | , end = "2003010" 27 | , SDSstring = "110100" 28 | , maskValue = c(254L, 255L) 29 | , quiet = TRUE 30 | ) 31 | , pattern = "'maskValue' length needs to be 1 or match 'SDSstring'" 32 | ) 33 | ) 34 | -------------------------------------------------------------------------------- /inst/tinytest/test-extractDate.R: -------------------------------------------------------------------------------- 1 | ## standard length 2 | mod13q1 = "MOD13Q1.A2001001.h21v08.006.2015140082121.hdf" 3 | 4 | expect_equivalent( 5 | extractDate(mod13q1)$inputLayerDates 6 | , target = "2001001" 7 | , info = "position indication works for standard-length products" 8 | ) 9 | expect_equivalent( 10 | extractDate(mod13q1, asDate = TRUE)$inputLayerDates 11 | , target = as.Date("2001-01-01") 12 | , info = "if desired, 'Date' object is returned" 13 | ) 14 | 15 | ## longer than standard length 16 | mod15a2h = c("MOD15A2H.A2017001.h21v08.006.2017017150854.hdf" 17 | , "MOD15A2H.A2017001.h21v09.006.2017017150810.hdf") 18 | 19 | expect_equivalent( 20 | extractDate(mod15a2h)$inputLayerDates 21 | , target = rep("2017001", 2L) 22 | , info = "position indication works for longer than standard length products" 23 | ) 24 | 25 | ## shorter than standard length 26 | mod44b = "MOD44B.A2000065.h00v08.006.2017081101524.hdf" 27 | 28 | expect_equivalent( 29 | extractDate(mod44b)$inputLayerDates 30 | , target = "2000065" 31 | , info = "position indication works for shorter than standard length products" 32 | ) 33 | -------------------------------------------------------------------------------- /inst/tinytest/_test-getProduct.R: -------------------------------------------------------------------------------- 1 | ### available ---- 2 | 3 | expect_stdout( 4 | res1 <- getProduct( 5 | "MCD12Q1.006" 6 | ) 7 | , pattern = "^MCD12Q1 the .* product from .* with a ground resolution of" 8 | , info = "available products trigger expected message" 9 | ) 10 | 11 | expect_inherits( 12 | res1 13 | , class = "MODISproduct" 14 | , info = "output inherits from class 'MODISproduct'" 15 | ) 16 | 17 | ## multiple 18 | txt = utils::capture.output( 19 | res1.1 <- getProduct("M*D15A2H") 20 | ) 21 | 22 | lns = sapply( 23 | slotNames(res1.1)[-1] 24 | , function(i) { 25 | length(slot(res1.1, i)) 26 | } 27 | ) 28 | 29 | expect_identical( 30 | unique(lns) 31 | , target = length(txt) 32 | , info = "slot lengths are identical to the # of matching products" 33 | ) 34 | 35 | 36 | ### unavailable ---- 37 | 38 | expect_stdout( 39 | res2 <- getProduct( 40 | "MOD10_L2" 41 | ) 42 | , pattern = "No product found with the name" 43 | , info = "unavailable products trigger expected message" 44 | ) 45 | 46 | expect_null( 47 | res2 48 | , info = "`NULL` output is returned in case product is not available" 49 | ) 50 | -------------------------------------------------------------------------------- /man/preStack.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/preStack.R 3 | \name{preStack} 4 | \alias{preStack} 5 | \title{Organize (MODIS) Files in Preparation for Stacking} 6 | \usage{ 7 | preStack(pattern = "*", path = "./", files = NULL, timeInfo = NULL) 8 | } 9 | \arguments{ 10 | \item{pattern}{Regular expression passed to \code{\link[=list.files]{list.files()}}} 11 | 12 | \item{path}{\code{character}. Location of MODIS files to stack.} 13 | 14 | \item{files}{\code{character} vector of file names. If provided, arguments 15 | 'pattern' and 'path' are ignored.} 16 | 17 | \item{timeInfo}{Output from \code{\link[=orgTime]{orgTime()}}.} 18 | } 19 | \value{ 20 | A \code{character} vector of file names within the query. If 'timeInfo' is 21 | provided, file names are sorted and subsetted by date. 22 | } 23 | \description{ 24 | This function lets you sort a vector of file names according to date. It is 25 | thought to be used on results from \code{\link[=runGdal]{runGdal()}} or \code{\link[=runMrt]{runMrt()}}. 26 | } 27 | \examples{ 28 | # see Examples in ?smooth.spline.raster 29 | 30 | } 31 | \author{ 32 | Matteo Mattiuzzi 33 | } 34 | -------------------------------------------------------------------------------- /man/detectBitInfo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/detectBitInfo.R 3 | \name{detectBitInfo} 4 | \alias{detectBitInfo} 5 | \title{List MODIS Quality Information} 6 | \usage{ 7 | detectBitInfo(product, what = "all", warn = TRUE) 8 | } 9 | \arguments{ 10 | \item{product}{\code{character}, see \code{\link[=getProduct]{getProduct()}}.} 11 | 12 | \item{what}{\code{character}. Parameter name, e.g. \code{"VI Quality"} for all MOD13 13 | products (see \href{https://lpdaac.usgs.gov/documents/103/MOD13_User_Guide_V6.pdf}{MODIS Vegetation Index User's Guide}, 14 | Table 5, column "Parameter Name").} 15 | 16 | \item{warn}{\code{logical}, whether or not to throw warning messages.} 17 | } 18 | \value{ 19 | If \code{what = "all"} (default) a \code{data.frame}, else a \code{list}. 20 | } 21 | \description{ 22 | This function returns MODIS QA information for a specific product. It gets 23 | the information from an internal database and not all products are available. 24 | } 25 | \examples{ 26 | \dontrun{ 27 | detectBitInfo("MOD13Q1") 28 | detectBitInfo("MOD13Q1", "VI usefulness") 29 | 30 | detectBitInfo("MYD17A2") 31 | } 32 | 33 | } 34 | \author{ 35 | Matteo Mattiuzzi 36 | } 37 | -------------------------------------------------------------------------------- /man/getSds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getSds.R 3 | \name{getSds} 4 | \alias{getSds} 5 | \title{List SDS Layers in an HDF File} 6 | \usage{ 7 | getSds(HdfName, SDSstring = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{HdfName}{\code{character}. (Absolute) file name from which to extract SDS 11 | names. Non-existing files are being looked up recursively in 12 | \code{getOption("MODIS_localArcPath")}.} 13 | 14 | \item{SDSstring}{An optional \code{character} string of 1s and 0s, see Value.} 15 | 16 | \item{...}{Currently not used.} 17 | } 18 | \value{ 19 | A \code{list}. If 'SDSstring' is provided, the function reports matching SDS and a 20 | formatted 'SDSstring' (e.g., "1 1 1 0 1"). If omitted, the names of all SDS 21 | in 'HdfName' are returned. 22 | } 23 | \description{ 24 | List the names of all scientific data sets (SDS) contained in a specified 25 | MODIS grid HDF file. 26 | } 27 | \examples{ 28 | hdf = system.file( 29 | "external/MOD13A2.A2016145.h18v04.006.2016166145124.hdf" 30 | , package = "MODIS" 31 | ) 32 | 33 | getSds( 34 | hdf 35 | ) 36 | 37 | getSds( 38 | hdf 39 | , SDSstring = 1 40 | ) 41 | 42 | } 43 | \author{ 44 | Matteo Mattiuzzi, Florian Detsch 45 | } 46 | -------------------------------------------------------------------------------- /man/lpdaacLogin-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpdaacLogin.R 3 | \name{lpdaacLogin-deprecated} 4 | \alias{lpdaacLogin-deprecated} 5 | \title{Create File with Earthdata Login Credentials} 6 | \usage{ 7 | lpdaacLogin(server = "LPDAAC") 8 | } 9 | \arguments{ 10 | \item{server}{\code{character}. MODIS file server, defaults to \code{"LPDAAC"} which is 11 | currently the only option available.} 12 | } 13 | \value{ 14 | Invisible. 15 | } 16 | \description{ 17 | Create a hidden .netrc file with Earthdata Login credentials in your home 18 | directory. If your priority server for MODIS file download is LP DAAC (see 19 | also \code{\link[=MODISoptions]{MODISoptions()}}), these are subsequently used to automatically login to 20 | \url{https://urs.earthdata.nasa.gov/} and download required files. 21 | } 22 | \examples{ 23 | \dontrun{ 24 | lpdaacLogin() 25 | } 26 | 27 | } 28 | \seealso{ 29 | \itemize{ 30 | \item \url{https://docs.opendap.org/index.php/DAP_Clients_-_Authentication#LDAP} 31 | (section 2.2) 32 | \item \url{https://github.com/fdetsch/MODIS/issues/10} 33 | } 34 | 35 | \link{MODIS-deprecated} 36 | } 37 | \author{ 38 | Matteo Mattiuzzi and Florian Detsch 39 | } 40 | \keyword{internal} 41 | -------------------------------------------------------------------------------- /R/fileSize.R: -------------------------------------------------------------------------------- 1 | #' Get Size of File(s) 2 | #' 3 | #' @description 4 | #' Get the size of any file. 5 | #' 6 | #' @param file `character` vector of file(s) with path. 7 | #' @param units `character`, defaults to `"B"`. Currently available options 8 | #' are `c("B", "KB", "MB", "GB", "TB")` for bites, kilo-, mega-, giga- and 9 | #' terabytes. 10 | #' 11 | #' @return 12 | #' A `numeric` vector of the same length as 'file' (in 'units'). Note that 13 | #' directories are excluded. 14 | #' 15 | #' @author 16 | #' Matteo Mattiuzzi 17 | #' 18 | #' @examples 19 | #' \dontrun{ 20 | #' fileSize(list.files("./")) 21 | #' } 22 | #' 23 | #' @export fileSize 24 | #' @name fileSize 25 | fileSize <- function( 26 | file 27 | , units = c("B", "KB", "MB", "GB", "TB") 28 | ) { 29 | 30 | units = match.arg( 31 | units 32 | ) 33 | 34 | units <- toupper(units) 35 | unit <- c(1,1024,1048576,1073741824,1073741824*1024) 36 | names(unit) <- c("B","KB", "MB", "GB","TB") 37 | 38 | if (!units %in% names(unit)) { 39 | stop('unit must be one of: "B", "KB", "MB", "GB" or "TB"') 40 | } 41 | 42 | file <- file.info(file) 43 | file <- file[!file$isdir,"size"] 44 | 45 | res <- file/unit[toupper(units)] 46 | return(res) 47 | } 48 | -------------------------------------------------------------------------------- /R/MODIS-package.R: -------------------------------------------------------------------------------- 1 | #' MODIS Acquisition and Processing 2 | #' 3 | #' Download and processing functionality for the Moderate Resolution Imaging 4 | #' Spectroradiometer (MODIS). The package provides automated access to the 5 | #' global online data archives (LP DAAC and LAADS) and processing capabilities 6 | #' such as file conversion, mosaicking, subsetting and time series filtering. 7 | #' 8 | #' @name MODIS-package 9 | #' @title MODIS Acquisition and Processing 10 | #' @author Matteo Mattiuzzi, Florian Detsch 11 | #' \emph{Maintainer:} Florian Detsch \email{fdetsch@@web.de} 12 | #' 13 | #' @import bitops mapdata parallel ptw raster sf sp 14 | #' @importFrom curl curl curl_download handle_setopt new_handle 15 | #' @importFrom devtools install_github 16 | #' @importFrom grDevices dev.new dev.off png 17 | #' @importFrom graphics abline box grid locator title 18 | #' @importFrom mapedit drawFeatures selectFeatures 19 | #' @importFrom maps map.axes 20 | #' @importFrom methods as new slot 21 | #' @importFrom stats na.omit setNames smooth.spline 22 | #' @importFrom utils capture.output download.file installed.packages read.csv read.table vi write.csv write.table 23 | #' @rawNamespace if (.Platform$OS.type=="windows") importFrom(utils,shortPathName) 24 | #' 25 | #' @keywords package 26 | #' 27 | "_PACKAGE" 28 | 29 | NULL 30 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: MODIS 2 | Title: Acquisition and Processing of MODIS Products 3 | Version: 1.2.13 4 | URL: https://github.com/fdetsch/MODIS 5 | BugReports: https://github.com/fdetsch/MODIS/issues 6 | Authors@R: c( 7 | person("Matteo", "Mattiuzzi", role = "aut", email = "matteo@mattiuzzi.com"), 8 | person("Florian", "Detsch", role = c("cre", "aut"), email = "fdetsch@web.de")) 9 | Description: Download and processing functionality for the Moderate Resolution 10 | Imaging Spectroradiometer (MODIS). The package provides automated access to the 11 | global online data archives LP DAAC 12 | (), LAADS 13 | () and NSIDC 14 | () as well as processing capabilities such as file 15 | conversion, mosaicking, subsetting and time series filtering. 16 | License: MIT + file LICENSE 17 | Depends: 18 | mapdata, 19 | R (>= 3.5.0), 20 | raster 21 | Imports: 22 | bitops, 23 | curl, 24 | devtools, 25 | grDevices, 26 | graphics, 27 | mapedit, 28 | maps, 29 | methods, 30 | parallel, 31 | ptw, 32 | sf, 33 | sp, 34 | stats, 35 | utils 36 | ByteCompile: TRUE 37 | Encoding: UTF-8 38 | Roxygen: list(markdown = TRUE) 39 | RoxygenNote: 7.3.2 40 | Suggests: tinytest 41 | -------------------------------------------------------------------------------- /man/MODISproduct-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa-classes.R 3 | \name{MODISproduct-class} 4 | \alias{MODISproduct-class} 5 | \title{Class MODISproduct} 6 | \description{ 7 | An object of class \code{MODISproduct}, typically created through \code{\link[=getProduct]{getProduct()}} 8 | when the 'x' input is a MODIS product or regular expression. 9 | } 10 | \section{Slots}{ 11 | 12 | \describe{ 13 | \item{\code{request}}{User request as \code{character}.} 14 | 15 | \item{\code{PF1,PF2,PF3,PF4}}{Platform specific path feature for LP DAAC, LAADS, NTSG 16 | and NSIDC as \code{character}.} 17 | 18 | \item{\code{PD}}{Product specific code number following the platform specifier, e.g. 19 | \code{"13A1"} for MOD13A1.} 20 | 21 | \item{\code{PLATFORM}}{Satellite platform on which MODIS sensor is mounted; one of 22 | \code{c("Terra", "Aqua")}.} 23 | 24 | \item{\code{TYPE}}{Product type; one of \code{c("Tile", "CMG", "Swath")}.} 25 | 26 | \item{\code{PRODUCT}}{MODIS product identified from 'request' as \code{character}.} 27 | 28 | \item{\code{SENSOR}}{Statically set to \code{"MODIS"}.} 29 | 30 | \item{\code{SOURCE}}{Product specific MODIS download server(s) as named \code{list}.} 31 | 32 | \item{\code{CCC}}{Product specific MODIS data collection(s) stored as 3-digit 33 | \code{character} objects in a named \code{list}.} 34 | }} 35 | 36 | -------------------------------------------------------------------------------- /man/transDate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/transDate.R 3 | \name{transDate} 4 | \alias{transDate} 5 | \title{MODIS Date Conversion and Testing} 6 | \usage{ 7 | transDate(begin = NULL, end = NULL) 8 | } 9 | \arguments{ 10 | \item{begin, end}{\code{Date} or \code{character}. Begin and end date of MODIS time 11 | series, see Note. If not provided, this defaults to \code{"1972-01-01"} and 12 | \code{\link[=Sys.Date]{Sys.Date()}}, respectively.} 13 | } 14 | \value{ 15 | A \code{list} of begin and end dates formatted according to 'YYYY-MM-DD' (first 16 | two slots; class \code{Date}) and 'YYYYDDD' (second two slots; class \code{character}). 17 | } 18 | \description{ 19 | This function converts a sequence of input dates to 'YYYY-MM-DD' and 20 | 'YYYYDDD'. 21 | } 22 | \note{ 23 | If input dates are supplied as \code{character}, this function either expects 24 | 7-digit strings in the MODIS intrinsic form \code{'\\\%Y\\\%j'} or, alternatively, 25 | 10-digit strings in the form \code{'\\\%Y-\\\%m-\\\%d'} where the two field separators 26 | need to be uniform (see Examples). 27 | } 28 | \examples{ 29 | transDate() 30 | transDate(begin = "2009.01.01") # ends with current date 31 | transDate(end = "2009.01.01") # starts with Landsat 1 32 | transDate(begin = c("2009-01-01", "2010-01-01"), end = "2011.03.16") 33 | 34 | } 35 | \seealso{ 36 | \code{\link[=strptime]{strptime()}}. 37 | } 38 | \author{ 39 | Matteo Mattiuzzi, Florian Detsch 40 | } 41 | -------------------------------------------------------------------------------- /R/lpdaacLogin.R: -------------------------------------------------------------------------------- 1 | #' Create File with Earthdata Login Credentials 2 | #' 3 | #' @description 4 | #' Create a hidden .netrc file with Earthdata Login credentials in your home 5 | #' directory. If your priority server for MODIS file download is LP DAAC (see 6 | #' also [MODISoptions()]), these are subsequently used to automatically login to 7 | #' and download required files. 8 | #' 9 | #' @param server `character`. MODIS file server, defaults to `"LPDAAC"` which is 10 | #' currently the only option available. 11 | #' 12 | #' @return 13 | #' Invisible. 14 | #' 15 | #' @author 16 | #' Matteo Mattiuzzi and Florian Detsch 17 | #' 18 | #' @seealso 19 | #' * 20 | #' (section 2.2) 21 | #' * 22 | #' 23 | #' @examples 24 | #' \dontrun{ 25 | #' lpdaacLogin() 26 | #' } 27 | #' 28 | #' @name lpdaacLogin-deprecated 29 | #' @usage lpdaacLogin(server = "LPDAAC") 30 | #' @seealso [MODIS-deprecated] 31 | #' @keywords internal 32 | NULL 33 | 34 | #' @rdname MODIS-deprecated 35 | #' @section `lpdaacLogin`: 36 | #' For [lpdaacLogin()], use [EarthdataLogin()] instead. 37 | #' 38 | #' @export 39 | lpdaacLogin <- function(server = "LPDAAC") { 40 | 41 | .Deprecated("EarthdataLogin") 42 | 43 | #server = ifelse(server %in% c("LPDAAC", "LAADS"), "Earthdata", server) 44 | #return(EarthdataLogin(service = server)) 45 | return(EarthdataLogin()) 46 | } 47 | -------------------------------------------------------------------------------- /man/minorFuns.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/minorFuns.R 3 | \name{minorFuns} 4 | \alias{minorFuns} 5 | \alias{search4map} 6 | \title{Minor MODIS Package Functions} 7 | \usage{ 8 | search4map(pattern = "", database = "worldHires", plot = FALSE) 9 | } 10 | \arguments{ 11 | \item{pattern}{Regular expression passed to \code{\link[=grep]{grep()}}.} 12 | 13 | \item{database}{\code{character}. Defaults to \code{"worldHires"}, see \code{\link[maps:map]{maps::map()}} 14 | for available options.} 15 | 16 | \item{plot}{\code{logical}, defaults to \code{FALSE}. If \code{TRUE}, search results are 17 | displayed.} 18 | } 19 | \value{ 20 | A \code{list} of length 2. The first entry is the call to create the given 21 | map, whereas the second entry represents the names of areas within the 22 | search. 23 | } 24 | \description{ 25 | Compendium of minor \strong{MODIS} package-related functions. 26 | } 27 | \section{Functions}{ 28 | \itemize{ 29 | \item \code{search4map()}: Simplifies search for \strong{mapdata}-based extents 30 | 31 | }} 32 | \examples{ 33 | \donttest{ 34 | search4map() 35 | 36 | search4map(pattern="USA",plot=TRUE) 37 | search4map(database="state",plot=TRUE) 38 | 39 | search4map(database="italy",pattern="Bolz",plot=TRUE) 40 | 41 | search4map(pattern="Sicily",plot=TRUE) 42 | } 43 | 44 | } 45 | \seealso{ 46 | \code{\link[=getTile]{getTile()}}, \code{\link[maps:map]{maps::map()}}, \code{\link[=grep]{grep()}}. 47 | } 48 | \author{ 49 | Matteo Mattiuzzi 50 | } 51 | -------------------------------------------------------------------------------- /man/genTile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/genTile.R 3 | \name{genTile} 4 | \alias{genTile} 5 | \title{Generate Global Tiling System} 6 | \usage{ 7 | genTile( 8 | tileSize = 1, 9 | offset = 0, 10 | StartNameFrom = c(0, 0), 11 | extent = list(xmin = -180, xmax = 180, ymin = -90, ymax = 90) 12 | ) 13 | } 14 | \arguments{ 15 | \item{tileSize}{\code{numeric}, size of a single tile in degrees (EPSG:4326).} 16 | 17 | \item{offset}{\code{numeric}, shifts the tiling system in upper-left direction.} 18 | 19 | \item{StartNameFrom}{\code{numeric}. \code{c(Lat-Direction,Lon-Direction)} start number 20 | in the naming of the tiles.} 21 | 22 | \item{extent}{\code{list}. Tile system extent information, basically the coverage 23 | of the data on server.} 24 | } 25 | \value{ 26 | A \code{matrix}. 27 | } 28 | \description{ 29 | This function generates a matrix with bounding box information for a global 30 | tiling system (based on Lat/Lon). 31 | } 32 | \examples{ 33 | # 1x1 degree tiling system 34 | e1 <- genTile() 35 | head(e1) 36 | 37 | # 10x10 degree tiling system with offset to be aligned to Geoland2 Dataset 38 | e2 <- genTile(tileSize = 10, offset = (1/112) / 2) 39 | head(e2) 40 | 41 | # Tiling system for SRTMv4 data (CGIAR-CSI) 42 | e3 <- genTile(tileSize = 5, StartNameFrom = c(1, 1), 43 | extent = list(xmin = -180, xmax = 180, ymin = -60,ymax = 60)) 44 | head(e3) 45 | 46 | } 47 | \seealso{ 48 | \code{\link[=getTile]{getTile()}}. 49 | } 50 | \author{ 51 | Matteo Mattiuzzi 52 | } 53 | -------------------------------------------------------------------------------- /inst/tinytest/test-minorFuns.R: -------------------------------------------------------------------------------- 1 | ### . getExtension ---- 2 | 3 | xtn0 = Map( 4 | MODIS:::getExtension 5 | , c("GTiff", "HDF4Image", "ENVI", "raw binary") 6 | ) 7 | 8 | expect_true( 9 | all( 10 | unlist(xtn0) == c(".tif", ".hdf", "", ".hdr") 11 | ) 12 | , info = "important format extensions are correct" 13 | ) 14 | 15 | 16 | ### `fixOrphanedHoles()` ---- 17 | 18 | ## example polygon taken from `?sf::st_make_valid` 19 | p = sf::st_as_sfc("POLYGON((0 0, 0 10, 10 0, 10 10, 0 0))") 20 | 21 | expect_false( 22 | sf::st_is_valid(p) 23 | , info = "created geometry is definitively invalid" 24 | ) 25 | 26 | pr = MODIS:::fixOrphanedHoles(p) 27 | 28 | expect_true( 29 | sf::st_is_valid(pr) 30 | , info = "fixed invalid geometry" 31 | ) 32 | 33 | expect_identical( 34 | MODIS:::fixOrphanedHoles(pr) 35 | , target = pr 36 | , info = "valid geometries are returned unmodified" 37 | ) 38 | 39 | ## fixable on plane, but not on sphere (see 40 | ## https://github.com/r-spatial/sf/issues/1732) 41 | if (require(mapdata, quietly = TRUE)) { 42 | 43 | uses_s2 = sf::sf_use_s2() 44 | 45 | library(mapdata) 46 | 47 | m1 = maps::map("worldHires", "Spain", plot = FALSE, fill = TRUE) 48 | p1 = sf::st_as_sf(m1) 49 | 50 | pr1 = MODIS:::fixOrphanedHoles(p1) 51 | 52 | expect_true( 53 | sf::st_is_valid(pr1) 54 | , info = "fixed geometry that can only be valid on plane" 55 | ) 56 | 57 | expect_identical( 58 | sf::sf_use_s2() 59 | , target = uses_s2 60 | , info = "output of `sf::sf_use_s2()` is same as before" 61 | ) 62 | } 63 | 64 | -------------------------------------------------------------------------------- /R/getPart.R: -------------------------------------------------------------------------------- 1 | # Author: Matteo Mattiuzzi, matteo.mattiuzzi@boku.ac.at 2 | # Date : February 2012 3 | 4 | ################################ 5 | # getPart() takes as argument ONLY a defineName() or a getProduct() result, or basicaly a vector with named "nodes" 6 | ################################ 7 | getPart <- function(x, what = c('YYYY', 'DDD', 'DATE', 'SENSOR', 'PF1', 'PF2' 8 | , 'PF3', 'PF4', 'PLATFORM', 'TILE', 'TILEV', 'TILEH' 9 | , 'C', 'CCC', 'PRODUCT', 'FORMAT', 'COMPRESSION' 10 | , 'DATE1DATE2', 'PROCESSINGDATE', 'REGION' 11 | , 'TIME')) 12 | { 13 | if (missing(x)){ 14 | return(cat("Available 'placeholders' are:",what,"\n",sep=" ")) 15 | } 16 | 17 | what <- match.arg(what) 18 | switch(what, 19 | YYYY = substring(x@DATE,2,5), # works with AYYYYDDD input # TODO a scanning function to detect teh first numeric value in date 20 | DDD = substring(x@DATE,6,8), # works with AYYYYDDD input 21 | DATE = gsub(transDate(begin=substring(x@DATE,2,8))$begin,pattern="-",replacement="."), # works with AYYYYDDD input 22 | PF1 = x@PF1, 23 | PF2 = x@PF2, 24 | PF3 = x@PF3, 25 | PF4 = x@PF4, 26 | PLATFORM = x@PLATFORM, 27 | TILE = x@TILE, 28 | C = as.numeric(x@CCC), 29 | CCC = x@CCC, 30 | PRODUCT = x@PRODUCT, 31 | SENSOR = x@SENSOR, 32 | FORMAT = x@FORMAT, 33 | PROCESSINGDATE = x@PROCESSINGDATE, 34 | ) 35 | } 36 | 37 | -------------------------------------------------------------------------------- /man/EarthdataLogin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/EarthdataLogin.R 3 | \name{EarthdataLogin} 4 | \alias{EarthdataLogin} 5 | \title{Create File with Earthdata Login Credentials} 6 | \usage{ 7 | EarthdataLogin(usr = NULL, pwd = NULL, path = "~/.netrc") 8 | } 9 | \arguments{ 10 | \item{usr, pwd}{Login credentials as \code{character}. If \code{NULL}, username and 11 | password are read from the terminal.} 12 | 13 | \item{path}{Path to hidden \code{.netrc} file as \code{character}. The default should 14 | not be changed unless for a good reason.} 15 | } 16 | \value{ 17 | The Earthdata Login credentials as invisible \code{list}. 18 | } 19 | \description{ 20 | Create a hidden \code{.netrc} file with Earthdata Login credentials in your home 21 | directory. The information included therein is used to login to 22 | \url{https://urs.earthdata.nasa.gov/} which is a mandatory requirement in order 23 | to download MODIS data from LP DAAC, LAADS and NSIDC (see also 24 | \code{\link[=MODISoptions]{MODISoptions()}}). If the \code{.netrc} file already exist, the function can be 25 | used to re-enter credentials. 26 | } 27 | \examples{ 28 | \dontrun{ 29 | EarthdataLogin() 30 | } 31 | 32 | } 33 | \seealso{ 34 | \itemize{ 35 | \item \url{https://docs.opendap.org/index.php/DAP_Clients_-_Authentication#LDAP} 36 | (section 2.2) 37 | \item \url{https://github.com/fdetsch/MODIS/issues/10} 38 | \item \url{https://wiki.earthdata.nasa.gov/display/EL/How+To+Access+Data+With+cURL+And+Wget} 39 | } 40 | } 41 | \author{ 42 | Matteo Mattiuzzi and Florian Detsch 43 | } 44 | -------------------------------------------------------------------------------- /man/reformatDOY.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reformatDOY.R 3 | \name{reformatDOY} 4 | \alias{reformatDOY} 5 | \title{Reformat MODIS "composite_day_of_the_year" SDS} 6 | \usage{ 7 | reformatDOY(x, cores = 1L, ...) 8 | } 9 | \arguments{ 10 | \item{x}{\code{character} or \verb{Raster*}. MODIS "composite_day_of_the_year" 11 | layer(s).} 12 | 13 | \item{cores}{\code{integer}. Number of cores for parallel processing.} 14 | 15 | \item{...}{Additional arguments passed to \code{\link[=extractDate]{extractDate()}}.} 16 | } 17 | \value{ 18 | A \verb{Raster*} object. 19 | } 20 | \description{ 21 | In order to create custom temporal aggregation levels (e.g., half-monthly, 22 | monthly) from native 16-day MODIS composites, a convenient representation of 23 | the pixel-wise acquisition date is urgently required. Since the MODIS 24 | "composite_day_of_the_year" SDS merely includes the day of the year (DOY), 25 | but not the year itself, this function creates complete date information from 26 | both the respective MODIS layer name and the pixel-wise DOY information. 27 | } 28 | \examples{ 29 | \dontrun{ 30 | tfs = runGdal("MOD13Q1", collection = "006", 31 | begin = "2000353", end = "2000366", extent = "Luxembourg", 32 | job = "reformatDOY", SDSstring = "000000000010") 33 | 34 | ## raw doy 35 | raw <- raster(unlist(tfs)) 36 | unique(raw[]) 37 | 38 | ## reformatted dates 39 | rfm <- reformatDOY(raw) 40 | unique(rfm[]) 41 | } 42 | 43 | } 44 | \seealso{ 45 | \code{\link[=repDoy]{repDoy()}}. 46 | } 47 | \author{ 48 | Florian Detsch 49 | } 50 | -------------------------------------------------------------------------------- /R/checkUtils.R: -------------------------------------------------------------------------------- 1 | checkEarthdataLogin = function( 2 | method = "auto" 3 | , path = "~/.netrc" 4 | ) { 5 | 6 | ## construct online file paths 7 | remote_urls = genString( 8 | "MCD64A1" 9 | , collection = "061" 10 | , date = "2019-12-01" 11 | )$remotePath 12 | 13 | ## cycle through download servers 14 | for (remote_url in remote_urls) { 15 | 16 | # try to download file from current server 17 | con = try( 18 | downloadFile( 19 | url = file.path( 20 | remote_url 21 | , "MCD64A1.A2019335.h32v11.061.2021309110404.hdf" 22 | ) 23 | , destfile = tempfile(fileext = ".hdf") 24 | , method = method 25 | , path = path 26 | , quiet = TRUE 27 | ) 28 | , silent = TRUE 29 | ) 30 | 31 | # exit if download succeeded 32 | if (!inherits(con, "try-error")) { 33 | break 34 | } 35 | } 36 | 37 | ## return if download succeeded 38 | if (inherits(con, "try-error")) { 39 | msg = if (grepl("401", con)) { 40 | sprintf( 41 | paste( 42 | "Please check your Earthdata credentials in %s" 43 | , "or re-enter via `EarthdataLogin()`." 44 | ) 45 | , path 46 | ) 47 | } 48 | 49 | warning( 50 | gsub( 51 | "\n$" 52 | , "" 53 | , paste0( 54 | "Authentication failed with\n> " 55 | , tail(unlist(strsplit(as.character(con), split = "\\s+:\\s*")), 1L) 56 | , msg 57 | ) 58 | ) 59 | , call. = FALSE 60 | ) 61 | 62 | FALSE 63 | } else { 64 | TRUE 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /man/getProduct.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getProduct.R 3 | \name{getProduct} 4 | \alias{getProduct} 5 | \title{Check and Create Product-Related Information} 6 | \usage{ 7 | getProduct(x = NULL, quiet = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{\code{character}. MODIS file name, product name, regular expression 11 | passed as pattern to \code{\link[=grep]{grep()}}, or missing. Use dot notation to address 12 | Terra and Aqua products at the same time, e.g. \code{"M.D13Q1"}.} 13 | 14 | \item{quiet}{\code{logical}, defaults to \code{FALSE}.} 15 | 16 | \item{...}{Additional arguments passed to \code{\link[=getCollection]{getCollection()}}.} 17 | } 18 | \value{ 19 | If 'x' is missing, a \code{data.frame} with information about all MODIS products 20 | available. In case of \code{character} input, an invisible \linkS4class{MODISproduct} or 21 | \linkS4class{MODISfile} object depending on the type of input (product, regular 22 | expression or file name); the object holds information usable by other 23 | functions. 24 | } 25 | \description{ 26 | On user side, it is a function to find the desired product. On package site, 27 | it generates central internal information to handle files. 28 | } 29 | \examples{ 30 | getProduct() # list available products 31 | 32 | # or use regular expression style 33 | getProduct("M.D11C3") 34 | getProduct("M*D11C") 35 | 36 | # or get information about specific product 37 | internal_info <- getProduct("MOD11C3", quiet = TRUE) 38 | internal_info 39 | 40 | # or use a valid filename 41 | fileinfo <- getProduct("MYD11A1.A2009001.h18v04.006.2015363221538.hdf") 42 | fileinfo 43 | 44 | } 45 | \author{ 46 | Matteo Mattiuzzi and Florian Detsch 47 | } 48 | -------------------------------------------------------------------------------- /man/MODISfile-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa-classes.R 3 | \name{MODISfile-class} 4 | \alias{MODISfile-class} 5 | \title{Class MODISfile} 6 | \description{ 7 | An object of class \code{MODISfile}, typically created through \code{\link[=getProduct]{getProduct()}} when 8 | the 'x' input is a MODIS filename. 9 | } 10 | \section{Slots}{ 11 | 12 | \describe{ 13 | \item{\code{request}}{User request as \code{character}.} 14 | 15 | \item{\code{PRODUCT}}{MODIS product identified from 'request' as \code{character}.} 16 | 17 | \item{\code{DATE}}{Acquisition date string in the form \code{"A\\\%Y\\\%j"} (see \code{\link[=strptime]{strptime()}} 18 | and \href{https://modis-images.gsfc.nasa.gov/MOD07_L2/filename.html}{HDF filename convention}.} 19 | 20 | \item{\code{TILE}}{Tile string in the form \code{"hXXvXX"}.} 21 | 22 | \item{\code{CCC}}{MODIS data collection as 3-digit \code{character}.} 23 | 24 | \item{\code{PROCESSINGDATE}}{Processing date string in the form \code{"\\\%Y\\\%j\\\%H\\\%M\\\%S"} 25 | (see \code{\link[=strptime]{strptime()}}).} 26 | 27 | \item{\code{FORMAT}}{File format as \code{character}.} 28 | 29 | \item{\code{SENSOR}}{Statically set to \code{"MODIS"}.} 30 | 31 | \item{\code{PLATFORM}}{Satellite platform on which MODIS sensor is mounted; one of 32 | \code{c("Terra", "Aqua")}.} 33 | 34 | \item{\code{PF1,PF2,PF3,PF4}}{Platform specific path feature for LP DAAC, LAADS, NTSG 35 | and NSIDC as \code{character}.} 36 | 37 | \item{\code{TOPIC}}{Product topic as \code{character}.} 38 | 39 | \item{\code{TYPE}}{Product type; one of \code{c("Tile", "CMG", "Swath")}.} 40 | 41 | \item{\code{SOURCE}}{Product specific MODIS download server(s) as named \code{list}.} 42 | 43 | \item{\code{POS1,POS2}}{Default start and end index of date string in MODIS filename, 44 | usually \code{c("10", "16")}.} 45 | }} 46 | 47 | -------------------------------------------------------------------------------- /man/delHdf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/delHdf.R 3 | \name{delHdf} 4 | \alias{delHdf} 5 | \title{Delete Local MODIS Grid Files} 6 | \usage{ 7 | delHdf( 8 | product, 9 | collection = NULL, 10 | extent = "global", 11 | tileV = NULL, 12 | tileH = NULL, 13 | begin = NULL, 14 | end = NULL, 15 | ask = TRUE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{product}{\code{character}, see \code{\link[=getProduct]{getProduct()}}.} 21 | 22 | \item{collection}{\code{character} or \code{integer}, see \code{\link[=getCollection]{getCollection()}}.} 23 | 24 | \item{extent}{Extent information, defaults to \code{"global"}. See \code{\link[=getTile]{getTile()}}.} 25 | 26 | \item{tileH, tileV}{\code{numeric} or \code{character}. Horizontal and vertical tile 27 | number, see \code{\link[=getTile]{getTile()}}.} 28 | 29 | \item{begin, end}{\code{Date} or \code{character}. Begin and end date of MODIS time 30 | series, see \code{\link[=transDate]{transDate()}}.} 31 | 32 | \item{ask}{\code{logical}. If \code{TRUE} (default), the user is being asked for 33 | deletion after checking.} 34 | 35 | \item{...}{Arguments passed to \code{\link[=MODISoptions]{MODISoptions()}}, particularly 'localArcPath'.} 36 | } 37 | \description{ 38 | Delete MODIS grid files to reduce the local storage. 39 | } 40 | \examples{ 41 | \dontrun{ 42 | # REMOVE "MYD11A2" from specific date range and area subset: 43 | # delHdf(product="MYD11A2",begin="2010001",end="2010.02.01",extent="austria") 44 | # or 45 | # delHdf(product="MYD11A2",begin="2010001",end="2010.02.01",tileV=18:19,tileH=4) 46 | 47 | # REMOVE "MOD11A2" and "MYD11A2" from specific date range but globaly: 48 | # delHdf(product="M.D11A2",begin="2010001",end="2010.02.01") 49 | 50 | # REMOVE ALL "MOD11A2" from local archive: 51 | # delHdf(product="MOD11A2") 52 | } 53 | 54 | } 55 | \author{ 56 | Matteo Mattiuzzi 57 | } 58 | -------------------------------------------------------------------------------- /R/preStack.R: -------------------------------------------------------------------------------- 1 | #' Organize (MODIS) Files in Preparation for Stacking 2 | #' 3 | #' @description 4 | #' This function lets you sort a vector of file names according to date. It is 5 | #' thought to be used on results from [runGdal()] or [runMrt()]. 6 | #' 7 | #' @param pattern Regular expression passed to [list.files()] 8 | #' @param path `character`. Location of MODIS files to stack. 9 | #' @param files `character` vector of file names. If provided, arguments 10 | #' 'pattern' and 'path' are ignored. 11 | #' @param timeInfo Output from [orgTime()]. 12 | #' 13 | #' @return 14 | #' A `character` vector of file names within the query. If 'timeInfo' is 15 | #' provided, file names are sorted and subsetted by date. 16 | #' 17 | #' @author 18 | #' Matteo Mattiuzzi 19 | #' 20 | #' @examples 21 | #' # see Examples in ?smooth.spline.raster 22 | #' 23 | #' @export preStack 24 | #' @name preStack 25 | preStack <- function(pattern = "*", path = "./", files = NULL, timeInfo = NULL) 26 | { 27 | if (is.null(files)) 28 | { 29 | fnames <- list.files( path = path, pattern = pattern, full.names = TRUE) 30 | } else 31 | { 32 | fnames <- files 33 | } 34 | 35 | if (length(fnames) == 0) 36 | { 37 | cat("No files found!\n") ; return(NULL) 38 | } 39 | 40 | if (!is.null(timeInfo)) 41 | { 42 | avDates <- extractDate( basename(fnames), pos1 = timeInfo$call$pos1, pos2 = timeInfo$call$pos2, format = timeInfo$call$format, asDate = TRUE) 43 | fnames <- fnames[ order(avDates$inputLayerDates) ] 44 | avDates <- sort(avDates$inputLayerDates) 45 | begin <- min(timeInfo$inputLayerDates) 46 | end <- max(timeInfo$inputLayerDates) 47 | fnames <- fnames[avDates >= begin & avDates <= end] 48 | } 49 | 50 | cat("Found", length(fnames), "files!\n") 51 | if ( length(fnames) == 0 ) ( return(NULL) ) 52 | 53 | return(fnames) 54 | } 55 | -------------------------------------------------------------------------------- /man/extractDate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extractDate.R 3 | \name{extractDate} 4 | \alias{extractDate} 5 | \title{Extract Dates from (MODIS) Files} 6 | \usage{ 7 | extractDate(files, pos1, pos2, asDate = FALSE, format = "\%Y\%j") 8 | } 9 | \arguments{ 10 | \item{files}{A \code{character} vector of filenames from which to extract dates. 11 | Alternatively, a \verb{Raster*} with date information in its \code{\link[raster:names]{raster::names()}}.} 12 | 13 | \item{pos1, pos2}{Start and end of date string in 'files' as \code{integer}. If 14 | missing, attempts to retrieve positions from a look-up table provided that 15 | 'files' comply with the MODIS standard naming convention.} 16 | 17 | \item{asDate}{\code{logical}. If \code{TRUE}, the result is converted to a \code{Date} 18 | object.} 19 | 20 | \item{format}{\code{character}, date format. Used only if \code{asDate = TRUE}. 21 | Defaults to MODIS date style (i.e., \code{"\\\%Y\\\%j"} for year and Julian day). 22 | See \code{\link[=strptime]{strptime()}} for modifications.} 23 | } 24 | \value{ 25 | A \code{list} with the following entries: 'inputLayerDates', 'pos1', 'pos2', 26 | 'asDate' and, optionally, 'format'. If \code{asDate = FALSE} (default), 27 | 'inputLayerDates' are represented as \code{character}, else as \code{Date}. 28 | } 29 | \description{ 30 | This function helps to extract dates from a vector of files. 31 | } 32 | \examples{ 33 | # example on HDF files 34 | files <- c("MOD13Q1.A2010209.h18v03.005.2010239071130.hdf", 35 | "MOD13Q1.A2010225.h18v03.005.2010254043849.hdf") 36 | extractDate(files) 37 | extractDate(files, asDate = TRUE) 38 | 39 | # on any other file 40 | files <- c("Myfile_20010101.XXX", "Myfile_20010115.XXX", "Myfile_20010204.XXX") 41 | extractDate(files, pos1 = 8, pos2 = 15) 42 | extractDate(files, pos1 = 8, pos2 = 15, asDate = TRUE, format = "\%Y\%m\%d") 43 | 44 | } 45 | \author{ 46 | Matteo Mattiuzzi 47 | } 48 | -------------------------------------------------------------------------------- /inst/tinytest/_test-runGdal.R: -------------------------------------------------------------------------------- 1 | lap = file.path(tempdir(), "MODIS_ARC") 2 | odp = file.path(lap, "PROCESSED") 3 | jnk = capture.output( 4 | suppressMessages( 5 | MODISoptions(localArcPath = lap, outDirPath = odp 6 | , save = FALSE, quiet = TRUE, checkTools = FALSE) 7 | ) 8 | ) 9 | 10 | jnk = capture.output( 11 | orgStruc(system.file("external", package = "MODIS") 12 | , pattern = "^MOD13A2.A2016145.h18v04.006.2016166145124.hdf$" 13 | , quiet = TRUE) 14 | ) 15 | 16 | 17 | ### 0 default settings ---- 18 | 19 | jnk = capture.output( 20 | tfs0 <- runGdal("MOD13A2", collection = "006" 21 | , begin = "2016145", end = "2016145" 22 | , tileH = 18, tileV = 4 23 | , SDSstring = "111", job = "test-runGdal" 24 | , checkIntegrity = FALSE, forceDownload = FALSE 25 | , overwrite = TRUE) 26 | ) 27 | 28 | rst0 = raster::stack(unlist(tfs0)) 29 | 30 | expect_equivalent( 31 | dim(rst0) 32 | , target = c(1200, 1410, 3) 33 | , info = "default output has expected dimensions (# rows, cols, layers)" 34 | ) 35 | 36 | 37 | ### 1 custom settings ---- 38 | 39 | jnk = capture.output( 40 | tfs1 <- runGdal( 41 | "MOD13A2", collection = "006" 42 | , begin = "2016145", end = "2016145" 43 | , tileH = 18, tileV = 4 44 | , SDSstring = "1", job = "test-runGdal" 45 | , outProj = 32632, pixelSize = 1000 46 | , checkIntegrity = FALSE, forceDownload = FALSE 47 | , overwrite = TRUE 48 | ) 49 | ) 50 | 51 | rst1 = raster::stack(unlist(tfs1)) 52 | 53 | expect_true( 54 | raster::nlayers(rst1) == 1 55 | , info = "customized output has expected # layers" 56 | ) 57 | 58 | expect_equivalent( 59 | raster::res(rst1) 60 | , target = c(1000, 1000) 61 | , info = "customized output has expected resolution" 62 | ) 63 | 64 | expect_true( 65 | sf::st_crs(rst1) == sf::st_crs(32632) 66 | , info = "customized output inherits specified crs" 67 | ) 68 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(EarthdataLogin) 4 | export(MODISoptions) 5 | export(aggInterval) 6 | export(arcStats) 7 | export(delHdf) 8 | export(detectBitInfo) 9 | export(extractBits) 10 | export(extractDate) 11 | export(fileSize) 12 | export(genTile) 13 | export(getCollection) 14 | export(getHdf) 15 | export(getProduct) 16 | export(getSds) 17 | export(getTile) 18 | export(lpdaacLogin) 19 | export(makeWeights) 20 | export(maskWater) 21 | export(orgStruc) 22 | export(orgTime) 23 | export(preStack) 24 | export(reformatDOY) 25 | export(repDoy) 26 | export(runGdal) 27 | export(runMrt) 28 | export(search4map) 29 | export(smooth.spline.raster) 30 | export(temporalComposite) 31 | export(transDate) 32 | export(whittaker.raster) 33 | exportClasses(MODISextent) 34 | exportClasses(MODISfile) 35 | exportClasses(MODISproduct) 36 | if (.Platform$OS.type=="windows") importFrom(utils,shortPathName) 37 | 38 | import(bitops) 39 | import(mapdata) 40 | import(parallel) 41 | import(ptw) 42 | import(raster) 43 | import(sf) 44 | import(sp) 45 | importFrom(curl,curl) 46 | importFrom(curl,curl_download) 47 | importFrom(curl,handle_setopt) 48 | importFrom(curl,new_handle) 49 | importFrom(devtools,install_github) 50 | importFrom(grDevices,dev.new) 51 | importFrom(grDevices,dev.off) 52 | importFrom(grDevices,png) 53 | importFrom(graphics,abline) 54 | importFrom(graphics,box) 55 | importFrom(graphics,grid) 56 | importFrom(graphics,locator) 57 | importFrom(graphics,title) 58 | importFrom(mapedit,drawFeatures) 59 | importFrom(mapedit,selectFeatures) 60 | importFrom(maps,map.axes) 61 | importFrom(methods,as) 62 | importFrom(methods,new) 63 | importFrom(methods,slot) 64 | importFrom(stats,na.omit) 65 | importFrom(stats,setNames) 66 | importFrom(stats,smooth.spline) 67 | importFrom(utils,capture.output) 68 | importFrom(utils,download.file) 69 | importFrom(utils,installed.packages) 70 | importFrom(utils,read.csv) 71 | importFrom(utils,read.table) 72 | importFrom(utils,vi) 73 | importFrom(utils,write.csv) 74 | importFrom(utils,write.table) 75 | -------------------------------------------------------------------------------- /exec/exec-modis_dl.R: -------------------------------------------------------------------------------- 1 | library(MODIS) 2 | library(sf) 3 | 4 | 5 | ## ENVIRONMENT ==== 6 | 7 | ### `MODISoptions()` ---- 8 | 9 | lap = file.path( 10 | tempdir() 11 | , "MODIS" 12 | ) 13 | 14 | MODISoptions( 15 | localArcPath = lap 16 | , outDirPath = file.path( 17 | lap 18 | , "PROCESSED" 19 | ) 20 | , quiet = FALSE 21 | , save = FALSE 22 | ) 23 | 24 | 25 | ### aoi ---- 26 | 27 | kibo = data.frame( 28 | y = -3.065053 29 | , x = 37.359031 30 | ) |> 31 | st_as_sf( 32 | crs = 4326 33 | , coords = c("x", "y") 34 | ) 35 | 36 | kili = st_buffer( 37 | kibo 38 | , dist = 5e4 39 | ) |> 40 | st_bbox() |> 41 | st_as_sfc() 42 | 43 | # mapview::mapview( 44 | # stars::st_as_stars( 45 | # kili 46 | # ) 47 | # , col.regions = "cornflowerblue" 48 | # , alpha.regions = 0.4 49 | # , map.types = mapviewGetOption( 50 | # "basemaps" 51 | # )[ 52 | # c(4, 1:3, 5) 53 | # ] 54 | # , legend = FALSE 55 | # ) 56 | 57 | 58 | ### download ---- 59 | 60 | ## lpdaac 61 | product = "MOD13A1" 62 | 63 | clc = getCollection( 64 | product 65 | , forceCheck = TRUE 66 | ) 67 | 68 | tifs = runGdal( 69 | product 70 | , collection = clc 71 | , extent = kili 72 | , begin = "2021-03-01" 73 | , end = "2021-05-31" 74 | , SDSstring = "1" 75 | , job = "mod13a1_kili" 76 | , MODISserverOrder = "LPDAAC" 77 | , quiet = FALSE 78 | ) 79 | 80 | 81 | 82 | ## LAADS 83 | hdfs1 = getHdf( 84 | product 85 | , collection = clc 86 | , tileH = 21 87 | , tileV = 9 88 | , begin = "2020-08-01" 89 | , end = "2020-08-03" 90 | , MODISserverOrder = "LAADS" 91 | , quiet = FALSE 92 | ) 93 | 94 | product2 = "MOD10A1" 95 | 96 | clc2 = getCollection( 97 | product2 98 | , forceCheck = TRUE 99 | ) 100 | 101 | hdfs2 = getHdf( 102 | product2 103 | , collection = clc2 104 | , tileH = 21 105 | , tileV = 9 106 | , begin = "2020-08-01" 107 | , end = "2020-08-03" 108 | , quiet = FALSE 109 | ) 110 | -------------------------------------------------------------------------------- /man/aggInterval.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aggInterval.R 3 | \name{aggInterval} 4 | \alias{aggInterval} 5 | \title{Create Periods for Temporal Composites} 6 | \usage{ 7 | aggInterval(x, interval = c("month", "year", "fortnight")) 8 | } 9 | \arguments{ 10 | \item{x}{\code{Date} object, see e.g. default value of 'timeInfo' in 11 | \code{temporalComposite}.} 12 | 13 | \item{interval}{\code{character}. Time period for aggregation. Currently 14 | available options are \code{"month"} (default), \code{"year"} and \code{"fortnight"} (i.e., 15 | every 1st and 15th day of the month).} 16 | } 17 | \value{ 18 | A \code{list} with the following slots: 19 | \itemize{ 20 | \item \verb{$begin}: The start date(s) of each (half-)monthly timestep as 21 | \code{Date} object. 22 | \item \verb{$end}: Same for end date(s). 23 | \item \verb{$beginDOY}: Similar to \verb{$begin}, but with \code{character} objects in 24 | MODIS-style date format (i.e., \code{"\%Y\%j"}; see \code{\link[=strptime]{strptime()}}). 25 | \item \verb{$endDOY}: Same for end date(s). 26 | } 27 | } 28 | \description{ 29 | The creation of custom temporal aggregation levels (e.g., half-monthly, 30 | monthly) from native 16-day MODIS composites usually requires the definition 31 | of date sequences based on which the "composite_day_of_the_year" SDS is 32 | further processed. Complementing \code{\link[=transDate]{transDate()}}, which returns the respective 33 | start and end date only, this function creates full-year (half-)monthly or 34 | annual composite periods from a user-defined temporal range. 35 | } 36 | \examples{ 37 | dates <- do.call("c", lapply(2015:2016, function(i) { 38 | start <- as.Date(paste0(i, "-01-01")) 39 | end <- as.Date(paste0(i, "-12-31")) 40 | seq(start, end, 16) 41 | })) 42 | 43 | intervals <- c("month", "year", "fortnight") 44 | lst <- lapply(intervals, function(i) { 45 | aggInterval(dates, interval = i) 46 | }); names(lst) <- intervals 47 | 48 | print(lst) 49 | 50 | } 51 | \seealso{ 52 | \code{\link[=transDate]{transDate()}}. 53 | } 54 | \author{ 55 | Florian Detsch 56 | } 57 | -------------------------------------------------------------------------------- /inst/external/MODIS_Opts.R: -------------------------------------------------------------------------------- 1 | # This file contains default values for the R package 'MODIS'. 2 | # version 0.8.13 3 | # Consult '?MODISoptions' for details and explanations! 4 | 5 | ######################### 6 | # 1.) Set path for HDF-archive and processing output location. 7 | # ON WINDOWS ALSO USE SINGLE FORWARD SLASH '/' 8 | # If path does not exist it is created! 9 | # Work also with network share! 10 | # consult '?MODISoptions' for more details 11 | 12 | # All HDF-data will be (properly) stored in this directory. 13 | localArcPath <- file.path(gsub("\\\\", "/", tempdir()), 'MODIS_ARC') 14 | 15 | # Default output location for MODIS package processing results. 16 | outDirPath <- file.path(localArcPath, 'PROCESSED') 17 | 18 | ######################### 19 | # 2.) Download: 20 | # consult '?MODISoptions' for more details 21 | dlmethod <- 'auto' # Download method passed to ?download.file, 'auto' is always a good choice, if you encouter problems (like 'file not found') switch to 'wget' 22 | stubbornness <- 'high' # How stubborn should MODIS re-try to connect to ftp/http? 23 | wait <- 0.5 24 | quiet <- FALSE 25 | 26 | ######################### 27 | # 3.) Processing defaults 28 | # It is highly recommended to not modify here, at least not 'resamplingType' as there are several layers that require NN (i.e. VI_Quality, Day of the year,...)! 29 | # consult '?MODISoptions' for more details 30 | 31 | resamplingType <- 'NN' 32 | outProj <- 'asIn' 33 | pixelSize <- 'asIn' 34 | dataFormat <- 'GTiff' 35 | 36 | ######################### 37 | # 4) Defaults related to raster package: 38 | # Cellchunk: Comparable with chunksize in ?rasterOption. 39 | # But as no effect was found in adapting chunksize, 40 | # MODIS applies its own variant:minrows <- max(floor(cellchunk/ncol(x)),1) blockSize(x,minrows=minrows). 41 | # On a reasonable working station you can easily increase this to 500000, set 1 for raster defaults 42 | cellchunk <- 1 43 | 44 | ######################### 45 | # 5.) Set path to GDAL _bin_ directory 46 | # Optional, used to relate writable sf::st_drivers("raster") to file extensions for non-standard formats. 47 | # Example: 48 | # gdalPath <- 'C:/OSGeo4W/bin' 49 | 50 | -------------------------------------------------------------------------------- /R/detectBitInfo.R: -------------------------------------------------------------------------------- 1 | #' List MODIS Quality Information 2 | #' 3 | #' @description 4 | #' This function returns MODIS QA information for a specific product. It gets 5 | #' the information from an internal database and not all products are available. 6 | #' 7 | #' @param product `character`, see [getProduct()]. 8 | #' @param what `character`. Parameter name, e.g. `"VI Quality"` for all MOD13 9 | #' products (see [MODIS Vegetation Index User's Guide](https://lpdaac.usgs.gov/documents/103/MOD13_User_Guide_V6.pdf), 10 | #' Table 5, column "Parameter Name"). 11 | #' @param warn `logical`, whether or not to throw warning messages. 12 | #' 13 | #' @return 14 | #' If `what = "all"` (default) a `data.frame`, else a `list`. 15 | #' 16 | #' @author 17 | #' Matteo Mattiuzzi 18 | #' 19 | #' @examples 20 | #' \dontrun{ 21 | #' detectBitInfo("MOD13Q1") 22 | #' detectBitInfo("MOD13Q1", "VI usefulness") 23 | #' 24 | #' detectBitInfo("MYD17A2") 25 | #' } 26 | #' 27 | #' @export detectBitInfo 28 | #' @name detectBitInfo 29 | detectBitInfo <- function(product, what='all',warn=TRUE) 30 | { 31 | 32 | if(inherits(product,"Raster")) 33 | { 34 | product <- basename(names(product)[1]) 35 | } else if(inherits(product,"character")) 36 | { 37 | product <- basename(product) 38 | } else 39 | { 40 | stop("Unknown input in detectBitInfo!") 41 | } 42 | 43 | product <- strsplit(product,"\\.")[[1]][1] 44 | prodinfo <- getProduct(product,quiet=TRUE)@PRODUCT[1] 45 | if(is.null(prodinfo)) 46 | { 47 | stop() 48 | } 49 | 50 | try(info <- eval(parse(text=paste("",prodinfo,"_QC",sep=""))),silent=TRUE) 51 | 52 | if(exists("info")) 53 | { 54 | if(what!='all') 55 | { 56 | index <- grep(info$LongName,pattern=what, ignore.case = TRUE) 57 | res <- list(bitShift=info[index,"bitShift"],bitMask=info[index,"bitMask"]) 58 | } else 59 | { 60 | res <- info 61 | } 62 | } else 63 | { 64 | if(warn) 65 | { 66 | warning("Could not detect 'bit' information, please provide me (matteo@mattiuzzi.com) the product name you have used so I can enable it, or add it manually see '?extractBits'!") 67 | } 68 | res <- NULL 69 | } 70 | return(res) 71 | } 72 | -------------------------------------------------------------------------------- /inst/tinytest/test-MODIS_Products.R: -------------------------------------------------------------------------------- 1 | prd = MODIS:::MODIS_Products 2 | 3 | ## class 4 | expect_inherits( 5 | prd 6 | , class = "list" 7 | , info = "built-in products data inherits from class 'list'" 8 | ) 9 | 10 | ## `names()` 11 | expect_identical( 12 | names(prd) 13 | , c( 14 | "SENSOR", "PRODUCT", "PLATFORM" 15 | , "PF1", "PF2", "PF3", "PF4" 16 | , "TOPIC", "TYPE", "RES", "TEMP_RES" 17 | , "INTERNALSEPARATOR", "SOURCE", "POS1", "POS2" 18 | ) 19 | , info = "built-in products list has expected names" 20 | ) 21 | 22 | expect_equivalent( 23 | sapply( 24 | prd 25 | , class 26 | ) 27 | , c( 28 | rep("character", 12) 29 | , "list" 30 | , rep("integer", 2) 31 | ) 32 | , info = "built-in products list has expected classes" 33 | ) 34 | 35 | ## `lengths()` 36 | expect_true( 37 | all(lengths(prd) == nrow(MODIS::getProduct())) 38 | , info = "lengths of all list slots equal # of products in `getProduct()`" 39 | ) 40 | 41 | ## content 42 | expect_true( 43 | all(prd$PLATFORM %in% c("Combined", "Terra", "Aqua")) 44 | , info = "available platforms are terra, aqua, and combined" 45 | ) 46 | 47 | expect_true( 48 | all(prd$PF1 %in% c("MOTA", "MOLT", "MOLA") | is.na(prd$PF1)) 49 | , info = "available lpdaac/laads path features are molt, mola, and mota" 50 | ) 51 | 52 | expect_true( 53 | all(prd$PF2 %in% c("MCD", "MOD", "MYD")) 54 | , info = "available product-specific path features are mod, myd, and mcd" 55 | ) 56 | 57 | expect_true( 58 | all(is.na(prd$PF4) | prd$PF4 %in% c("MOST", "MOSA")) 59 | , info = "available nsidc path features are most, mosa, or na" 60 | ) 61 | 62 | expect_identical( 63 | is.na(prd$PF4) 64 | , !is.na(prd$PF1) 65 | , info = "path features are empty for nsidc where available for lpdaac/laads" 66 | ) 67 | 68 | expect_identical( 69 | is.na(prd$PF1) 70 | , !is.na(prd$PF4) 71 | , info = "path features are empty for lpdaac/laads where available for nsidc" 72 | ) 73 | 74 | expect_true( 75 | all(prd$TYPE %in% c("Tile", "CMG", "Swath")) 76 | , info = "available image types are tile, cmg, and swath" 77 | ) 78 | 79 | expect_true( 80 | all(prd$POS2 - prd$POS1 == 6) 81 | , info = "date string in file name is always 6 characters long" 82 | ) 83 | -------------------------------------------------------------------------------- /exec/exec-modis_skip_s2.R: -------------------------------------------------------------------------------- 1 | ## ENVIRONMENT ==== 2 | 3 | ### pkgs ---- 4 | 5 | library(MODIS) 6 | 7 | 8 | ### global objects ---- 9 | 10 | product = "MOD11A1" 11 | 12 | ## get newest collection for product 13 | clc = getCollection( 14 | product 15 | , forceCheck = TRUE 16 | ) 17 | 18 | ## set job name 19 | job = sprintf( 20 | "%s_%s" 21 | , Sys.Date() 22 | , product 23 | ) 24 | 25 | 26 | ## PROCESSING ==== 27 | 28 | ### `sf` input with ellipsoidal coordinates ---- 29 | 30 | ## background: 31 | ## in `getTile,sf-method`, `sf::st_filter(sr, x)` would fail due to invalid 32 | ## geometries in the input file and built-in `MODIS:::sr` data set (see also 33 | ## https://github.com/fdetsch/MODIS/issues/110). with `sf::sf_use_s2` 34 | ## deactivated, this operation succeeds. 35 | 36 | ## aoi 37 | dsn = system.file( 38 | "vectors/Up.tab" 39 | , package = "rgdal" 40 | ) 41 | 42 | shp = sf::st_read( 43 | dsn 44 | , layer = "Up" 45 | , quiet = TRUE 46 | ) 47 | 48 | tls = getTile( 49 | shp 50 | ) 51 | 52 | ## download and extract data 53 | tfs1 = runGdal( 54 | product 55 | , extent = tls 56 | , begin = "2021-01-01" 57 | , end = "2021-01-04" 58 | , SDSstring = "1" # 'LST_Day_1km' 59 | , job = job 60 | ) 61 | 62 | ## investigate 63 | ( 64 | out1 = tfs1 |> 65 | unlist() |> 66 | stack() 67 | ) 68 | 69 | 70 | ### `raster` input (uses non-valid `sr` built-in object) ---- 71 | 72 | ## background: 73 | ## in `getTile,Raster-method`, `sf::st_crop(sr, x)` would fail due to invalid 74 | ## geometries in the built-in `MODIS:::sr` data set (see also 75 | ## https://github.com/fdetsch/MODIS/issues/110). with `sf::sf_use_s2` 76 | ## deactivated, this operation succeeds. 77 | 78 | ## aoi 79 | rst = raster( 80 | xmn = 9.2 81 | , xmx = 17.47 82 | , ymn = 46.12 83 | , ymx = 49.3 84 | ) 85 | 86 | ## download and extract data 87 | tfs2 = runGdal( 88 | product 89 | , extent = rst 90 | , begin = "2021-07-01" 91 | , end = "2021-07-04" 92 | , SDSstring = "1" # 'LST_Day_1km' 93 | , job = job 94 | ) 95 | 96 | ## investigate 97 | ( 98 | out2 = tfs2 |> 99 | unlist() |> 100 | stack() |> 101 | plot() 102 | ) 103 | -------------------------------------------------------------------------------- /man/orgStruc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/orgStruc.R 3 | \name{orgStruc} 4 | \alias{orgStruc} 5 | \title{Reorganize MODIS Files in Local Data Archive} 6 | \usage{ 7 | orgStruc(from, to, structure, pattern, move = FALSE, quiet = FALSE) 8 | } 9 | \arguments{ 10 | \item{from}{\code{character}. Local path to look for MODIS files, defaults to 11 | \code{options("MODIS_localArcPath")} (see \code{\link[=MODISoptions]{MODISoptions()}}).} 12 | 13 | \item{to}{\code{character}. Target folder to move (or copy) MODIS files to, 14 | defaults to \code{options("MODIS_localArcPath")}.} 15 | 16 | \item{structure}{\code{character}. Storage structure, defaults to 17 | \code{options("MODIS_arcStructure")} (see Examples).} 18 | 19 | \item{pattern}{Regular expression passed to \code{\link[=list.files]{list.files()}}. Insert a pattern 20 | if you want to extract specific files from your archive.} 21 | 22 | \item{move}{\code{logical}. If \code{TRUE}, files are moved and duplicated files are 23 | deleted. If \code{FALSE} (default), files are just copied and thus remain in the 24 | origin folder. Note that the copying process performs rather slowly when 25 | dealing with large files, e.g. 250-m \code{"MOD13Q1"}.} 26 | 27 | \item{quiet}{\code{logical}, defaults to \code{FALSE}.} 28 | } 29 | \value{ 30 | If \code{quiet = FALSE} (default), information on how many files have been moved 31 | (or copied) and deleted is printed to the console. 32 | } 33 | \description{ 34 | Reorganize the storage structure of your MODIS archive according to the 35 | settings in \code{options("MODIS_arcStructure")}. Depending on the specified 36 | 'source', you can also use this function to gather all MODIS grid files on 37 | your machine and reorganize them. The main purpose is to organize the 38 | archive, but it is also possible to copy a subset of files to a desired 39 | location! 40 | } 41 | \examples{ 42 | \dontrun{ 43 | # MOVE all MODIS grid data to the directory and structure as defined in 44 | # options("MODIS_localArcPath", "MODIS_arcStructure") 45 | orgStruc(move = TRUE) 46 | 47 | # COPY all MOD13Q1 from 2001 to folder "MyFiles/MOD13Q1.collection/" 48 | orgStruc(pattern="MOD13Q1.A2001*.",to="MyFiles",structure="PRODUCT.CCC") 49 | 50 | # COPY all MOD13Q1 to folder "MyFiles/" 51 | orgStruc(pattern="MOD13Q1.*.",to="MyFiles",structure="") 52 | } 53 | 54 | } 55 | \author{ 56 | Matteo Mattiuzzi 57 | } 58 | -------------------------------------------------------------------------------- /R/MODISswath/FUSION_cloudCeck_getMOD02.R: -------------------------------------------------------------------------------- 1 | 2 | ###### 3 | library(raster) 4 | library(RCurl) 5 | library(PBSmapping) 6 | ###### 7 | ################################### 8 | ### Parameter input 9 | ###################### 10 | # personal setting: 11 | if (.Platform$OS.type == "unix"){ 12 | #HEG <- "/usr/share/HEG/bin/" 13 | wrkdr <- "/home/matteo/Desktop/FUSIO_CloudCheck/MODIS_clF_2009/" 14 | } else { 15 | #HEG <- "c:\\Programme\\heg\\HEG_Win\\bin\\" 16 | wrkdr <- "D:\\Fusion\\" 17 | } 18 | setwd(wrkdr) 19 | ###### 20 | # Parameters 21 | 22 | # max view angle 23 | 24 | # max clouds 25 | 26 | # FTP string 27 | 28 | 29 | 30 | av <- read.csv2("final2.csv") 31 | 32 | for(i in 1:nrows(av){#23:37){ # # for all 33 | 34 | todo <- av[i,] 35 | 36 | MxD03 <- as.character(todo[2][[1]]) 37 | subM03 <- strsplit(MxD03,"\\.")[[1]] 38 | 39 | plf <- substr(subM03[1],2,2) 40 | if (plf == "Y") {plf <- "MYD"} else {plf <- "MOD"} 41 | rootn <- paste(subM03[2:4],sep="",collapse=".") 42 | splroot <- strsplit(rootn,"\\.")[[1]] 43 | vers <- splroot[3] 44 | year <- substr(splroot[1],2,5) 45 | doy <- substr(splroot[1],6,8) 46 | 47 | # FTPString 48 | drn <- paste("MODIS_02_hdfs",sep="") 49 | if (.Platform$OS.type == "unix") {dir.create(drn,showWarnings=F, mode = "777")} else {dir.create(drn,showWarnings=F)} 50 | FTP02a <- "ftp://ladsweb.nascom.nasa.gov/allData/" 51 | FTP02b <- paste(FTP02a,as.numeric(vers),"/",sep="") 52 | 53 | # getFiles (1km,hkm,qkm) 54 | FTP1KM <- paste(FTP02b,plf,"021KM/",year,"/",doy,"/",sep="") 55 | getlist <- strsplit(getURL(FTP1KM,.opts=curlOptions(ftplistonly=TRUE)), if(.Platform$OS.type=="unix"){"\n"} else{"\r\n"})[[1]] 56 | fil1 <- grep(getlist,pattern=paste(plf,"021KM.",rootn,".*",sep=""),value=T) 57 | download.file(paste(FTP1KM,fil1,sep=""),destfile=paste(getwd(),"/",drn,"/",fil1,sep=""),mode="wb",method="wget",quiet=T,cacheOK=FALSE) 58 | 59 | filb <- paste(strsplit(fil1,"\\.")[[1]][-1],sep="",collapse=".") 60 | 61 | FTPHKM <- paste(FTP02b,plf,"02HKM/",year,"/",doy,"/",sep="") 62 | filH <- paste(plf,"02HKM.",filb,sep="") 63 | download.file(paste(FTPHKM,filH,sep=""),destfile=paste(getwd(),"/",drn,"/",filH,sep=""),mode="wb",method="wget",quiet=T,cacheOK=FALSE) 64 | 65 | FTPQKM <- paste(FTP02b,plf,"02QKM/",year,"/",doy,"/",sep="") 66 | filQ <- paste(plf,"02QKM.",filb,sep="") 67 | download.file(paste(FTPQKM,filQ,sep=""),destfile=paste(getwd(),"/",drn,"/",filQ,sep=""),mode="wb",method="wget",quiet=T,cacheOK=FALSE) 68 | } # end i 69 | 70 | -------------------------------------------------------------------------------- /man/temporalComposite.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/temporalComposite.R 3 | \name{temporalComposite} 4 | \alias{temporalComposite} 5 | \title{Calculate MODIS Composite Images} 6 | \usage{ 7 | temporalComposite( 8 | x, 9 | y, 10 | timeInfo = extractDate(x, asDate = TRUE)$inputLayerDates, 11 | interval = c("month", "year", "fortnight"), 12 | fun = max, 13 | na.rm = TRUE, 14 | cores = 1L, 15 | filename = "", 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{x}{\verb{Raster*} or \code{character}. MODIS composite data set with an 21 | associated "composite_day_of_the_year" SDS, e.g. all vegetation indices 22 | products (MOD13).} 23 | 24 | \item{y}{\verb{Raster*} or \code{character}. MODIS "composite_day_of_the_year" SDS 25 | associated with 'x'.} 26 | 27 | \item{timeInfo}{\code{Date} vector corresponding to all input layers. If not 28 | further specified, this is tried to be created through invoking 29 | \code{\link[=extractDate]{extractDate()}} upon 'x', assuming standard MODIS file names.} 30 | 31 | \item{interval}{\code{character}. Time period for aggregation, see 32 | \code{\link[=aggInterval]{aggInterval()}}.} 33 | 34 | \item{fun, na.rm}{\code{function}. See \code{\link[raster:overlay]{raster::overlay()}}.} 35 | 36 | \item{cores}{\code{integer}. Number of cores for parallel processing.} 37 | 38 | \item{filename}{\code{character}. Optional output file name.} 39 | 40 | \item{...}{Additional arguments passed to \code{\link[raster:writeRaster]{raster::writeRaster()}}.} 41 | } 42 | \value{ 43 | A \verb{Raster*} object. 44 | } 45 | \description{ 46 | Based on a user-defined function, e.g. \code{\link[=max]{max()}} for maximum value composites 47 | (MVC), aggregate native 16-day MODIS data sets to custom temporal composites. 48 | } 49 | \examples{ 50 | \dontrun{ 51 | library(mapview) 52 | frc <- as(subset(franconia, district == "Mittelfranken"), "Spatial") 53 | tfs <- runGdal("MOD13A1", begin = "2015001", end = "2016366", extent = frc, 54 | job = "temporalComposite", SDSstring = "100000000010") 55 | 56 | ndvi <- sapply(tfs[[1]], "[[", 1) 57 | cdoy <- sapply(tfs[[1]], "[[", 2) 58 | 59 | mmvc <- temporalComposite(ndvi, cdoy) 60 | plot(mmvc[[1:4]]) 61 | } 62 | 63 | } 64 | \seealso{ 65 | \code{\link[=aggInterval]{aggInterval()}}, \code{\link[raster:calc]{raster::calc()}}, \code{\link[raster:writeRaster]{raster::writeRaster()}}. 66 | } 67 | \author{ 68 | Florian Detsch 69 | } 70 | -------------------------------------------------------------------------------- /R/extractDate.R: -------------------------------------------------------------------------------- 1 | #' Extract Dates from (MODIS) Files 2 | #' 3 | #' @description 4 | #' This function helps to extract dates from a vector of files. 5 | #' 6 | #' @param files A `character` vector of filenames from which to extract dates. 7 | #' Alternatively, a `Raster*` with date information in its [raster::names()]. 8 | #' @param pos1,pos2 Start and end of date string in 'files' as `integer`. If 9 | #' missing, attempts to retrieve positions from a look-up table provided that 10 | #' 'files' comply with the MODIS standard naming convention. 11 | #' @param asDate `logical`. If `TRUE`, the result is converted to a `Date` 12 | #' object. 13 | #' @param format `character`, date format. Used only if `asDate = TRUE`. 14 | #' Defaults to MODIS date style (i.e., `"\%Y\%j"` for year and Julian day). 15 | #' See [strptime()] for modifications. 16 | #' 17 | #' @return 18 | #' A `list` with the following entries: 'inputLayerDates', 'pos1', 'pos2', 19 | #' 'asDate' and, optionally, 'format'. If `asDate = FALSE` (default), 20 | #' 'inputLayerDates' are represented as `character`, else as `Date`. 21 | #' 22 | #' @author 23 | #' Matteo Mattiuzzi 24 | #' 25 | #' @examples 26 | #' # example on HDF files 27 | #' files <- c("MOD13Q1.A2010209.h18v03.005.2010239071130.hdf", 28 | #' "MOD13Q1.A2010225.h18v03.005.2010254043849.hdf") 29 | #' extractDate(files) 30 | #' extractDate(files, asDate = TRUE) 31 | #' 32 | #' # on any other file 33 | #' files <- c("Myfile_20010101.XXX", "Myfile_20010115.XXX", "Myfile_20010204.XXX") 34 | #' extractDate(files, pos1 = 8, pos2 = 15) 35 | #' extractDate(files, pos1 = 8, pos2 = 15, asDate = TRUE, format = "%Y%m%d") 36 | #' 37 | #' @export extractDate 38 | #' @name extractDate 39 | extractDate <- function(files, pos1, pos2, asDate = FALSE, format = "%Y%j") 40 | { 41 | if (inherits(files, "Raster")) { 42 | files <- names(files) 43 | } 44 | 45 | files <- basename(files) 46 | 47 | ## if any position indication is missing, try to retrieve it from look-up table 48 | if (any(missing(pos1), missing(pos2))) { 49 | ids = positionIndication(files) 50 | pos1 = ids[[1]]; pos2 = ids[[2]] 51 | } 52 | 53 | date <- sapply(files,function(x){ 54 | substr(x, pos1, pos2) 55 | }) 56 | 57 | if(asDate) 58 | { 59 | date <- as.Date(date, format=format) 60 | return(list(inputLayerDates = date, pos1=pos1, pos2=pos2, asDate = asDate, format=format)) 61 | } else 62 | { 63 | return(list(inputLayerDates = date, pos1 = pos1, pos2 = pos2, asDate = asDate)) 64 | } 65 | } 66 | 67 | -------------------------------------------------------------------------------- /R/MODISswath/getMxD02_fromCSV.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | Platform="both" 4 | Job = "UKRAINA" 5 | 6 | 7 | run <- function(){ 8 | ### create FTP-Dir-string 9 | HIR1 <- if(Platform == "both"){c("MOLT", "MOLA")}else{Platform} 10 | HIR2 <- if(Platform == "both"){c("MOD", "MYD")}else{if(Platform == "TERRA"){"MOD"}else{if(Platform=="AQUA"){"MYD"}}} 11 | HIR3 <- if(Platform == "both"){c("TERRA", "AQUA")}else{Platform} 12 | 13 | 14 | for(z in 1:length(HIR1)){ 15 | 16 | data <- read.csv2(paste("summaries_",HIR2[z],"_",Job,".csv",sep="")) 17 | 18 | for (i in 1:nrow(data)){ 19 | 20 | MxD03 <- as.character(data[i,2]) 21 | basenam <- strsplit(MxD03,"\\.")[[1]][2:4] 22 | PVer <- as.numeric(strsplit(MxD03,"\\.")[[1]][4]) 23 | Year <- substr(strsplit(MxD03,"\\.")[[1]][2],2,5) 24 | Doy <- substr(strsplit(MxD03,"\\.")[[1]][2],6,8) 25 | 26 | ftp <- paste("ftp://ladsweb.nascom.nasa.gov/allData/",PVer,"/",sep="") 27 | 28 | if (Producttype == "ALL"){ 29 | PType <- c("1KM","HKM","QKM") 30 | 31 | } else {stop("only 'ALL' is supported for 'Producttype', just call me if you need changes")} 32 | 33 | # 34 | prenam <- paste(HIR2[z],"02",PType,sep="") 35 | ftpMxD02 <- paste(ftp,prenam,"/",Year,"/",Doy,"/",sep="") 36 | 37 | pattern <- paste(prenam,basenam[1],basenam[2],basenam[3],sep=".") 38 | pattern <- paste(pattern,".*.hdf",sep="") 39 | 40 | MxD02Av <- list() 41 | for(q in 1:length(pattern)){ 42 | MxD02Av[[q]] <- grep(dir(paste(archive,HIR2[z],"02",sep="")),pattern=pattern[q],value=T) 43 | } 44 | 45 | if (sum(MxD02Av!="character(0)")==0) { # if no PType is available on archive, get the file pattern from ftp (looks only for ftpMxD02[1]!) 46 | onFTP <- strsplit(getURL(ftpMxD02[1],.opts=curlOptions(ftplistonly=TRUE)), if(.Platform$OS.type=="unix"){"\n"} else{"\r\n"})[[1]] 47 | MxD02 <- grep(onFTP,pattern=pattern[1],value=T) 48 | #MxD02Av <- as.list(rep("character(0)",length(PType))) 49 | if (length(MxD02)==0){stop(paste('file with pattern: ',pattern[1],' not found in: ',ftpMxD02,sep=""))} 50 | } else { 51 | MxD02 <- unlist(MxD02Av)[MxD02Av!="character(0)"] 52 | MxD02 <- MxD02[1] 53 | } 54 | 55 | backpart <- paste(strsplit(MxD02,"\\.")[[1]][-1],collapse=".") 56 | MxD02 <- paste(prenam,backpart,sep=".") 57 | 58 | if (sum(MxD02Av=="character(0)")!=0){ 59 | for (x in which(MxD02Av=="character(0)")){ 60 | download.file(paste(ftpMxD02[x],MxD02[x],sep=""),destfile=paste(archive,HIR2[z],"02/",MxD02[x],sep=""),mode="wb",method="wget",quiet=F,cacheOK=FALSE) 61 | wait(0.5) 62 | } 63 | } 64 | 65 | } # end i (nrow(data)) 66 | } # end z (HIR1) 67 | } # end run() 68 | 69 | 70 | 71 | 72 | 73 | 74 | -------------------------------------------------------------------------------- /R/addServer.R: -------------------------------------------------------------------------------- 1 | #' Add New Remote Server to MODIS Inventory 2 | #' 3 | #' @description 4 | #' `addServer()` is a non-exported helper function for internal use only. It 5 | #' adds a new entry to the list of online servers featured by **MODIS** (see 6 | #' `MODIS:::MODIS_FTPinfo`). 7 | #' 8 | #' @param name `character` Name of the remote server that should be added to the 9 | #' inventory. 10 | #' @param sensor `character` Sensor type, defaults to 'MODIS'. 11 | #' @param basepath `character` Absolute online server path. 12 | #' @param varpath `character` Pattern of organizational structure on server. 13 | #' @param content `character` Content type, defaults to `"images"`. 14 | #' @param path_ext `character` Path to folder containing file 15 | #' 'MODIS_FTPinfo.RData'. When working with RStudio projects (`.Rproj`), this 16 | #' usually defaults to 'inst/external'. 17 | #' @param overwrite `logical`, defaults to `FALSE`. If `TRUE`, the initial 18 | #' `.RData` file located in 'path_ext' will be overwritten. 19 | #' 20 | #' @return 21 | #' A `list` holding the updated contents of 'MODIS_FTPinfo.RData'. 22 | #' 23 | #' @seealso 24 | #' `MODIS:::MODIS_FTPinfo`. 25 | #' 26 | #' @author 27 | #' Florian Detsch 28 | #' 29 | #' @examples 30 | #' \dontrun{ 31 | #' ## E.g., add server of MODIS evapotranspiration product 32 | #' MODIS:::addServer( 33 | #' name = "NTSG" 34 | #' , sensor = "MODIS" 35 | #' , basepath = "ftp://ftp.ntsg.umt.edu/pub/MODIS/NTSG_Products/MOD16/" 36 | #' , varpath = "PRODUCT.CCC/YYYY/DDD/" 37 | #' ) 38 | #' } 39 | #' 40 | #' @noRd 41 | addServer = function( 42 | name 43 | , sensor = "MODIS" 44 | , basepath 45 | , varpath 46 | , content = "images" 47 | , path_ext = "inst/external" 48 | , overwrite = FALSE 49 | ) { 50 | 51 | ## load list of current products 52 | load(paste0(path_ext, "/MODIS_FTPinfo.RData")) 53 | 54 | ## id of last and new entry 55 | int_id_last <- length(MODIS_FTPinfo) 56 | int_id_new <- int_id_last + 1 57 | 58 | ## add new collection 59 | ls_new <- list(list( 60 | name = name, 61 | SENSOR = sensor, 62 | basepath = basepath, 63 | variablepath = varpath, 64 | content = content 65 | )) 66 | names(ls_new) <- paste0("ftpstring", int_id_new) 67 | 68 | MODIS_FTPinfo <- append(MODIS_FTPinfo, ls_new) 69 | 70 | ## output storage 71 | if (overwrite) { 72 | file_out <- paste0(path_ext, "/MODIS_FTPinfo.RData") 73 | save(MODIS_FTPinfo, file = file_out) 74 | } 75 | 76 | ## return updated collections dataset 77 | return(MODIS_FTPinfo) 78 | } 79 | -------------------------------------------------------------------------------- /R/getSds.R: -------------------------------------------------------------------------------- 1 | #' List SDS Layers in an HDF File 2 | #' 3 | #' @description 4 | #' List the names of all scientific data sets (SDS) contained in a specified 5 | #' MODIS grid HDF file. 6 | #' 7 | #' @param HdfName `character`. (Absolute) file name from which to extract SDS 8 | #' names. Non-existing files are being looked up recursively in 9 | #' `getOption("MODIS_localArcPath")`. 10 | #' @param SDSstring An optional `character` string of 1s and 0s, see Value. 11 | #' @param ... Currently not used. 12 | #' 13 | #' @return 14 | #' A `list`. If 'SDSstring' is provided, the function reports matching SDS and a 15 | #' formatted 'SDSstring' (e.g., "1 1 1 0 1"). If omitted, the names of all SDS 16 | #' in 'HdfName' are returned. 17 | #' 18 | #' @author 19 | #' Matteo Mattiuzzi, Florian Detsch 20 | #' 21 | #' @examples 22 | #' hdf = system.file( 23 | #' "external/MOD13A2.A2016145.h18v04.006.2016166145124.hdf" 24 | #' , package = "MODIS" 25 | #' ) 26 | #' 27 | #' getSds( 28 | #' hdf 29 | #' ) 30 | #' 31 | #' getSds( 32 | #' hdf 33 | #' , SDSstring = 1 34 | #' ) 35 | #' 36 | #' @export getSds 37 | #' @name getSds 38 | getSds = function( 39 | HdfName 40 | , SDSstring = NULL 41 | , ... 42 | ) { 43 | 44 | if (!file.exists(HdfName)) { 45 | cat("Hm, I have to search for the file. Next time provide the full path and I'll be very fast!\n") 46 | HdfName = list.files( 47 | path = combineOptions()$localArcPath 48 | , pattern = paste0(HdfName, "$") 49 | , recursive = TRUE 50 | , full.names = TRUE 51 | ) 52 | } 53 | 54 | SDSnames = unlist(sf::gdal_subdatasets(HdfName[1])) 55 | sds = gsub("\"", "", getSdsNames(SDSnames)) 56 | 57 | if (!is.null(SDSstring)) 58 | { 59 | if (inherits(SDSstring,"list")) 60 | { 61 | SDSstring <- paste(SDSstring$SDSstring,collapse="") 62 | } else if (inherits(SDSstring,"numeric")) 63 | { 64 | SDSstring <- paste(SDSstring,collapse="") 65 | } 66 | 67 | SDSstring <- gsub(pattern=" ",replacement="",x=SDSstring) # collapse the spaces 68 | 69 | msk <- rep(FALSE,length(sds)) 70 | for (o in 1:length(sds)) 71 | { 72 | msk[o] <- substr(SDSstring,o,o)==1 73 | } 74 | 75 | return(list(SDSnames = sds[msk],SDSstring = paste(as.numeric(msk),collapse=" "),SDS4gdal=SDSnames[msk])) 76 | } else 77 | { 78 | return(list(SDSnames = sds,SDS4gdal=SDSnames)) 79 | } 80 | } 81 | 82 | 83 | getSdsNames = function(x) { 84 | x = strsplit(x, ":") 85 | mapply(`[`, x, lengths(x)) 86 | } 87 | -------------------------------------------------------------------------------- /man/getCollection.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getCollection.R 3 | \name{getCollection} 4 | \alias{getCollection} 5 | \title{Get Available Collections of MODIS Product(s)} 6 | \usage{ 7 | getCollection( 8 | product, 9 | collection = NULL, 10 | newest = TRUE, 11 | forceCheck = FALSE, 12 | as = "character", 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{product}{\code{character}. MODIS grid product to check for existing 18 | collections, see \code{\link[=getProduct]{getProduct()}}.} 19 | 20 | \item{collection}{\code{character} or \code{integer}. If provided, the function only 21 | checks if the specified collection exists and returns the collection number 22 | formatted based on the 'as' parameter or \code{FALSE} if it doesn't exists. The 23 | check is performed on 24 | \href{https://www.earthdata.nasa.gov/centers/lp-daac}{LP DAAC} as the exclusive 25 | source for several products or, for snow cover (MOD/MYD10) and sea ice 26 | extent (MOD/MYD29), \href{https://nsidc.org/home}{NSIDC}.} 27 | 28 | \item{newest}{\code{logical}. If \code{TRUE} (default), return only the newest 29 | collection, else return all available collections.} 30 | 31 | \item{forceCheck}{\code{logical}, defaults to \code{FALSE}. If \code{TRUE}, connect to the 32 | LP DAAC or NSIDC server and get available collections, of which an updated 33 | version is permanently stored in \code{MODIS:::combineOptions()$auxPath}.} 34 | 35 | \item{as}{\code{character}, defaults to \code{"character"} which returns the typical 36 | 3-digit collection number (i.e., \code{"061"}). \code{as = "numeric"} returns the 37 | result as \code{numeric} (i.e., \code{61}).} 38 | 39 | \item{...}{Additional arguments passed to \code{\link[=MODISoptions]{MODISoptions()}}. Permanent 40 | settings for these arguments are temporarily overridden.} 41 | } 42 | \value{ 43 | A 3-digit \code{character} or \code{numeric} object (depending on 'as') or, if 44 | \code{length(product) > 1}, a \code{list} of such objects with each slot corresponding 45 | to the collection available for a certain product. Additionally, a text file 46 | in a hidden folder located in \code{getOption("MODIS_localArcPath")} as database 47 | for future calls. If 'collection' is provided, only the (formatted) 48 | collection (or \code{FALSE} if it could not be found) is returned. 49 | } 50 | \description{ 51 | Checks and retrieves available MODIS collection(s) for a given product. 52 | } 53 | \examples{ 54 | \dontrun{ 55 | 56 | # update or get collections for MCD12C1 and MCD12Q1 57 | getCollection(product = "MCD12.*") 58 | getCollection(product = "MCD12.*", newest = FALSE) 59 | getCollection(product = "MCD12.*", forceCheck = TRUE) 60 | } 61 | 62 | } 63 | \seealso{ 64 | \code{\link[=getProduct]{getProduct()}}. 65 | } 66 | \author{ 67 | Matteo Mattiuzzi, Florian Detsch 68 | } 69 | -------------------------------------------------------------------------------- /inst/tinytest/test-getSds.R: -------------------------------------------------------------------------------- 1 | hdf_name = system.file( 2 | "external" 3 | , "MOD13A2.A2016145.h18v04.006.2016166145124.hdf" 4 | , package = "MODIS" 5 | ) 6 | 7 | 8 | ### . w/o 'SDSstring' ---- 9 | 10 | layers = try( 11 | MODIS:::getSds( 12 | hdf_name 13 | ) 14 | , silent = TRUE 15 | ) 16 | 17 | if (!inherits(layers, "try-error")) { 18 | 19 | ## structure 20 | expect_true( 21 | all( 22 | inherits(layers, "list") 23 | , length(layers) == 2 24 | , names(layers) == c("SDSnames", "SDS4gdal") 25 | ) 26 | , info = "list structure w/o 'SDSstring' looks right" 27 | ) 28 | 29 | ## content 30 | expect_true( 31 | all( 32 | length(layers$SDSnames) == 3 33 | , grepl( 34 | "1 km 16 days (NDVI|VI Quality|pixel reliability)$" 35 | , layers$SDSnames 36 | ) 37 | ) 38 | , info = "Slot 'SDSnames' has expected length and content" 39 | ) 40 | 41 | expect_true( 42 | length(layers$SDS4gdal) == 3 43 | , info = "Slot 'SDS4gdal' has expected length" 44 | ) 45 | 46 | # test_that( 47 | # "'gdal' and 'mrt' methods create identical output" 48 | # , { 49 | # expect_identical( 50 | # layers[1] 51 | # , getSds( 52 | # hdf_name 53 | # , method = "mrt" 54 | # ) 55 | # ) 56 | # } 57 | # ) 58 | } 59 | 60 | 61 | ### . w/'SDSstring' ---- 62 | 63 | sds_string = "101" 64 | 65 | layers1 = try( 66 | MODIS:::getSds( 67 | hdf_name 68 | , SDSstring = sds_string 69 | ) 70 | , silent = TRUE 71 | ) 72 | 73 | if (!inherits(layers1, "try-error")) { 74 | 75 | ## structure 76 | expect_true( 77 | all( 78 | inherits(layers1, "list") 79 | , length(layers1) == 3 80 | , names(layers1) == c("SDSnames", "SDSstring", "SDS4gdal") 81 | ) 82 | , info = "list structure w/'SDSstring' looks right" 83 | ) 84 | 85 | ## content 86 | expect_true( 87 | all( 88 | length(layers1$SDSnames) == 2 89 | , grepl( 90 | "1 km 16 days (NDVI|pixel reliability)$" 91 | , layers1$SDSnames 92 | ) 93 | ) 94 | , info = "Slot 'SDSnames' has expected length and content" 95 | ) 96 | 97 | expect_identical( 98 | layers1$SDSstring 99 | , target = "1 0 1" 100 | , info = "Slot 'SDSstring' has expected content" 101 | ) 102 | 103 | expect_true( 104 | length(layers1$SDS4gdal) == 2 105 | , info = "Slot 'SDS4gdal' has expected length" 106 | ) 107 | 108 | ## comparison 109 | expect_identical( 110 | layers$SDSnames[c(1, 3)] 111 | , layers1$SDSnames 112 | , info = "Slot 'SDSnames' w/'SDSstring' is a valid subset of w/o method" 113 | ) 114 | 115 | expect_identical( 116 | layers$SDS4gdal[c(1, 3)] 117 | , layers1$SDS4gdal 118 | , info = "Slot 'SDS4gdal' w/'SDSstring' is a valid subset of w/o method" 119 | ) 120 | } 121 | -------------------------------------------------------------------------------- /man/repDoy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/repDoy.R 3 | \name{repDoy} 4 | \alias{repDoy} 5 | \title{Repair MODIS "composite_day_of_the_year" SDS} 6 | \usage{ 7 | repDoy(pixX, layerDate = NULL, bias = 0) 8 | } 9 | \arguments{ 10 | \item{pixX}{\code{matrix} of values, usually derived from \code{\link[raster:as.matrix]{raster::as.matrix()}}.} 11 | 12 | \item{layerDate}{If \code{NULL} (default), try to autodetect layer dates. If you 13 | want to be sure, use the result from \code{\link[=extractDate]{extractDate()}} or \code{\link[=orgTime]{orgTime()}}.} 14 | 15 | \item{bias}{\code{integer}. Bias applied to all values in 'pixX'.} 16 | } 17 | \value{ 18 | A \code{matrix} with sequential Julian dates. 19 | } 20 | \description{ 21 | Currently works only for MODIS 16 days composites! In MODIS composites, the 22 | Julian dates inside the 'composite_day_of_the_year' SDS are referring always 23 | to the year they are effectively in. The problem is that the layer/SDS name 24 | from the last files from Terra and Aqua within a year can include dates from 25 | the following year and so starting again with 1. The problem occurs if you 26 | want to sort values of a time series by date (e.g. for precise time series 27 | functions). This function generates a sequential vector beginning always 28 | with the earliest SDS/layer date and ending with the total sum of days of the 29 | time series length. 30 | } 31 | \examples{ 32 | \dontrun{ 33 | tfs <- runGdal(product="M.D13A2", begin="2010350", end="2011016" 34 | , extent="Luxembourg", job="deleteme", SDSstring="100000000010") 35 | 36 | ndviFiles <- grep("NDVI.tif$", unlist(tfs, use.names = FALSE), value = TRUE) 37 | ndviFiles <- preStack(files = ndviFiles, timeInfo = orgTime(ndviFiles)) 38 | ndvi <- stack(ndviFiles) 39 | 40 | doyFiles <- grep("composite_day_of_the_year.tif$" 41 | , unlist(tfs, use.names = FALSE), value = TRUE) 42 | doyFiles <- preStack(files = doyFiles, timeInfo = orgTime(doyFiles)) 43 | doy <- stack(doyFiles) 44 | 45 | layerDates <- extractDate(doyFiles) 46 | 47 | pixX <- 169 48 | 49 | y <- ndvi[pixX] 50 | print(x1 <- doy[pixX]) 51 | print(x2 <- repDoy(x1,layerDates)) 52 | 53 | # the plotting example is not really good. 54 | # To create a figurative example it would be necessary to dolwnload to much data! 55 | plot("",xlim=c(1,max(x1,x2)),ylim=c(0,2000),xlab="time",ylab="NDVI*10000") 56 | lines(y=y,x=x1,col="red",lwd=3) 57 | lines(y=y,x=x2,col="green",lwd=2) 58 | 59 | # repDoy function is thought to be embedded in something like that: 60 | tr <- blockSize(ndvi) 61 | 62 | doyOk <- brick(doy) 63 | doyOk <- writeStart(doyOk, filename='test.tif', overwrite=TRUE) 64 | 65 | for (i in 1:tr$n) 66 | { 67 | pixX <- getValues(doy,tr$row[i],tr$nrows[i]) 68 | ok <- repDoy(pixX,layerDates) 69 | doyOk <- writeValues(x=doyOk,v=ok,start=tr$row[i]) 70 | } 71 | doyOk <- writeStop(doyOk) 72 | 73 | unlink(filename(doyOk)) 74 | } 75 | 76 | } 77 | \author{ 78 | Matteo Mattiuzzi 79 | } 80 | -------------------------------------------------------------------------------- /man/arcStats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/arcStats.R 3 | \name{arcStats} 4 | \alias{arcStats} 5 | \title{Get Summary of Local MODIS Data} 6 | \usage{ 7 | arcStats( 8 | product, 9 | collection = NULL, 10 | extent = "global", 11 | begin = "2000.01.01", 12 | end = format(Sys.Date(), "\%Y.\%m.\%d"), 13 | asMap = TRUE, 14 | outName = NULL, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{product}{\code{character}, see \code{\link[=getProduct]{getProduct()}}. MODIS grid product to be 20 | checked.} 21 | 22 | \item{collection}{\code{character} or \code{integer}, see \code{\link[=getCollection]{getCollection()}}. MODIS 23 | product version.} 24 | 25 | \item{extent}{Extent information, defaults to \code{"global"}. See \code{\link[=getTile]{getTile()}}.} 26 | 27 | \item{begin}{\code{character}. Begin date of MODIS time series, see \code{\link[=transDate]{transDate()}}.} 28 | 29 | \item{end}{\code{character}. End date, defaults to \code{\link[=Sys.Date]{Sys.Date()}}.} 30 | 31 | \item{asMap}{Controls output type. Possible options are \code{TRUE} (\code{.png}), 32 | \code{FALSE} (\code{.csv}) or \code{"both"}.} 33 | 34 | \item{outName}{\code{character}. Name of output file, defaults to 35 | \code{"product.collection.YYYYMMDDHHMMSS.png"} (or \code{.csv}) of the function call 36 | or, if applicable, \code{"product.collection.extent.YYYYMMDDHHMMSS.png"} (or 37 | \code{.csv}).} 38 | 39 | \item{...}{Arguments passed to \code{\link[=MODISoptions]{MODISoptions()}}, most importantly 'outProj' 40 | and 'outDirPath'.} 41 | } 42 | \value{ 43 | An invisible \code{NULL} (probably this will change to a matrix-like object 44 | similar to the \code{.csv} output). If \code{asMap = TRUE}, a \code{"table.csv"} and a 45 | \code{"image.png"} file in 'outDirPath'. 46 | } 47 | \description{ 48 | In the same manner as \code{\link[=getHdf]{getHdf()}}, this function quantifies the availability 49 | of local MODIS \code{.hdf} data and gives you a visual and/or tabular overview. 50 | } 51 | \examples{ 52 | \dontrun{ 53 | # The following examples expect that you have some data stored locally! 54 | ########################################################### 55 | # generates 2 png's and 2 csv's, one for TERRA one for AQUA 56 | arcStats(product="M.D13Q1") 57 | 58 | # -"- with the specified countries 59 | arcStats(product="M.D13Q1",extent=c("austria","germany","italy")) 60 | 61 | # generates 1 png and 1 csv for AQUA 62 | arcStats(product="MYD13Q1",begin="2005001",outName="MyDataStart2005") 63 | 64 | # generates 1 png for AQUA for the selected area and plots it in 'Sinusoidal' 65 | arcStats(product="MYD13Q1",begin="2005001",asMap=TRUE, outName="InteractiveSelection2005", 66 | extent=getTile(), outProj="asIn") 67 | 68 | # -"- and plots it in 'Geographic' Coordinates. 69 | arcStats(product="MYD13Q1",begin="2005001",asMap=TRUE, outName="InteractiveSelection2005", 70 | extent=getTile(), outProj="GEOGRAPHIC") 71 | } 72 | 73 | } 74 | \author{ 75 | Matteo Mattiuzzi 76 | } 77 | -------------------------------------------------------------------------------- /R/reformatDOY.R: -------------------------------------------------------------------------------- 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 `character` or `Raster*`. MODIS "composite_day_of_the_year" 12 | #' layer(s). 13 | #' @param cores `integer`. Number of cores for parallel processing. 14 | #' @param ... Additional arguments passed to [extractDate()]. 15 | #' 16 | #' @return 17 | #' A `Raster*` object. 18 | #' 19 | #' @author 20 | #' Florian Detsch 21 | #' 22 | #' @seealso 23 | #' [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 | 44 | ## if 'x' represents filename(s), import as 'Raster*' 45 | if (inherits(x, "character")) 46 | x <- raster::stack(x) 47 | 48 | ## extract required date information 49 | dts <- extractDate(x, ...)$inputLayerDates 50 | yrs <- as.numeric(substr(dts, 1, 4)) 51 | dys <- as.numeric(substr(dts, 5, 7)) 52 | 53 | ## initialize parallel cluster and export required objects 54 | cl <- parallel::makePSOCKcluster(cores) 55 | on.exit(parallel::stopCluster(cl)) 56 | 57 | parallel::clusterExport(cl, c("x", "yrs", "dys"), envir = environment()) 58 | 59 | ## loop over layers 60 | rfm <- do.call( 61 | raster::stack, 62 | parallel::parLapply(cl, 1:raster::nlayers(x), function(i) { 63 | # get doy values 64 | rst <- raster::subset(x, i) 65 | val <- raster::getValues(rst) 66 | 67 | 68 | # if required (i.e., if file date and pixel-based doy differ by more than 69 | # 300 days), add +1 to year information of the respective pixel 70 | yr <- rep(yrs[i], length(val)) 71 | 72 | dff <- unique(val) - dys[i] 73 | 74 | if (any(dff < (-300), na.rm = TRUE)) { 75 | ids <- which(dff < (-300)) 76 | nxt <- unique(val)[ids] 77 | 78 | ids <- which(val %in% nxt) 79 | yr[ids] <- yr[ids] + 1 80 | } 81 | 82 | # insert new date values into raster layer 83 | val <- formatC(val, width = 3, flag = "0") 84 | val <- suppressWarnings(as.integer(paste0(yr, val))) 85 | raster::setValues(rst, val) 86 | }) 87 | ) 88 | 89 | ## if length(x) == 1, return 'RasterLayer' 90 | if (raster::nlayers(rfm) == 1) { 91 | rfm[[1]] 92 | ## else return 'RasterStack' 93 | } else { 94 | rfm 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /R/MODISswath/FUSION_CloudCeck_MxD02_s2g.R: -------------------------------------------------------------------------------- 1 | # Purose: 2 | # get into csv table (output of "Fusion_CloudCheck.R" and resample MxD02xkm to grid 3 | # 4 | ###### 5 | library(raster) 6 | library(RCurl) 7 | library(PBSmapping) 8 | ###### 9 | useExt <- T # (if exist) use Extension file: "EXTENT_1ULlat_2ULlon_3LRlat_4LRlon.txt" 10 | Proj <- "UTM"# proj of output 11 | Zone <- "33" # 12 | RT <- "CC" # resampletype NN, CC, BI 13 | 14 | ################################### 15 | ### Parameter input 16 | ###################### 17 | # personal setting: 18 | if (.Platform$OS.type == "unix"){ 19 | #HEG <- "/usr/share/HEG/bin/" 20 | wrkdr <- "/home/matteo/Desktop/FUSIO_CloudCheck/MODIS_clF_2009/" 21 | } else { 22 | #HEG <- "c:\\Programme\\heg\\HEG_Win\\bin\\" 23 | wrkdr <- "D:\\Fusion\\" 24 | } 25 | setwd(wrkdr) 26 | ###### 27 | AOIpol <- importPolys("/home/matteo/Desktop/FUSIO_CloudCheck/AOIset_Marchfeld.txt") 28 | r <- raster("/home/matteo/Desktop/NDVI_2009_stack.img") 29 | allEx<- extent(r) 30 | 31 | av <- read.csv2("MOD35_statsTable.csv") 32 | 33 | for(i in 33:53){ # 1:nrows(av) # for all 34 | 35 | todo <- av[i,] 36 | 37 | MxD03 <- as.character(todo[2][[1]]) 38 | subM03 <- strsplit(MxD03,"\\.")[[1]] 39 | 40 | plf <- substr(subM03[1],2,2) 41 | if (plf == "Y") {plf <- "MYD"} else {plf <- "MOD"} 42 | rootn <- paste(subM03[2:4],sep="",collapse=".") 43 | splroot <- strsplit(rootn,"\\.")[[1]] 44 | vers <- splroot[3] 45 | year <- substr(splroot[1],2,5) 46 | doy <- substr(splroot[1],6,8) 47 | 48 | MxD03Dr <- paste(plf,"03/",sep="") 49 | MxD02Dr <- "MODIS_02_hdfs/" 50 | MxD02Nam <- grep(dir(paste(getwd(),'/',MxD02Dr,sep="")),pattern=paste(plf,"02QKM.",rootn,".*",sep=""),value=T) 51 | strMxD02Nam <- strsplit(MxD02Nam,"\\.")[[1]] 52 | 53 | ####### 54 | outDir <- paste(getwd(),"/",plf,"02Grid/",sep="") 55 | dir.create(outDir,showWarnings = FALSE) 56 | 57 | MRT <- paste(getwd(),'/MRTkicker.prm',sep='') 58 | filename = file(MRT, open='wt') 59 | 60 | write(paste('INPUT_FILENAME = ',getwd(),'/',MxD02Dr,MxD02Nam,sep=''), filename) 61 | write(paste('GEOLOCATION_FILENAME = ',getwd(),'/',MxD03Dr,MxD03,sep=''),filename) 62 | write(paste('INPUT_SDS_NAME = EV_250_RefSB, 0,1',sep=''),filename) 63 | write(paste('OUTPUT_SPATIAL_SUBSET_TYPE = LAT_LONG',sep=''),filename) 64 | write(paste('OUTPUT_SPACE_UPPER_LEFT_CORNER (LONG LAT) = ',min(AOIpol[,'X']),' ',max(AOIpol[,'Y']),sep=''),filename) 65 | write(paste('OUTPUT_SPACE_LOWER_RIGHT_CORNER (LONG LAT) = ',max(AOIpol[,'X']),' ',min(AOIpol[,'Y']),sep=''),filename) 66 | write(paste('OUTPUT_FILENAME = ',outDir,plf,'02G_',rootn,'_',RT,'.tif',sep=''),filename) 67 | write(paste('OUTPUT_FILE_FORMAT = GEOTIFF_FMT',sep=''),filename) 68 | write(paste('KERNEL_TYPE (CC/BI/NN) = ',RT,sep=''),filename) 69 | write(paste('OUTPUT_PROJECTION_NUMBER = ',Proj,sep=''),filename) 70 | write(paste('OUTPUT_PROJECTION_PARAMETER = 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0',sep=''),filename) 71 | write(paste('OUTPUT_PROJECTION_SPHERE = 8',sep=''),filename) 72 | write(paste('OUTPUT_PROJECTION_ZONE = ',Zone,sep=''),filename) 73 | close(filename) 74 | 75 | system(paste('swath2grid -pf=',MRT,sep='')) # extract MxD35 76 | } 77 | 78 | 79 | #system(paste('read_sds_attributes ',getwd(),'/',MxD02Dr,MxD02Nam,sep='')) 80 | 81 | -------------------------------------------------------------------------------- /inst/tinytest/test-getTile.R: -------------------------------------------------------------------------------- 1 | ### . points ---- 2 | 3 | data(meuse, package = "sp") 4 | pts = sf::st_as_sf(meuse, coords = c("x", "y"), crs = 28992) 5 | 6 | tls_pt = getTile(pts[1, ]) 7 | 8 | expect_null( 9 | tls_pt@target$extent 10 | , info = "target extent defaults to full tile for single point feature" 11 | ) 12 | 13 | expect_true( 14 | inherits(getTile(pts[1:2, ])@target$extent, "Extent") 15 | , info = "target extent inherited from multi-point feature is of class 'Extent'" 16 | ) 17 | 18 | 19 | ### . rasters ---- 20 | 21 | data(meuse.grid, package = "sp") 22 | x = sf::st_as_sf( 23 | meuse.grid 24 | , coords = c("x", "y") 25 | ) 26 | 27 | rst = raster::raster( 28 | sf::st_as_sf( 29 | sf::st_make_grid( 30 | x 31 | ) 32 | ) 33 | ) 34 | 35 | ## raster with no crs and invalid latlon coords 36 | expect_error( 37 | getTile(rst) 38 | , pattern = "assign a valid CRS" 39 | , info = "rasters lacking crs and with invalid coordinates produce an error" 40 | ) 41 | 42 | ## raster with valid crs 43 | suppressWarnings( 44 | raster::projection(rst) <- "+init=epsg:28992" 45 | ) 46 | trgt = getTile(rst)@target 47 | 48 | expect_true( 49 | inherits(trgt$extent, "Extent") 50 | , info = "target extent inherited from raster is of class 'Extent'" 51 | ) 52 | 53 | expect_identical( 54 | trgt$extent 55 | , target = raster::extent(rst) 56 | , info = "target extent is inherited from raster" 57 | ) 58 | 59 | expect_equivalent( 60 | trgt$outProj 61 | , target = sf::st_crs(rst) 62 | , info = "target crs is inherited from raster" 63 | ) 64 | 65 | expect_equivalent( 66 | trgt$pixelSize 67 | , target = raster::res(rst) 68 | , info = "target resolution is inherited from raster" 69 | ) 70 | 71 | ## raster with no crs, but valid latlon coords 72 | rst_ll = raster::projectRaster(rst, crs = "+init=epsg:4326") 73 | raster::projection(rst_ll) = NA 74 | 75 | expect_true( 76 | inherits(getTile(rst_ll), "MODISextent") 77 | , info = "rasters lacking crs and with valid coordinates produce regular output" 78 | ) 79 | 80 | 81 | ### spherical geometry w/o s2 ---- 82 | 83 | ## sample data 84 | spain = map( 85 | "worldHires" 86 | , "Spain" 87 | , fill = TRUE 88 | , plot = FALSE 89 | ) 90 | 91 | Up = sf::st_as_sf( 92 | spain 93 | , quiet = TRUE 94 | ) 95 | 96 | expect_true( 97 | any( 98 | !sf::st_is_valid( 99 | Up 100 | ) 101 | ) 102 | , info = "sample data for testing spherical geometry w/o s2 is invalid" 103 | ) 104 | 105 | expect_inherits( 106 | getTile(Up) 107 | , class = "MODISextent" 108 | , info = "not using s2 for geometries with ellipsoidal coordinates succeeds" 109 | ) 110 | 111 | 112 | ### 'sfc' ---- 113 | 114 | expect_identical( 115 | getTile( 116 | sf::st_as_sfc( 117 | pts 118 | )[1] 119 | ) 120 | , target = tls_pt 121 | , info = "inputs with 'sfc' signature create same output as 'sf' analogs" 122 | ) 123 | 124 | expect_inherits( 125 | getTile( 126 | sf::st_as_sfc( 127 | subset( 128 | MODIS:::sr 129 | , h == 21L & v == 9L 130 | ) 131 | ) 132 | ) 133 | , class = "MODISextent" 134 | , info = "also works with 'sfc_POLYGON' input" 135 | ) 136 | -------------------------------------------------------------------------------- /R/genTile.R: -------------------------------------------------------------------------------- 1 | #' Generate Global Tiling System 2 | #' 3 | #' @description 4 | #' This function generates a matrix with bounding box information for a global 5 | #' tiling system (based on Lat/Lon). 6 | #' 7 | #' @param tileSize `numeric`, size of a single tile in degrees (EPSG:4326). 8 | #' @param offset `numeric`, shifts the tiling system in upper-left direction. 9 | #' @param StartNameFrom `numeric`. `c(Lat-Direction,Lon-Direction)` start number 10 | #' in the naming of the tiles. 11 | #' @param extent `list`. Tile system extent information, basically the coverage 12 | #' of the data on server. 13 | #' 14 | #' @return 15 | #' A `matrix`. 16 | #' 17 | #' @author 18 | #' Matteo Mattiuzzi 19 | #' 20 | #' @seealso 21 | #' [getTile()]. 22 | #' 23 | #' @examples 24 | #' # 1x1 degree tiling system 25 | #' e1 <- genTile() 26 | #' head(e1) 27 | #' 28 | #' # 10x10 degree tiling system with offset to be aligned to Geoland2 Dataset 29 | #' e2 <- genTile(tileSize = 10, offset = (1/112) / 2) 30 | #' head(e2) 31 | #' 32 | #' # Tiling system for SRTMv4 data (CGIAR-CSI) 33 | #' e3 <- genTile(tileSize = 5, StartNameFrom = c(1, 1), 34 | #' extent = list(xmin = -180, xmax = 180, ymin = -60,ymax = 60)) 35 | #' head(e3) 36 | #' 37 | #' @export genTile 38 | #' @name genTile 39 | genTile <- function(tileSize = 1, offset = 0, StartNameFrom = c(0, 0), 40 | extent = list(xmin = -180, xmax = 180, ymin = -90, ymax = 90)) 41 | { 42 | 43 | # offset is used in case of pixel centrum reference. In such case the offset is res/2 44 | if (offset!=0) {cat("Warning! Tiles crossing LAT extremas (-90 and +90) are not meaningful for now! For those tiles the resulting shift in LON is not computed!\n")} 45 | 46 | # set origin in UL 47 | LON <- seq(extent$xmin,extent$xmax,by=tileSize) 48 | LON <- LON[-length(LON)] 49 | LAT <- seq(extent$ymax,extent$ymin,by=-tileSize) 50 | LAT <- LAT[-length(LAT)] 51 | 52 | LON <- LON - offset 53 | LAT <- LAT + offset 54 | 55 | tiles <- expand.grid(LON,LAT) 56 | colnames(tiles) <- c("xmin","ymax") 57 | 58 | iv <- (0:(length(LON)-1)) + StartNameFrom[2] 59 | ih <- (0:(length(LAT)-1)) + StartNameFrom[1] 60 | 61 | vh <- expand.grid(iv,ih) 62 | tiles$iv <- vh[,2] 63 | tiles$ih <- vh[,1] 64 | 65 | tiles$xmax <- tiles$xmin + tileSize 66 | tiles$ymin <- tiles$ymax - tileSize 67 | 68 | tiles[tiles$xmin < -180,"xmin"] <- tiles[tiles$xmin < -180,"xmin"] + 2*180 69 | tiles[tiles$xmin > 180,"xmin"] <- tiles[tiles$xmin > 180,"xmin"] - 2*180 70 | tiles[tiles$xmax < -180,"xmax"] <- tiles[tiles$xmax < -180,"xmax"] + 2*180 71 | tiles[tiles$xmax > 180,"xmax"] <- tiles[tiles$xmax > 180,"xmax"] - 2*180 72 | 73 | #TODO: EXTREMAS IN LAT are changing LON +- 180 74 | # tiles[tiles[,"lat"] < -90,"lon"] <- tiles[tiles[,"lat"] < -90,"lon"] + 180 # 75 | tiles[tiles$ymax < -90,"ymax"] <- -90 + abs(90 + tiles[tiles$ymax < -90,"ymax"]) 76 | tiles[tiles$ymax > 90,"ymax"] <- (2*90) - tiles[tiles$ymax > 90,"ymax"] 77 | tiles[tiles$ymin < -90,"ymin"] <- -90 + abs(90 + tiles[tiles$ymin < -90,"ymin"]) 78 | tiles[tiles$ymin > 90,"ymin"] <- (2*90) - tiles[tiles$ymin > 90,"ymin"] 79 | 80 | tiles <- tiles[,c(3,4,1,2,5,6)] 81 | return(tiles) 82 | } 83 | 84 | -------------------------------------------------------------------------------- /man/orgTime.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/orgTime.R 3 | \name{orgTime} 4 | \alias{orgTime} 5 | \alias{orgTime,character-method} 6 | \alias{orgTime,Date-method} 7 | \alias{orgTime,Raster-method} 8 | \title{Handle Input and Output Dates Used for Filtering} 9 | \usage{ 10 | \S4method{orgTime}{character}( 11 | files, 12 | nDays = "asIn", 13 | begin = NULL, 14 | end = NULL, 15 | pillow = 75, 16 | pos1, 17 | pos2, 18 | format = "\%Y\%j" 19 | ) 20 | 21 | \S4method{orgTime}{Date}(files, nDays = "asIn", begin = NULL, end = NULL, pillow = 75) 22 | 23 | \S4method{orgTime}{Raster}( 24 | files, 25 | nDays = "asIn", 26 | begin = NULL, 27 | end = NULL, 28 | pillow = 75, 29 | pos1, 30 | pos2, 31 | format = "\%Y\%j" 32 | ) 33 | } 34 | \arguments{ 35 | \item{files}{A \code{character}, \code{Date}, or \verb{Raster*} object. Typically MODIS file 36 | names created e.g. from \code{\link[=runGdal]{runGdal()}} or \code{\link[=runMrt]{runMrt()}}, but any other file names 37 | holding date information are supported as well. If a \verb{Raster*} object is 38 | supplied, make sure to adjust 'pos1', 'pos2', and 'format' according to its 39 | layer \code{\link[raster:names]{raster::names()}}.} 40 | 41 | \item{nDays}{Time interval for output layers. Defaults to \code{"asIn"} that 42 | includes the exact input dates within the period selected using 'begin' and 43 | 'end'. Can also be \code{"1 month"} or \code{"1 week"}, see \code{\link[=seq.Date]{seq.Date()}} and 44 | Examples.} 45 | 46 | \item{begin}{\code{character}. Output begin date, defaults to the earliest input 47 | data set.} 48 | 49 | \item{end}{\code{character}. Output end date, defaults to the latest input data 50 | set. Note that the exact end date depends on 'begin' and 'nDays'.} 51 | 52 | \item{pillow}{\code{integer}. Number of days added to the beginning and end of a 53 | time series.} 54 | 55 | \item{pos1, pos2, format}{Arguments passed to \code{\link[=extractDate]{extractDate()}}.} 56 | } 57 | \value{ 58 | A \code{list} with the following slots (to be completed): 59 | \itemize{ 60 | \item $inSeq 61 | \item $outSeq 62 | \item $inDoys 63 | \item $inputLayerDates 64 | \item $outputLayerDates 65 | \item $call 66 | } 67 | } 68 | \description{ 69 | This function lets you define the period to be filtered, the output temporal 70 | resolution, and select the required data from your input files. 71 | } 72 | \examples{ 73 | # Using MODIS files 74 | files <- c("MOD13A2.A2010353.1_km_16_days_composite_day_of_the_year.tif", 75 | "MOD13A2.A2011001.1_km_16_days_composite_day_of_the_year.tif", 76 | "MYD13A2.A2010361.1_km_16_days_composite_day_of_the_year.tif", 77 | "MYD13A2.A2011009.1_km_16_days_composite_day_of_the_year.tif") 78 | 79 | orgTime(files) 80 | orgTime(files,nDays=2,begin="2010350",end="2011015") 81 | 82 | # Using other files, e.g. from AVHRR GIMMS NDVI (Jul 1981 to Dec 1982) 83 | \dontrun{ 84 | library(gimms) 85 | 86 | files.v1 <- system.file("extdata/inventory_ecv1.rds", package = "gimms") 87 | files.v1 <- readRDS(files.v1)[1:3] 88 | dates.v1 <- monthlyIndices(files.v1, timestamp = TRUE) 89 | 90 | orgTime(dates.v1) 91 | } 92 | 93 | } 94 | \seealso{ 95 | \code{\link[=seq.Date]{seq.Date()}}. 96 | } 97 | \author{ 98 | Matteo Mattiuzzi, Florian Detsch 99 | } 100 | -------------------------------------------------------------------------------- /R/transDate.R: -------------------------------------------------------------------------------- 1 | #' MODIS Date Conversion and Testing 2 | #' 3 | #' @description 4 | #' This function converts a sequence of input dates to 'YYYY-MM-DD' and 5 | #' 'YYYYDDD'. 6 | #' 7 | #' @param begin,end `Date` or `character`. Begin and end date of MODIS time 8 | #' series, see Note. If not provided, this defaults to `"1972-01-01"` and 9 | #' [Sys.Date()], respectively. 10 | #' 11 | #' @return 12 | #' A `list` of begin and end dates formatted according to 'YYYY-MM-DD' (first 13 | #' two slots; class `Date`) and 'YYYYDDD' (second two slots; class `character`). 14 | #' 15 | #' @note 16 | #' If input dates are supplied as `character`, this function either expects 17 | #' 7-digit strings in the MODIS intrinsic form `'\%Y\%j'` or, alternatively, 18 | #' 10-digit strings in the form `'\%Y-\%m-\%d'` where the two field separators 19 | #' need to be uniform (see Examples). 20 | #' 21 | #' @seealso [strptime()]. 22 | #' 23 | #' @author 24 | #' Matteo Mattiuzzi, Florian Detsch 25 | #' 26 | #' @examples 27 | #' transDate() 28 | #' transDate(begin = "2009.01.01") # ends with current date 29 | #' transDate(end = "2009.01.01") # starts with Landsat 1 30 | #' transDate(begin = c("2009-01-01", "2010-01-01"), end = "2011.03.16") 31 | #' 32 | #' @export transDate 33 | #' @name transDate 34 | transDate <- function(begin = NULL, end = NULL) { 35 | 36 | begin <- if (inherits(begin, "Date")) { 37 | format(begin, "%Y.%m.%d") 38 | } else if (is.null(begin)) { 39 | "1972.01.01" # start with Landsat 1 40 | } else begin 41 | 42 | end <- if (inherits(end, "Date")) { 43 | format(end, "%Y.%m.%d") 44 | } else if (is.null(end)) { 45 | format(Sys.Date(), "%Y.%m.%d") # current date 46 | } else end 47 | 48 | ## if 'begin' dates come in '%Y%j' format, reformat to '%Y.%m.%d' 49 | if (any(nchar(begin) == 7)) { 50 | 51 | # if all 'begin' dates have the same format, proceed 52 | if (all(nchar(begin) == 7)) { 53 | begin <- strftime(as.Date(begin, "%Y%j"), "%Y.%m.%d") 54 | 55 | # else throw error 56 | } else { 57 | stop("Input dates are required to have the same format (e.g., '%Y%j').\n") 58 | } 59 | } 60 | 61 | ## same as above, but for 'end' dates 62 | if (any(nchar(end) == 7)) { 63 | 64 | if (all(nchar(end) == 7)) { 65 | end <- strftime(as.Date(end,"%Y%j"),"%Y.%m.%d") 66 | 67 | } else { 68 | stop("Input dates are required to have the same format (e.g., '%Y%j').\n") 69 | } 70 | } 71 | 72 | divisor <- substr(begin,5,5) 73 | begin <- as.Date(begin, format = paste0("%Y", divisor, "%m", divisor, "%d")) 74 | if (any(is.na(begin))) 75 | stop("'begin' date is either in a wrong format or an invalid date.\n") 76 | 77 | divisor <- substr(end,5,5) 78 | end <- as.Date(end,format=paste("%Y",divisor,"%m",divisor,"%d",sep="")) 79 | if (any(is.na(end))) 80 | stop("'end' date is either in a wrong format or an invalid date.\n") 81 | 82 | if (any(end < begin)) { 83 | warning("'begin' and 'end' dates seem to be confused, reordering dates...\n") 84 | dts <- sort(c(begin, end)) 85 | begin <- dts[1:(length(dts) - 1)] 86 | end <- dts[length(dts)] 87 | } 88 | 89 | beginDOY <- format(as.Date(begin,format="%Y.%m.%d"), "%Y%j") 90 | endDOY <- format(as.Date(end,format="%Y.%m.%d"), "%Y%j") 91 | 92 | return(list(begin=begin,end=end,beginDOY=beginDOY,endDOY=endDOY)) 93 | } 94 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # **MODIS**: Acquisition and Processing of MODIS Products 2 | 3 | ⚠️ **Note:** The `MODIS` package is currently not fully functional due to recent 4 | changes in authentication mechanisms at LP DAAC and LAADS (Earthdata Login and 5 | token-based access). While some core features may still work, automated 6 | downloading and processing are affected. Users working with MODIS data are 7 | encouraged to explore alternative packages listed below. 8 | 9 | ## 🔍 Related and Similar Packages 10 | 11 | While the `MODIS` package provides an integrated workflow for discovering, 12 | downloading, mosaicking, and processing MODIS satellite data, users may also 13 | find value in the following actively maintained alternatives—especially for 14 | workflows requiring compatibility with newer versions of R: 15 | 16 | ### [`MODISTools`](https://github.com/sntck/MODISTools) 17 | - **Focus:** Efficient access to MODIS subsets via the ORNL DAAC web service 18 | (MODIS Subsets API). 19 | - **Highlights:** Streamlined for point-based time series extraction (e.g., 20 | vegetation indices at specific locations). Ideal for ecological or 21 | site-based studies. 22 | - **Limitations:** Does not support full-tile downloading or mosaicking of 23 | spatial rasters. 24 | 25 | ### [`MODIStsp`](https://github.com/ropensci/MODIStsp) 26 | - **Focus:** GUI and command-line tool for pre-processing MODIS time series. 27 | - **Highlights:** Provides a user-friendly interface (also scriptable) to 28 | automate downloading, reprojecting, mosaicking, and time series creation. 29 | - **Best for:** Batch processing of MODIS raster products across time and 30 | space with minimal coding. 31 | 32 | ### [`rsat`](https://github.com/ropensci/rsat) 33 | - **Focus:** General framework for working with remote sensing time series 34 | from multiple platforms. 35 | - **Highlights:** MODIS is supported alongside Sentinel, Landsat, and others. 36 | Designed for harmonized, cross-sensor workflows. 37 | - **Best for:** Projects integrating MODIS with other remote sensing data 38 | sources in a unified workflow. 39 | 40 | ### [`rspatial.org` MODIS Guide](https://rspatial.org/modis/2-download.html) 41 | - **Focus:** Educational resource demonstrating MODIS data download and 42 | pre-processing using base R and `terra`. 43 | - **Highlights:** Teaches how to manually script MODIS data access and 44 | preparation. Good for learning fundamentals and customizing your own 45 | pipeline. 46 | 47 | --- 48 | 49 | If you continue to rely on `MODIS` for legacy workflows or specific utilities, 50 | we recommend documenting your environment carefully and checking for ongoing 51 | support issues (e.g., via GitHub). For new projects, consider evaluating the 52 | packages above to ensure long-term maintainability. 53 | 54 | 55 | ==== 56 | 57 | ### Package downloads 58 | 59 | This month | In total 60 | --------------- | ----------- 61 | ![month](http://cranlogs.r-pkg.org/badges/MODIS) | ![total](http://cranlogs.r-pkg.org/badges/grand-total/MODIS) 62 | 63 | 64 | ==== 65 | 66 | ### Installation 67 | 68 | **MODIS** can be installed via 69 | 70 | 71 | ```r 72 | remotes::install_github("fdetsch/MODIS") 73 | ``` 74 | 75 | 76 | ==== 77 | 78 | ### Additional resources 79 | 80 | * https://stevemosher.wordpress.com/modis-tutorial/ 81 | * https://cornelllabofornithology.github.io/ebird-best-practices/covariates.html#covariates-dl 82 | 83 | 84 | ==== 85 | 86 | ### Contact 87 | 88 | Please file bug reports and feature requests at https://github.com/fdetsch/MODIS/issues. 89 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | longer term changes: 2 | - reduce the capability of functions eg: 3 | completely separate getHdf from runGdal (also getProduct, getCollection etc should be removed from those functions. 4 | This should allow runGdal to run in a more general manner like a input file list that is crunched. This should result in some more lines to code when using runGdal but is also allows more freedom and performance. AND last but not least at all also much easier handling of the package development. 5 | MOD and MYD should still be run by one call, but not eg: MxD13A1 and MxD13A2. This change would simplify a lot the package development. 6 | - I was quite good to avoid the creation of classes, I am not sure if we really need it...maybe yes? S3 should be enough I guess? 7 | - Accelerate 'Downloading structure on ...' 8 | - Any file in 'inst/external' no longer required? 9 | - get rid of certain dependencies 10 | 11 | detectBitInfo() 12 | - recent products supported? (see whittaker.raster) 13 | - update QA information in look-up table 14 | - implement quality control routines for various products? 15 | 16 | MODISoptions() 17 | - Check for presence of .netrc file (<-> LP DAAC, LAADS, NSIDC support) 18 | 19 | runGdal() 20 | - an 'HdfName' argument (just like in getHdf()) could be of advantage in the 21 | sense that if one (or numerous) local .hdf file is specified, an online 22 | retrieval (of collection, available dates, etc.) is entirely turned off 23 | - include scale factor during SDS extraction? 24 | - speed up when downloaded hdf / processed tif files are already present 25 | 26 | qualityControl 27 | - method based on maximum value from preceding / current / succeeding image (i.e., from user-defined window) as proposed by Yang et al. (2013, http://dx.doi.org/10.1109/LGRS.2012.2219576) 28 | 29 | whittaker.raster() 30 | - set (optional) thresholds to get rid of too high or low (i.e., outside [-1;1]) values resulting from smoothing spline 31 | - output file names not in agreement with MODIS naming convention (i.e., timestamps start/end at the 5th/11th position rather than 15th/21st) 32 | 33 | getHdf(): 34 | - download is not possible for Swath products, see eg. https://github.com/fdetsch/MODIS/issues/18 35 | 36 | getGranule(): 37 | - tileH,tileV 38 | - remaining 'extent' inputs (sf::st_bbox, MODISextent, character, Raster*, missing) 39 | 40 | getCollection(): 41 | - retrieval from LAADS (ie. MOD03), particularly during LPDAAC downtime 42 | 43 | Automated wget, curl check if any("LPDAAC", "NSIDC") %in% opts$MODISserverOrder 44 | 45 | General solution for "//" 46 | 47 | Save MODIS Sinusoidal proj4 string somewhere: +proj=sinu +lon_0=0 +x_0=0 +y_0=0 +R=6371007.181 +units=m +no_defs 48 | 49 | getStruc(): 50 | - if specified, restrict to dates 51 | 52 | getTile(): 53 | - if interactive and `mode = "draw"`, handle errors for incomplete shapes 54 | - if non-interactive, display aoi 55 | 56 | separate issues 57 | * decide fate of `arcStats()` 58 | * feed non-existing collection in `list` format to `getCollection()` and handle 59 | 'Error in cat([...])' 60 | 61 | Assertion on `MODISoptions()`, e.g. valid entries for 'MODISserverOrder' 62 | 63 | curl installed with {curl} package? 64 | <-> would render `system('curl -h')` calls and testing for wget obsolete 65 | --> test in docker environment 66 | 67 | find appropriate place for `EarthdataLogin()` if usr and/or pwd is missing 68 | 69 | streamline `getStruc()` 70 | <-> currently run in `runGdal()` and, under the hood, `getHdf()` 71 | 72 | leverage `gdalwarp` -wo functionality (https://gdal.org/programs/gdalwarp.html#cmdoption-gdalwarp-wo) 73 | 74 | put deprecated functions on defunct 75 | 76 | runGdal(): 77 | * [x] file name in 'Getting file from: LPDAAC' 78 | * [x] optionally turn off 'maskValue', i.e. "None" in `gdalwarp` 79 | (https://gdal.org/programs/gdalwarp.html#cmdoption-gdalwarp-srcnodata) 80 | * [x] check if '-dstnodata' is required -------------------------------------------------------------------------------- /R/temporalComposite.R: -------------------------------------------------------------------------------- 1 | #' Calculate MODIS Composite Images 2 | #' 3 | #' @description 4 | #' Based on a user-defined function, e.g. [max()] for maximum value composites 5 | #' (MVC), aggregate native 16-day MODIS data sets to custom temporal composites. 6 | #' 7 | #' @param x `Raster*` or `character`. MODIS composite data set with an 8 | #' associated "composite_day_of_the_year" SDS, e.g. all vegetation indices 9 | #' products (MOD13). 10 | #' @param y `Raster*` or `character`. MODIS "composite_day_of_the_year" SDS 11 | #' associated with 'x'. 12 | #' @param timeInfo `Date` vector corresponding to all input layers. If not 13 | #' further specified, this is tried to be created through invoking 14 | #' [extractDate()] upon 'x', assuming standard MODIS file names. 15 | #' @param interval `character`. Time period for aggregation, see 16 | #' [aggInterval()]. 17 | #' @param fun,na.rm `function`. See [raster::overlay()]. 18 | #' @param cores `integer`. Number of cores for parallel processing. 19 | #' @param filename `character`. Optional output file name. 20 | #' @param ... Additional arguments passed to [raster::writeRaster()]. 21 | #' 22 | #' @return A `Raster*` object. 23 | #' 24 | #' @author 25 | #' Florian Detsch 26 | #' 27 | #' @seealso 28 | #' [aggInterval()], [raster::calc()], [raster::writeRaster()]. 29 | #' 30 | #' @examples 31 | #' \dontrun{ 32 | #' library(mapview) 33 | #' frc <- as(subset(franconia, district == "Mittelfranken"), "Spatial") 34 | #' tfs <- runGdal("MOD13A1", begin = "2015001", end = "2016366", extent = frc, 35 | #' job = "temporalComposite", SDSstring = "100000000010") 36 | #' 37 | #' ndvi <- sapply(tfs[[1]], "[[", 1) 38 | #' cdoy <- sapply(tfs[[1]], "[[", 2) 39 | #' 40 | #' mmvc <- temporalComposite(ndvi, cdoy) 41 | #' plot(mmvc[[1:4]]) 42 | #' } 43 | #' 44 | #' @export temporalComposite 45 | #' @name temporalComposite 46 | temporalComposite <- function(x, y, 47 | timeInfo = extractDate(x, asDate = TRUE)$inputLayerDates, 48 | interval = c("month", "year", "fortnight"), 49 | fun = max, na.rm = TRUE, 50 | cores = 1L, filename = "", ...) { 51 | 52 | if (inherits(x, "character")) { names(x) <- NULL; x <- raster::stack(x) } 53 | if (inherits(y, "character")) { names(y) <- NULL; y <- raster::stack(y) } 54 | 55 | ## append year to "composite_day_of_the_year" 56 | y <- reformatDOY(y, cores = cores) 57 | 58 | ## create half-monthly time series 59 | dates_seq <- aggInterval(timeInfo, interval[1]) 60 | 61 | ## initialize parallel cluster with required variables 62 | cl <- parallel::makePSOCKcluster(cores) 63 | on.exit(parallel::stopCluster(cl)) 64 | 65 | parallel::clusterExport(cl, c("x", "y", "fun", "na.rm", "timeInfo", "dates_seq"), 66 | envir = environment()) 67 | 68 | ## generate temporal composites 69 | lst_seq <- parallel::parLapply(cl, 1:length(dates_seq$begin), function(i) { 70 | dff <- timeInfo - dates_seq$begin[i] 71 | ids <- which(dff <= 16 & dff >= (-16)) 72 | 73 | if (length(ids) == 0) 74 | return(NULL) 75 | 76 | lst <- lapply(ids, function(j) { 77 | doy <- raster::getValues(raster::subset(y, j)) 78 | out <- which(doy < dates_seq$beginDOY[i] | doy > dates_seq$endDOY[i]) 79 | 80 | val <- raster::getValues(raster::subset(x, j)) 81 | val[out] <- NA 82 | raster::setValues(raster::subset(x, j), val) 83 | }) 84 | 85 | rst <- if (length(lst) == 1) { 86 | lst[[1]] 87 | } else { 88 | rst <- raster::stack(lst) 89 | suppressWarnings(rst <- raster::calc(rst, fun = fun, na.rm = na.rm)) 90 | } 91 | names(rst) <- paste0("A", dates_seq$beginDOY[i]) 92 | return(rst) 93 | }) 94 | 95 | ids <- !sapply(lst_seq, is.null) 96 | rst_seq <- raster::stack(lst_seq[ids]) 97 | 98 | ## write to disk (optional) 99 | if (nchar(filename) > 0) 100 | rst_seq <- raster::writeRaster(rst_seq, filename, ...) 101 | 102 | return(rst_seq) 103 | } 104 | -------------------------------------------------------------------------------- /man/getHdf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getHdf.R 3 | \name{getHdf} 4 | \alias{getHdf} 5 | \alias{getHdf,character-method} 6 | \alias{getHdf,missing-method} 7 | \title{Create or Update Local Subset of Online MODIS Data Pool} 8 | \usage{ 9 | \S4method{getHdf}{character}( 10 | product, 11 | HdfName, 12 | begin = NULL, 13 | end = NULL, 14 | tileH, 15 | tileV, 16 | extent, 17 | collection = NULL, 18 | checkIntegrity = TRUE, 19 | forceDownload = TRUE, 20 | ... 21 | ) 22 | 23 | \S4method{getHdf}{missing}(HdfName, checkIntegrity = TRUE, ...) 24 | } 25 | \arguments{ 26 | \item{product}{\code{character}. MODIS grid product to be downloaded, see 27 | \code{\link[=getProduct]{getProduct()}}.} 28 | 29 | \item{HdfName}{\code{character} vector or \code{list}. Full HDF file name(s) to 30 | download a small set of files. If specified, other file-related parameters 31 | (e.g., 'begin', 'end', 'collection', etc.) are ignored.} 32 | 33 | \item{begin, end}{\code{Date} or \code{character}. Begin and end date of MODIS time 34 | series, see \code{\link[=transDate]{transDate()}}.} 35 | 36 | \item{tileH, tileV}{\code{numeric} or \code{character}. Horizontal and vertical tile 37 | number, see \code{\link[=getTile]{getTile()}}.} 38 | 39 | \item{extent}{See Details in \code{\link[=getTile]{getTile()}}.} 40 | 41 | \item{collection}{Desired MODIS product collection as \code{character}, \code{integer}, 42 | or \code{list} as returned by \code{\link[=getCollection]{getCollection()}}.} 43 | 44 | \item{checkIntegrity}{\code{logical}. If \code{TRUE} (default), the size of each 45 | downloaded file is checked. In case of inconsistencies, the function tries 46 | to re-download broken files.} 47 | 48 | \item{forceDownload}{\code{logical}. If \code{TRUE} (default), try to download data 49 | irrespective of whether online information could be retrieved via 50 | \code{MODIS:::getStruc} or not.} 51 | 52 | \item{...}{Further arguments passed to \code{\link[=MODISoptions]{MODISoptions()}}, e.g. 'wait'.} 53 | } 54 | \value{ 55 | An invisible vector of downloaded data and paths. 56 | } 57 | \description{ 58 | Create or update a local user-defined subset of the global MODIS grid data 59 | archive. Based on user-specific parameters the function checks in the local 60 | archive for available data and downloads missing data from the online MODIS 61 | data pool. When run in a schedule job, the function manage the continuous 62 | update of the local MODIS data archive. 63 | } 64 | \examples{ 65 | \dontrun{ 66 | # One or more specific file (no regular erpression allowed here) 67 | a <- getHdf(HdfName = c("MYD11A1.A2009001.h18v04.006.2015363221538.hdf", 68 | "MYD11A1.A2009009.h18v04.006.2015364055036.hdf", 69 | "MYD11A1.A2009017.h18v04.006.2015364115403.hdf")) 70 | a 71 | 72 | # Get all MODIS Terra and Aqua M*D11A1 data from the past 30 days 73 | # (can be run in a scheduled job for regular archive update) 74 | b1 <- getHdf(product = "M.D13A2", begin = Sys.Date() - 30, 75 | tileH = 18:19, tileV = 4) 76 | b1 77 | 78 | # Same tiles with a 'list' extent 79 | Austria <- extent(9.2, 17.47, 46.12, 49.3) 80 | b2 <- getHdf(product = "MOD13A2", begin = "2020001", end = "2020031", extent = Austria) 81 | b2 82 | 83 | # Using country boarders from 'mapdata' package 84 | c <- getHdf(product = "MOD13A2", begin = "2016180", end = "2016210", 85 | extent = "Luxembourg") 86 | c 87 | 88 | # Interactive selection of spatial extent, see getTile() 89 | d <- getHdf(product = "MOD13A2", begin = "2016180", end = "2016210") 90 | d 91 | } 92 | 93 | } 94 | \references{ 95 | MODIS data is currently available from the online data pools at 96 | \itemize{ 97 | \item NASA Land Processes Distributed Active Archive Center 98 | (\href{https://www.earthdata.nasa.gov/centers/lp-daac}{LP DAAC}), 99 | \item Level-1 and Atmosphere Archive & Distribution System 100 | (\href{https://ladsweb.modaps.eosdis.nasa.gov/}{LAADS}), and 101 | \item National Snow & Ice Data Center (\href{https://nsidc.org/home}{NSIDC}). 102 | } 103 | } 104 | \author{ 105 | Matteo Mattiuzzi 106 | } 107 | -------------------------------------------------------------------------------- /R/aggInterval.R: -------------------------------------------------------------------------------- 1 | #' Create Periods for Temporal Composites 2 | #' 3 | #' @description 4 | #' The creation of custom temporal aggregation levels (e.g., half-monthly, 5 | #' monthly) from native 16-day MODIS composites usually requires the definition 6 | #' of date sequences based on which the "composite_day_of_the_year" SDS is 7 | #' further processed. Complementing [transDate()], which returns the respective 8 | #' start and end date only, this function creates full-year (half-)monthly or 9 | #' annual composite periods from a user-defined temporal range. 10 | #' 11 | #' @param x `Date` object, see e.g. default value of 'timeInfo' in 12 | #' `temporalComposite`. 13 | #' @param interval `character`. Time period for aggregation. Currently 14 | #' available options are `"month"` (default), `"year"` and `"fortnight"` (i.e., 15 | #' every 1st and 15th day of the month). 16 | #' 17 | #' @return 18 | #' A `list` with the following slots: 19 | #' 20 | #' * `$begin`: The start date(s) of each (half-)monthly timestep as 21 | #' `Date` object. 22 | #' * `$end`: Same for end date(s). 23 | #' * `$beginDOY`: Similar to `$begin`, but with `character` objects in 24 | #' MODIS-style date format (i.e., `"%Y%j"`; see [strptime()]). 25 | #' * `$endDOY`: Same for end date(s). 26 | #' 27 | #' @author 28 | #' Florian Detsch 29 | #' 30 | #' @seealso 31 | #' [transDate()]. 32 | #' 33 | #' @examples 34 | #' dates <- do.call("c", lapply(2015:2016, function(i) { 35 | #' start <- as.Date(paste0(i, "-01-01")) 36 | #' end <- as.Date(paste0(i, "-12-31")) 37 | #' seq(start, end, 16) 38 | #' })) 39 | #' 40 | #' intervals <- c("month", "year", "fortnight") 41 | #' lst <- lapply(intervals, function(i) { 42 | #' aggInterval(dates, interval = i) 43 | #' }); names(lst) <- intervals 44 | #' 45 | #' print(lst) 46 | #' 47 | #' @export aggInterval 48 | #' @name aggInterval 49 | aggInterval <- function(x, interval = c("month", "year", "fortnight")) { 50 | 51 | ## date range 52 | rng <- c(min(x), max(x)) 53 | x <- as.numeric(strftime(x, "%Y")) 54 | 55 | 56 | ### monthly or fortnightly aggregation ----- 57 | 58 | if (interval[1] != "year") { 59 | 60 | ## create start date sequence 61 | st <- lapply(min(x):max(x), function(i) { 62 | do.call(c, lapply(formatC(1:12, width = 2, flag = "0"), function(j) { 63 | as.Date(paste(i, j, if (interval[1] == "month") "01" else c("01", "15"), 64 | sep = "-")) 65 | })) 66 | }) 67 | 68 | ## limit start date range to input period 69 | st <- do.call(c, st) 70 | bfr <- st < rng[1]; afr <- st > rng[2] 71 | st <- if (all(any(bfr), any(afr))) { 72 | st[which(bfr)[length(which(bfr))]:(which(afr)[1] - 1)] 73 | } else if (any(bfr) & all(!afr)) { 74 | st[which(bfr)[length(which(bfr))]:length(st)] 75 | } else if (all(!bfr) & any(afr)) { 76 | st[1:(which(afr)[1] - 1)] 77 | } else { 78 | st 79 | } 80 | 81 | 82 | ## create end date sequence 83 | nd <- lapply(1:length(st), function(i) { 84 | if (i < length(st)) { 85 | st[i + 1] - 1 86 | } else { 87 | if (interval[1] == "fortnight" & substr(st[i], 9, 10) == "01") { 88 | st[i] + 13 89 | } else { 90 | mn <- as.integer(strftime(st[i], "%m")) 91 | dec <- mn + 1 == 13 92 | 93 | if (dec) { 94 | yr <- as.integer(substr(st[i], 1, 4)) 95 | nx <- paste0(yr + 1, "-01-") 96 | as.Date(gsub(substr(st[i], 1, 8), nx, st[i])) - 1 97 | } else { 98 | nx <- paste0("-", formatC(mn + 1, width = 2L, flag = "0"), "-") 99 | as.Date(gsub(substr(st[i], 5, 8), nx, st[i])) - 1 100 | } 101 | } 102 | } 103 | }) 104 | 105 | nd <- do.call(c, nd) 106 | 107 | 108 | ### annual aggregation ----- 109 | 110 | } else { 111 | st <- as.Date(paste0(min(x):max(x), "-01-01")) 112 | nd <- as.Date(paste0(min(x):max(x), "-12-31")) 113 | } 114 | 115 | st_doy <- transDate(st)$beginDOY 116 | nd_doy <- suppressWarnings(transDate(nd)$beginDOY) 117 | 118 | ## return named list 119 | list(begin = st, end = nd, 120 | beginDOY = st_doy, endDOY = nd_doy) 121 | } 122 | -------------------------------------------------------------------------------- /R/gdalControls.R: -------------------------------------------------------------------------------- 1 | ### input projection ----- 2 | 3 | InProj <- function(product) { 4 | if (product@TYPE[1] == "Tile") { 5 | "+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +R=6371007.181 +units=m +no_defs" 6 | } else { 7 | "+proj=longlat +ellps=clrk66 +no_defs" 8 | } 9 | } 10 | 11 | 12 | ### output projection ----- 13 | 14 | OutProj <- function(product, extent, ...) { 15 | 16 | opts <- combineOptions(...) 17 | 18 | cat("########################\n") 19 | if(!is.null(extent@target$outProj)) { 20 | outProj <- checkOutProj(extent@target$outProj, tool = "GDAL") 21 | cat("outProj = ", if (inherits(outProj, "crs")) outProj$proj4string else outProj, " (if applicable, derived from Raster*/Spatial*/sf* object)\n") 22 | 23 | } else { 24 | outProj <- checkOutProj(opts$outProj, tool = "GDAL") 25 | cat("outProj = ", if (inherits(outProj, "crs")) outProj$proj4string else outProj, "\n") 26 | } 27 | 28 | if (outProj == "asIn") { 29 | if (product@TYPE[1] == "Tile") { 30 | outProj <- "+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +R=6371007.181 +units=m +no_defs" 31 | } else { 32 | outProj <- "+proj=longlat +ellps=clrk66 +no_defs" # CMG proj 33 | } 34 | } 35 | 36 | if (inherits(outProj, "crs")) outProj$proj4string else outProj 37 | } 38 | 39 | 40 | ### output pixel size ----- 41 | 42 | PixelSize <- function(extent, ...) { 43 | 44 | opts <- combineOptions(...) 45 | 46 | if(!is.null(extent@target$pixelSize)) { 47 | pixelSize <- extent@target$pixelSize 48 | cat("pixelSize = ", pixelSize, " (if applicable, derived from Raster* object)\n") 49 | 50 | } else { 51 | pixelSize <- opts$pixelSize 52 | cat("pixelSize = ", pixelSize, "\n") 53 | } 54 | 55 | if (pixelSize[1] != "asIn") { 56 | if (length(pixelSize) == 1) { 57 | rep(pixelSize, 2) 58 | } else { 59 | pixelSize 60 | } 61 | } 62 | } 63 | 64 | 65 | ### resampling type ----- 66 | 67 | ResamplingType <- function(...) { 68 | 69 | opts <- combineOptions(...) 70 | 71 | opts$resamplingType <- checkResamplingType(opts$resamplingType, tool = "gdal") 72 | 73 | cat("resamplingType = ", opts$resamplingType, "\n") 74 | opts$resamplingType 75 | } 76 | 77 | 78 | ### target extent ----- 79 | 80 | TargetExtent <- function(extent, outProj) { 81 | 82 | if (!is.null(extent@target$extent)) { # all extents but not tileV/H 83 | if (is.null(extent@target$outProj)) { # map or list extents (always LatLon) 84 | rx <- raster(extent@target$extent, crs = "+init=epsg:4326") 85 | rx <- projectExtent(rx, outProj) 86 | rx <- extent(rx) 87 | } else { 88 | rx <- extent@target$extent 89 | } 90 | } 91 | 92 | if (is.null(extent@target)) { 93 | if(!is.null(extent@extent)) { 94 | rx <- raster(extent@extent, crs = "+init=epsg:4326") 95 | # suppress 'Discarded ... unknown in CRS definition' warning 96 | rx <- suppressWarnings(projectExtent(rx, outProj)) 97 | rx <- extent(rx) 98 | } 99 | } 100 | 101 | if (exists("rx")) { 102 | as.character(sf::st_bbox(rx)) 103 | } 104 | } 105 | 106 | 107 | ### block size ----- 108 | 109 | BlockSize <- function(...) { 110 | 111 | opts <- combineOptions(...) 112 | 113 | if (!is.null(opts$blockSize)) { 114 | opts$blockSize <- as.integer(opts$blockSize) 115 | paste0("BLOCKYSIZE=", opts$blockSize) 116 | } 117 | } 118 | 119 | 120 | ### output compression ----- 121 | 122 | OutputCompression <- function(...) { 123 | 124 | opts <- combineOptions(...) 125 | 126 | if (is.null(opts$compression) || isTRUE(opts$compression)) { 127 | c("compress=lzw", "predictor=2") 128 | } 129 | } 130 | 131 | 132 | ### quiet output ----- 133 | 134 | QuietOutput <- function(...) { 135 | 136 | opts <- combineOptions(...) 137 | 138 | ## if 'quiet = FALSE' or not available, show full console output 139 | if ("quiet" %in% names(opts)) { 140 | if (opts$quiet) "-q" 141 | } 142 | } 143 | 144 | 145 | ### gdal drivers ---- 146 | 147 | getGdalDrivers = function() { 148 | sf::st_drivers( 149 | what = "raster" 150 | ) 151 | } 152 | 153 | getGdalWriteDrivers = function() { 154 | subset( 155 | getGdalDrivers() 156 | , write 157 | ) 158 | } -------------------------------------------------------------------------------- /inst/tinytest/test-EarthdataLogin.R: -------------------------------------------------------------------------------- 1 | nrc = file.path(tempdir(), ".netrc") 2 | 3 | ## if available, backup existing .netrc file 4 | avl = file.exists(nrc) 5 | if (avl) { 6 | jnk = file.rename(nrc, paste0(nrc, ".backup")) 7 | } 8 | 9 | 10 | ## `credentials()` ==== 11 | 12 | ### 1 file unavailable ---- 13 | 14 | expect_null( 15 | MODIS:::credentials(path = nrc) 16 | , info = "blank output if file is missing" 17 | ) 18 | 19 | 20 | ### 2 single-entry file ---- 21 | 22 | ## with machine 23 | machine = "urs.earthdata.nasa.gov" 24 | 25 | writeLines(paste("machine", machine), nrc) 26 | lns = MODIS:::credentials(path = nrc) 27 | 28 | expect_inherits( 29 | lns 30 | , class = "list" 31 | , info = "output inherits from class 'list'" 32 | ) 33 | 34 | expect_identical( 35 | names(lns) 36 | , c("machine", "login", "password") 37 | , info = "names of output 'list' are correct" 38 | ) 39 | 40 | expect_identical( 41 | lns$machine 42 | , machine 43 | , info = "'machine' looks as expected (i.e. class 'character', content)" 44 | ) 45 | expect_null( 46 | lns$login 47 | , info = "'login' is NULL if missing in .netrc" 48 | ) 49 | expect_null( 50 | lns$password 51 | , info = "'password' is NULL if missing in .netrc (i)" 52 | ) 53 | 54 | ## -"- and login 55 | login = "sad_boyd" 56 | 57 | write(paste("login", login), nrc, append = TRUE) 58 | lns = MODIS:::credentials(path = nrc) 59 | 60 | expect_identical( 61 | lns$login 62 | , login 63 | , info = "'login' looks as expected (i.e. class `character`, content)" 64 | ) 65 | expect_null( 66 | lns$password 67 | , info = "'password' is NULL if missing in .netrc (ii)" 68 | ) 69 | 70 | ## -"- and password 71 | password = "Lc557Gv$" 72 | 73 | write(paste("password", password), nrc, append = TRUE) 74 | lns = MODIS:::credentials(path = nrc) 75 | 76 | expect_identical( 77 | lns$password 78 | , password 79 | , info = "'password' looks as expected (i.e. class `character`, content)" 80 | ) 81 | 82 | 83 | ### 3 multi-entry file ---- 84 | 85 | other_creds = paste( 86 | "machine e4ftl01.cr.usgs.gov" 87 | , "login romantic_swanson" 88 | , "password 9yerTXd@" 89 | , sep = "\n" 90 | ) 91 | 92 | write( 93 | paste( 94 | "" 95 | , other_creds 96 | , sep = "\n" 97 | ) 98 | , file = nrc 99 | , append = TRUE 100 | ) 101 | 102 | expect_identical( 103 | MODIS:::credentials( 104 | path = nrc 105 | ) 106 | , target = lns 107 | , info = "credentials are extracted correctly in the presence of 2+ entries" 108 | ) 109 | 110 | 111 | ## `EarthdataLogin()` ==== 112 | 113 | write( 114 | other_creds 115 | , file = nrc 116 | ) 117 | 118 | lns1 = EarthdataLogin( 119 | usr = login 120 | , pwd = password 121 | , path = nrc 122 | ) 123 | 124 | expect_identical( 125 | lns1 126 | , target = lns 127 | , info = "credentials are correctly written to .netrc" 128 | ) 129 | 130 | expect_identical( 131 | paste( 132 | readLines( 133 | nrc 134 | )[1:3] 135 | , collapse = "\n" 136 | ) 137 | , target = other_creds 138 | , info = "other credentials remain untouched when updating .netrc" 139 | ) 140 | 141 | 142 | ### checkEarthdataLogin() ---- 143 | 144 | expect_warning( 145 | out2.0 <- MODIS:::checkEarthdataLogin( 146 | path = nrc 147 | ) 148 | , pattern = "Authentication failed with\n> HTTP error (401|504)" 149 | ) # 504 = Gateway Timeout, i.e. server not reachable 150 | 151 | expect_false( 152 | out2.0 153 | ) 154 | 155 | ## early exit: single quotes in password 156 | lns2 = readLines( 157 | nrc 158 | ) 159 | 160 | write( 161 | gsub("557", "5'7", lns2) 162 | , file = nrc 163 | ) 164 | 165 | expect_error( 166 | MODIS:::downloadFile( 167 | method = "wget" 168 | , path = nrc 169 | ) 170 | , pattern = "Earthdata passwords .* must not contain single quotes" 171 | ) 172 | 173 | expect_warning( 174 | out2.1 <- MODIS:::checkEarthdataLogin( 175 | method = "wget" 176 | , path = nrc 177 | ) 178 | , pattern = "Authentication failed.*must not contain single quotes" 179 | ) 180 | 181 | expect_false( 182 | out2.1 183 | ) 184 | 185 | ## delete temporary .netrc file 186 | jnk = file.remove( 187 | nrc 188 | ) 189 | 190 | ## if applicable, restore previous .netrc file 191 | if (avl) { 192 | jnk = file.rename(paste0(nrc, ".backup"), nrc) 193 | } 194 | -------------------------------------------------------------------------------- /R/repDoy.R: -------------------------------------------------------------------------------- 1 | #' Repair MODIS "composite_day_of_the_year" SDS 2 | #' 3 | #' @description 4 | #' Currently works only for MODIS 16 days composites! In MODIS composites, the 5 | #' Julian dates inside the 'composite_day_of_the_year' SDS are referring always 6 | #' to the year they are effectively in. The problem is that the layer/SDS name 7 | #' from the last files from Terra and Aqua within a year can include dates from 8 | #' the following year and so starting again with 1. The problem occurs if you 9 | #' want to sort values of a time series by date (e.g. for precise time series 10 | #' functions). This function generates a sequential vector beginning always 11 | #' with the earliest SDS/layer date and ending with the total sum of days of the 12 | #' time series length. 13 | #' 14 | #' @param pixX `matrix` of values, usually derived from [raster::as.matrix()]. 15 | #' @param layerDate If `NULL` (default), try to autodetect layer dates. If you 16 | #' want to be sure, use the result from [extractDate()] or [orgTime()]. 17 | #' @param bias `integer`. Bias applied to all values in 'pixX'. 18 | #' 19 | #' @return 20 | #' A `matrix` with sequential Julian dates. 21 | #' 22 | #' @author 23 | #' Matteo Mattiuzzi 24 | #' 25 | #' @examples 26 | #' \dontrun{ 27 | #' tfs <- runGdal(product="M.D13A2", begin="2010350", end="2011016" 28 | #' , extent="Luxembourg", job="deleteme", SDSstring="100000000010") 29 | #' 30 | #' ndviFiles <- grep("NDVI.tif$", unlist(tfs, use.names = FALSE), value = TRUE) 31 | #' ndviFiles <- preStack(files = ndviFiles, timeInfo = orgTime(ndviFiles)) 32 | #' ndvi <- stack(ndviFiles) 33 | #' 34 | #' doyFiles <- grep("composite_day_of_the_year.tif$" 35 | #' , unlist(tfs, use.names = FALSE), value = TRUE) 36 | #' doyFiles <- preStack(files = doyFiles, timeInfo = orgTime(doyFiles)) 37 | #' doy <- stack(doyFiles) 38 | #' 39 | #' layerDates <- extractDate(doyFiles) 40 | #' 41 | #' pixX <- 169 42 | #' 43 | #' y <- ndvi[pixX] 44 | #' print(x1 <- doy[pixX]) 45 | #' print(x2 <- repDoy(x1,layerDates)) 46 | #' 47 | #' # the plotting example is not really good. 48 | #' # To create a figurative example it would be necessary to dolwnload to much data! 49 | #' plot("",xlim=c(1,max(x1,x2)),ylim=c(0,2000),xlab="time",ylab="NDVI*10000") 50 | #' lines(y=y,x=x1,col="red",lwd=3) 51 | #' lines(y=y,x=x2,col="green",lwd=2) 52 | #' 53 | #' # repDoy function is thought to be embedded in something like that: 54 | #' tr <- blockSize(ndvi) 55 | #' 56 | #' doyOk <- brick(doy) 57 | #' doyOk <- writeStart(doyOk, filename='test.tif', overwrite=TRUE) 58 | #' 59 | #' for (i in 1:tr$n) 60 | #' { 61 | #' pixX <- getValues(doy,tr$row[i],tr$nrows[i]) 62 | #' ok <- repDoy(pixX,layerDates) 63 | #' doyOk <- writeValues(x=doyOk,v=ok,start=tr$row[i]) 64 | #' } 65 | #' doyOk <- writeStop(doyOk) 66 | #' 67 | #' unlink(filename(doyOk)) 68 | #' } 69 | #' 70 | #' @export repDoy 71 | #' @name repDoy 72 | repDoy <- function(pixX, layerDate = NULL, bias = 0) 73 | { 74 | if (is.null(layerDate)) 75 | { 76 | layerDate <- extractDate(colnames(pixX),asDate=TRUE) 77 | } 78 | if (ifelse("call" %in% names(layerDate), layerDate$call$asDate, layerDate$asDate)) 79 | { 80 | layerDoy <- format(layerDate$inputLayerDates,"%j") 81 | layerYear <- format(layerDate$inputLayerDates,"%Y") 82 | } else 83 | { 84 | layerDoy <- substr(layerDate$inputLayerDates,5,7) 85 | layerYear <- substr(layerDate$inputLayerDates,1,4) 86 | } 87 | 88 | if (is.matrix(pixX)) 89 | { 90 | pixX <- t(pixX) 91 | } else 92 | { 93 | pixX <- as.matrix(pixX) # if it is a vector 94 | } 95 | 96 | # de-bias 'end of year layers' that have 'start of year' dates 97 | mask <- pixX - as.numeric(layerDoy) 98 | mask <- sign(mask)==-1 99 | mask[is.na(mask)] <- FALSE 100 | 101 | ndays <- as.numeric(format(as.Date(paste0(layerYear,"-12-31")),"%j")) 102 | bias1 <- matrix(ndays, ncol = ncol(pixX), nrow = nrow(pixX), byrow=FALSE) 103 | pixX[mask] <- pixX[mask] + bias1[mask] 104 | 105 | # sequentialize doys 106 | ndays <- as.numeric(format(as.Date(paste0(unique(layerYear),"-12-31")),"%j")) 107 | bias1 <- cumsum(ndays) - ndays[1] 108 | counter <- as.numeric(table(layerYear)) # nlayers in Y 109 | 110 | biasN <- vector(mode="list",length=length(counter)) 111 | for(i in seq_along(counter)) 112 | { 113 | biasN[[i]] <- rep(bias1[i],counter[i]) 114 | } 115 | pixX <- pixX + unlist(biasN) + bias 116 | return(t(pixX)) 117 | } 118 | 119 | -------------------------------------------------------------------------------- /R/getUTMZone.R: -------------------------------------------------------------------------------- 1 | # Get UTM Zone 2 | # 3 | # @description 4 | # Get the UTM zone for a geographic area. Zones are identified based on the 5 | # centroid coordinate pair of the specified input. 6 | # 7 | # @param x Extent information, see [getTile()] and Details therein. 8 | # 9 | # @return 10 | # A `c("sf", "data.frame")` in 11 | # [EPSG:4326](http://spatialreference.org/ref/epsg/wgs-84/) with relevant UTM 12 | # zone information. 13 | # 14 | # @author 15 | # Florian Detsch 16 | # 17 | # @seealso 18 | # [getTile()], [sf::st_centroid()]. 19 | # 20 | # @examples 21 | # \dontrun{ 22 | # source("R/getUTMZone.R") 23 | # 24 | # getUTMZone("tanzania") 25 | # 26 | # data(meuse) 27 | # pts = sf::st_as_sf(meuse, coords = c("x", "y"), crs = 28992) 28 | # getUTMZone(pts) 29 | # } 30 | # 31 | # @export 32 | getUTMZone <- function(x = NULL) { 33 | 34 | ## if 'x' is missing, select UTM tile(s) interactively 35 | if (is.null(x)) { 36 | return( 37 | selectUTMZone() 38 | ) 39 | } 40 | 41 | # `character` file method: read as `sf` or `Raster` 42 | if (inherits(x, "character") && file.exists(x[1])) { 43 | 44 | if (length(x) > 1L) { 45 | warning( 46 | sprintf( 47 | "Expected length of 'x' is [1L], got [%sL]. Dumping excess elements.." 48 | , length(x) 49 | ) 50 | , call. = FALSE 51 | ) 52 | 53 | x = x[1] 54 | } 55 | 56 | err = try( 57 | sf::st_read(x) 58 | , silent = TRUE 59 | ) 60 | 61 | # early exit: input is neither {sf} nor {raster} compatible 62 | x = tryCatch( 63 | error = \(e) { 64 | stop( 65 | "'x' is compatible with neither {sf} nor {raster}" 66 | , call. = FALSE 67 | ) 68 | } 69 | , raster::raster(x) 70 | ) 71 | } 72 | 73 | # 'character' map method: get 'sf' boundaries 74 | if (inherits(x, "character")) { 75 | x = maps::map( 76 | "worldHires" 77 | , x 78 | , plot = FALSE 79 | , fill = TRUE 80 | ) 81 | } 82 | 83 | # `Raster` method 84 | if (inherits(x, c("Raster", "Extent"))) { 85 | x = sf::st_as_sfc( 86 | sf::st_bbox(x) 87 | ) 88 | 89 | if (is.na(sf::st_crs(x))) { 90 | warning( 91 | "Input coordinate reference system is unknown, assuming EPSG:4326.." 92 | , call. = FALSE 93 | ) 94 | 95 | sf::st_crs(x) = sf::st_crs(4326L) 96 | } 97 | } 98 | 99 | # `Spatial,map,bbox` method 100 | if (inherits(x, c("Spatial", "map", "bbox"))) { 101 | x = sf::st_as_sf( 102 | x 103 | ) 104 | } 105 | 106 | ## early exit: input geometry not valid 107 | stopifnot( 108 | "Input geometry is not valid, try to `sf::st_make_valid()` and try again." = 109 | sf::st_is_valid(x) 110 | ) 111 | 112 | # determine centroid coordinates 113 | ctr = suppressWarnings( 114 | sf::st_centroid(x) 115 | ) 116 | 117 | # if required, transform to epsg:4326 118 | grd = readRDS("inst/external/UTM_Zone_Boundaries.rds") 119 | 120 | if (isFALSE(sf::st_crs(grd) == sf::st_crs(ctr))) { 121 | ctr = sf::st_transform( 122 | ctr 123 | , sf::st_crs(grd) 124 | ) 125 | } 126 | 127 | # return utm zone 128 | sf::st_join( 129 | ctr 130 | , grd 131 | ) 132 | } 133 | 134 | 135 | ### utm zone from geographic coordinates ---- 136 | ### (adopted from https://www.wavemetrics.com/code-snippet/convert-yitudexgitude-utm) 137 | 138 | GEO2UTM = function(x, y) { 139 | 140 | if (inherits(x, "Extent")) { 141 | x = as(x, "SpatialPolygons") 142 | sp::proj4string(x) = "+init=epsg:4326" 143 | } 144 | 145 | if (inherits(x, "Spatial")) { 146 | crd = sp::coordinates(x) 147 | x = crd[1]; y = crd[2] 148 | } 149 | 150 | # general zone 151 | zone = floor((x + 180)/6) + 1 152 | 153 | if (y >= 56.0 & y < 64.0 & x >= 3.0 & x < 12.0) { 154 | zone = 32 155 | } 156 | 157 | # special zones for Svalbard 158 | if (y >= 72.0 & y < 84.0) { 159 | zone = if (x >= 0.0 & x < 9.0) { 160 | 31 161 | } else if (x >= 9.0 & x < 21.0) { 162 | 33 163 | } else if (x >= 21.0 & x < 33.0) { 164 | 35 165 | } else if (x >= 33.0 & x < 42.0) { 166 | 37 167 | } 168 | } 169 | 170 | return(zone) 171 | } 172 | 173 | 174 | ### select target UTM zone interactively ---- 175 | 176 | selectUTMZone = function() { 177 | 178 | grd <- readRDS("inst/extdata/UTM_Zone_Boundaries.rds") 179 | # grd <- readRDS(system.file("extdata", "UTM_Zone_Boundaries.rds", package = "MODIS")) 180 | sel <- mapedit::selectFeatures(grd) 181 | 182 | return(sel) 183 | } 184 | -------------------------------------------------------------------------------- /man/smooth.spline.raster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/smoothSpline.R 3 | \name{smooth.spline.raster} 4 | \alias{smooth.spline.raster} 5 | \title{Filter Time Series Imagery with a Cubic Spline} 6 | \usage{ 7 | smooth.spline.raster( 8 | x, 9 | w = NULL, 10 | t = NULL, 11 | groupYears = TRUE, 12 | timeInfo = orgTime(x), 13 | df = 6, 14 | outDirPath = "./", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{\code{RasterBrick} (or \code{RasterStack}) or \code{character} vector of file 20 | names, sorted 'Vegetation index'.} 21 | 22 | \item{w}{\code{RasterBrick} (or \code{RasterStack}) with weighting information, e.g. 23 | derived from \code{\link[=makeWeights]{makeWeights()}}.} 24 | 25 | \item{t}{In case of MODIS composite, the corresponding 26 | 'composite_day_of_the_year' \code{RasterBrick} (or \code{RasterStack}).} 27 | 28 | \item{groupYears}{\code{logical}. If \code{TRUE} (default), output files are grouped by 29 | years.} 30 | 31 | \item{timeInfo}{Result from \code{\link[=orgTime]{orgTime()}}.} 32 | 33 | \item{df}{\code{numeric}, yearly degree of freedom value passed to 34 | \code{\link[stats:smooth.spline]{stats::smooth.spline()}}. If set as \code{character} (i.e., \code{df = "6"}), it is 35 | not adapted to the time series length but used as a fixed value (see 36 | Details).} 37 | 38 | \item{outDirPath}{Output path, defaults to the current working directory.} 39 | 40 | \item{...}{Arguments passed to \code{\link[raster:writeRaster]{raster::writeRaster()}}. Note that 'filename' 41 | is created automatically.} 42 | } 43 | \value{ 44 | The filtered data and a text file with the dates of the output layers. 45 | } 46 | \description{ 47 | This function uses the \code{\link[stats:smooth.spline]{stats::smooth.spline()}} function to filter a 48 | vegetation index time series of satellite data. 49 | } 50 | \details{ 51 | \code{numeric} values of 'df' (e.g., \code{df = 6}) are treated as yearly degrees of 52 | freedom. Here, the length of the input time series is not relevant since \code{df} 53 | is adapted to it with: \code{df * ('length of _input_ timeserie in days' / 365)}. 54 | The input length can differ from the output because of the 'pillow' argument 55 | in \code{\link[=orgTime]{orgTime()}}. 56 | 57 | \code{character} values of 'df' (e.g., \code{df = "6"}), on the other hand, are not 58 | adopted to the length of the input time series. 59 | 60 | Currently tested on MODIS and Landsat data. With M*D13 data, it is also 61 | possible to use the 'composite_day_of_the_year' layer and the 'VI_Quality' 62 | layer. 63 | } 64 | \examples{ 65 | \dontrun{ 66 | # The full capacity of the following functions is currently available only 67 | # with M*D13 data. 68 | # !! The function is very new, double check the result!! 69 | 70 | # You need to extract the: 'vegetation index', 'VI_Quality layer', 71 | # and 'composite day of the year' layer. 72 | # runGdal(product="MOD13A2",begin="2004340",extent="sicily",end="2006070", 73 | # job="fullCapa",SDSstring="101000000010") 74 | # Afterward extract it to: 75 | options("MODIS_outDirPath") 76 | 77 | # the only obligatory dataset is "x" (vegetatino index), get the 'vi' data on 78 | # the source directory: 79 | path <- paste0(options("MODIS_outDirPath"),"/fullCapa") 80 | vi <- preStack(path=path, pattern="*_NDVI.tif$") 81 | 82 | # `orgTime()` detects timing information of the input data and generates 83 | # based on the arguments the output date information. For spline functions 84 | # (in general) the start and end of the time series is always problematic. 85 | # So there is the argument "pillow" (default 75 days) that adds 86 | # (if available) some more layers on the two endings. 87 | 88 | timeInfo <- orgTime(vi,nDays=16,begin="2005001",end="2005365",pillow=40) 89 | 90 | # now re-run "preStack" with two differences, 'files' (output of the first 91 | # `preStack()` call) and the 'timeInfo'. 92 | # Here only the data needed for the filtering is extracted: 93 | vi <- preStack(files=vi,timeInfo=timeInfo) 94 | 95 | smooth.spline.raster(x=vi,timeInfo=timeInfo) 96 | 97 | # Filter with weighting and time information: 98 | # if the files are M*D13 you can use also use quality layers and the 99 | # composite day of the year: 100 | w <- stack(preStack(path=path, pattern="*_VI_Quality.tif$", timeInfo=timeInfo)) 101 | w <- makeWeights(w,bitShift=2,bitMask=15,threshold=6) 102 | # you can also pass only the names 103 | t <- preStack(path=path, pattern="*_composite_day_of_the_year.tif$", timeInfo=timeInfo) 104 | 105 | smooth.spline.raster(x=vi,w=w,t=t,timeInfo=timeInfo) 106 | } 107 | 108 | } 109 | \seealso{ 110 | \code{\link[=whittaker.raster]{whittaker.raster()}}, \code{\link[raster:raster]{raster::raster()}}. 111 | } 112 | \author{ 113 | Matteo Mattiuzzi 114 | } 115 | -------------------------------------------------------------------------------- /R/aaa-classes.R: -------------------------------------------------------------------------------- 1 | #' Class MODISextent 2 | #' 3 | #' @description 4 | #' An object of class `MODISextent`, typically created through [getTile()]. 5 | #' 6 | #' @slot tile MODIS tile ID as `character`. 7 | #' @slot tileH MODIS horizontal tile ID as `integer`. 8 | #' @slot tileV MODIS vertical tile ID as `integer`. 9 | #' @slot extent `Extent` information in [EPSG:4326](https://epsg.io/4326), see 10 | #' [getTile()]. 11 | #' @slot system Sensor system as `character`. 12 | #' @slot target If applicable, a `list` with additional target information. 13 | #' 14 | #' @exportClass MODISextent 15 | #' @name MODISextent-class 16 | NULL 17 | 18 | setClassUnion("listORnull", c("list", "NULL")) 19 | 20 | setClass('MODISextent', 21 | slots = c(tile = 'character', 22 | tileH = 'integer', 23 | tileV = 'integer', 24 | extent = 'Extent', 25 | system = 'character', 26 | target = 'listORnull') 27 | ) 28 | 29 | NULL 30 | 31 | #' Class MODISproduct 32 | #' 33 | #' @description 34 | #' An object of class `MODISproduct`, typically created through [getProduct()] 35 | #' when the 'x' input is a MODIS product or regular expression. 36 | #' 37 | #' @slot request User request as `character`. 38 | #' @slot PF1,PF2,PF3,PF4 Platform specific path feature for LP DAAC, LAADS, NTSG 39 | #' and NSIDC as `character`. 40 | #' @slot PD Product specific code number following the platform specifier, e.g. 41 | #' `"13A1"` for MOD13A1. 42 | #' @slot PLATFORM Satellite platform on which MODIS sensor is mounted; one of 43 | #' `c("Terra", "Aqua")`. 44 | #' @slot TYPE Product type; one of `c("Tile", "CMG", "Swath")`. 45 | #' @slot PRODUCT MODIS product identified from 'request' as `character`. 46 | #' @slot SENSOR Statically set to `"MODIS"`. 47 | #' @slot SOURCE Product specific MODIS download server(s) as named `list`. 48 | #' @slot CCC Product specific MODIS data collection(s) stored as 3-digit 49 | #' `character` objects in a named `list`. 50 | #' 51 | #' @exportClass MODISproduct 52 | #' @name MODISproduct-class 53 | NULL 54 | 55 | setClass('MODISproduct', 56 | slots = c(request = 'character', 57 | PF1 = 'character', 58 | PF2 = 'character', 59 | PF3 = 'character', 60 | PF4 = 'character', 61 | PD = 'character', 62 | PLATFORM = 'character', 63 | TYPE = 'character', 64 | PRODUCT = 'character', 65 | SENSOR = 'character', 66 | SOURCE = 'list', 67 | CCC = 'listORnull') 68 | ) 69 | 70 | NULL 71 | 72 | #' Class MODISfile 73 | #' 74 | #' @description 75 | #' An object of class `MODISfile`, typically created through [getProduct()] when 76 | #' the 'x' input is a MODIS filename. 77 | #' 78 | #' @slot request User request as `character`. 79 | #' @slot PRODUCT MODIS product identified from 'request' as `character`. 80 | #' @slot DATE Acquisition date string in the form `"A\%Y\%j"` (see [strptime()] 81 | #' and [HDF filename convention](https://modis-images.gsfc.nasa.gov/MOD07_L2/filename.html). 82 | #' @slot TILE Tile string in the form `"hXXvXX"`. 83 | #' @slot CCC MODIS data collection as 3-digit `character`. 84 | #' @slot PROCESSINGDATE Processing date string in the form `"\%Y\%j\%H\%M\%S"` 85 | #' (see [strptime()]). 86 | #' @slot FORMAT File format as `character`. 87 | #' @slot SENSOR Statically set to `"MODIS"`. 88 | #' @slot PLATFORM Satellite platform on which MODIS sensor is mounted; one of 89 | #' `c("Terra", "Aqua")`. 90 | #' @slot PF1,PF2,PF3,PF4 Platform specific path feature for LP DAAC, LAADS, NTSG 91 | #' and NSIDC as `character`. 92 | #' @slot TOPIC Product topic as `character`. 93 | #' @slot TYPE Product type; one of `c("Tile", "CMG", "Swath")`. 94 | #' @slot SOURCE Product specific MODIS download server(s) as named `list`. 95 | #' @slot POS1,POS2 Default start and end index of date string in MODIS filename, 96 | #' usually `c("10", "16")`. 97 | #' 98 | #' @exportClass MODISfile 99 | #' @name MODISfile-class 100 | NULL 101 | 102 | setClass('MODISfile', 103 | slots = c(request = 'character', 104 | PRODUCT = 'character', 105 | DATE = 'character', 106 | TILE = 'character', 107 | CCC = 'character', 108 | PROCESSINGDATE = 'character', 109 | FORMAT = 'character', 110 | SENSOR = 'character', 111 | PLATFORM = 'character', 112 | PF1 = 'character', 113 | PF2 = 'character', 114 | PF3 = 'character', 115 | PF4 = 'character', 116 | TYPE = 'character', 117 | SOURCE = 'list', 118 | POS1 = 'integer', 119 | POS2 = 'integer' 120 | ) 121 | ) 122 | 123 | NULL -------------------------------------------------------------------------------- /R/checkTools.R: -------------------------------------------------------------------------------- 1 | checkTools = function( 2 | tool = c("MRT", "GDAL", "wget", "curl") 3 | , quiet = FALSE 4 | ) { 5 | 6 | tool = tolower(tool) 7 | 8 | iw = options()$warn 9 | options(warn = -1) 10 | on.exit(options(warn = iw)) 11 | 12 | 13 | ### . mrt ---- 14 | 15 | MRT = if ("mrt" %in% tool) { 16 | checkMrt(quiet = quiet) 17 | } 18 | 19 | 20 | ### . gdal ---- 21 | 22 | GDAL = if ("gdal" %in% tool) { 23 | checkGdal(quiet = quiet) 24 | } 25 | 26 | 27 | ### . wget ---- 28 | 29 | WGET = if ("wget" %in% tool) { 30 | checkWget() 31 | } 32 | 33 | 34 | ### . curl ---- 35 | 36 | CURL = if ("curl" %in% tool) { 37 | checkCurl() 38 | } 39 | 40 | 41 | return( 42 | invisible( 43 | list( 44 | GDAL = GDAL 45 | , MRT = MRT 46 | , WGET = WGET 47 | , CURL = CURL 48 | ) 49 | ) 50 | ) 51 | } 52 | 53 | 54 | checkMrt = function(quiet = FALSE) { 55 | MRT <- FALSE 56 | mrtH <- normalizePath(Sys.getenv("MRT_HOME"), winslash="/", mustWork = FALSE) 57 | mrtDD <- normalizePath(Sys.getenv("MRT_DATA_DIR"), winslash="/", mustWork = FALSE) 58 | 59 | if (!quiet) 60 | { 61 | cat("Checking availability of MRT:\n") 62 | } 63 | 64 | if(mrtH=="" & !quiet) 65 | { 66 | cat(" 'MRT_HOME' not set/found! MRT is NOT enabled! See: 'https://lpdaac.usgs.gov/tools/modis_reprojection_tool'\n") 67 | } else 68 | { 69 | if (!quiet) 70 | { 71 | cat(" 'MRT_HOME' found:", mrtH,"\n") 72 | } 73 | if (mrtDD=="" & !quiet) 74 | { 75 | cat(" 'MRT_DATA_DIR' not set/found! MRT is NOT enabled! You need to set the path, read in the MRT manual! 'https://lpdaac.usgs.gov/tools/modis_reprojection_tool'\n") 76 | } else 77 | { 78 | if (!quiet) 79 | { 80 | cat(" 'MRT_DATA_DIR' found:",mrtDD,"\n") 81 | cat(" MRT enabled, settings are fine!\n") 82 | } 83 | MRT <- TRUE 84 | } 85 | } 86 | if(MRT) 87 | { 88 | if(file.exists(paste0(mrtH,"/doc/ReleaseNotes.txt"))) 89 | { 90 | x <- file(paste0(mrtH,"/doc/ReleaseNotes.txt"),open="rt") 91 | v <- readLines(x) 92 | v <- v[(grep(v,pattern="------*")-1)] 93 | v <- v[grep(v,pattern="Version ")][1] 94 | close(x) 95 | } else 96 | { 97 | v <- "Enabled" 98 | } 99 | } else 100 | { 101 | v <- "Version not determined" 102 | } 103 | list(MRT=MRT,version=v) 104 | } 105 | 106 | 107 | checkGdal = function(quiet = FALSE) { 108 | esv = sf::sf_extSoftVersion() 109 | if (!quiet) { 110 | cat( 111 | "Checking availability of GDAL:" 112 | , paste(" OK, GDAL", esv["GDAL"], "found!") 113 | , sep = "\n" 114 | ) 115 | } 116 | list( 117 | GDAL = TRUE # required by sf 118 | , version = unname(esv["GDAL"]) 119 | , vercheck = as.integer(strsplit(esv["GDAL"], "\\.")[[1]]) 120 | ) 121 | } 122 | 123 | 124 | checkWget = function() { 125 | WGET = FALSE 126 | wgetOK = try(system("wget --version", intern = TRUE), silent = TRUE) 127 | 128 | wgettext = if (!inherits(wgetOK, "try-error")) { 129 | WGET = TRUE 130 | regmatches(wgetOK[1], regexpr("GNU Wget [[:digit:]\\.]+", wgetOK[1])) 131 | } else "" 132 | 133 | list(WGET = WGET, version = wgettext) 134 | } 135 | 136 | 137 | checkCurl = function() { 138 | CURL = FALSE 139 | curlOK = try(system("curl --version", intern = TRUE), silent = TRUE) 140 | 141 | curltext = if (!inherits(curlOK, "try-error")) { 142 | CURL = TRUE 143 | regmatches(curlOK[1], regexpr("curl [[:digit:]\\.]+", curlOK[1])) 144 | } else "" 145 | 146 | list(CURL = CURL, version = curltext) 147 | } 148 | 149 | 150 | checkHdf4Driver = function() { 151 | avl = "HDF4" %in% sf::st_drivers(what = "raster")$name 152 | if (!avl) { 153 | warning("HDF4 driver seems to be lacking, please install GDAL with HDF4 support.") 154 | } 155 | return(avl) 156 | } 157 | 158 | 159 | checkGdalWriteDriver = function(dataFormat) { 160 | if (toupper(dataFormat) == 'RAW BINARY') { 161 | stop("dataFormat = '", dataFormat, "' is MRT specific, " 162 | , "run MODIS:::getGdalWriteDrivers() for GDAL supported write formats.") 163 | } 164 | nms = as.character(getGdalWriteDrivers()$name) 165 | avl = toupper(dataFormat) == toupper(nms) 166 | if (!any(avl)) { 167 | stop("dataFormat = '", dataFormat, "' not recognized by GDAL, " 168 | , "run MODIS:::getGdalWriteDrivers() for supported write formats.") 169 | } 170 | return(nms[avl]) 171 | } 172 | 173 | 174 | checkMrtWriteDriver = function(dataFormat) { 175 | nms = c('raw binary', 'hdf-eos', 'hdf4image','gtiff', 'geotiff') 176 | avl = tolower(dataFormat) == nms 177 | if(!any(avl)) { 178 | stop("dataFormat = '", dataFormat, "' not recognized by MRT, " 179 | , "choose one of c('raw binary', 'HDF-EOS', 'GeoTiff')." 180 | ) 181 | } 182 | switch( 183 | nms[avl] 184 | , "raw binary" = ".hdr" 185 | , "hdf-eos" = ".hdf" 186 | , "hdf4image" = ".hdf" 187 | , "gtiff" = ".tif" 188 | , "geotiff" = ".tif" 189 | ) 190 | } 191 | -------------------------------------------------------------------------------- /R/downloadUtils.R: -------------------------------------------------------------------------------- 1 | downloadFile = function( 2 | url 3 | , destfile 4 | , method 5 | , path = "~/.netrc" 6 | , quiet = FALSE 7 | ) { 8 | 9 | ## get or set credentials 10 | crd = credentials( 11 | path = path 12 | ) 13 | 14 | usr = crd$login 15 | pwd = crd$password 16 | 17 | if ( 18 | is.null(usr) || usr == "" || 19 | is.null(pwd) || pwd == "" 20 | ) { 21 | 22 | crd = EarthdataLogin( 23 | path = path 24 | ) 25 | 26 | usr = crd$login 27 | pwd = crd$password 28 | } 29 | 30 | ## cookies file 31 | cks = file.path( 32 | tempdir() 33 | , ".cookies.txt" 34 | ) 35 | 36 | if (!file.exists(cks)) { 37 | jnk = file.create(cks) 38 | } 39 | 40 | ## if `dlmethod = "auto"`, attempt to find curl or wget 41 | if (method == "auto") { 42 | 43 | cmd = try(system("curl -h", intern = TRUE), silent = TRUE) 44 | method = "curl" 45 | 46 | if (inherits(cmd, "try-error")) { 47 | cmd = try(system("wget -h", intern = TRUE), silent = TRUE) 48 | method = "wget" 49 | } 50 | 51 | if (inherits(cmd, "try-error")) { 52 | stop( 53 | "Make sure either curl or wget is available in order to download data." 54 | , call. = FALSE 55 | ) 56 | } 57 | } 58 | 59 | 60 | ### curl ---- 61 | 62 | if (method == "curl") { 63 | return( 64 | downloadFileCurl( 65 | url 66 | , destfile 67 | , usr 68 | , pwd 69 | , cookies = cks 70 | , quiet = quiet 71 | ) 72 | ) 73 | } 74 | 75 | 76 | ### other ---- 77 | 78 | # TODO: aria2 integration 79 | 80 | ## early exit: single quote in password 81 | if (grepl("'", pwd)) { 82 | stop( 83 | "Earthdata passwords used with this package must not contain single " 84 | , "quotes when download method is other than 'curl'." 85 | # , call. = FALSE 86 | ) 87 | } 88 | 89 | ## if applicable, set wget extras 90 | extra = if (method == "wget") { 91 | sprintf( 92 | paste( 93 | "--user '%s'" 94 | , "--password '%s'" 95 | , "--load-cookies %s" 96 | , "--save-cookies %s" 97 | , "--keep-session-cookie" 98 | , "--no-check-certificate" 99 | ) 100 | , usr 101 | , pwd 102 | , cks 103 | , cks 104 | ) 105 | } 106 | 107 | ## download 108 | jnk = utils::download.file( 109 | url = url 110 | , destfile = destfile 111 | , mode = 'wb' 112 | , method = method 113 | , quiet = quiet 114 | , cacheOK = TRUE 115 | , extra = extra # `NULL` if not wget 116 | ) 117 | 118 | ## early exit: .html downloaded instead of .hdf due to login failure 119 | isHTML(jnk) 120 | 121 | return(jnk) 122 | } 123 | 124 | 125 | downloadFileCurl = function( 126 | url 127 | , destfile 128 | , usr 129 | , pwd 130 | , cookies 131 | , quiet = FALSE 132 | ) { 133 | 134 | ## determine download server from url 135 | srv = if (grepl("^https://e4ftl01.cr.usgs.gov", url)) { 136 | "LPDAAC" 137 | } else if (grepl("^https://ladsweb.modaps.eosdis.nasa.gov", url)) { 138 | "LAADS" 139 | } else if (grepl("^https://n5eil01u.ecs.nsidc.org", url)) { 140 | "NSIDC" 141 | } 142 | 143 | ## set up curl handle 144 | h = curl::new_handle() 145 | 146 | args = list( 147 | handle = h 148 | , userpwd = paste0(usr, ":", pwd) 149 | , httpauth = 1L 150 | , cookiefile = cookies # read 151 | , cookiejar = cookies # write 152 | , connecttimeout = 60L 153 | ) 154 | 155 | if (srv != "LAADS") { 156 | args$httpauth = NULL 157 | } 158 | 159 | do.call( 160 | curl::handle_setopt 161 | , args = args 162 | ) 163 | 164 | ## download 165 | jnk = curl::curl_download( 166 | url 167 | , destfile 168 | , quiet = quiet 169 | , handle = h 170 | ) 171 | 172 | ## early exit: .html downloaded instead of .hdf due to login failure 173 | isHTML(jnk) 174 | 175 | ## imitate download.file() return value (i.e. 0 = success, non-zero = failure) 176 | as.integer( 177 | !file.exists( 178 | jnk 179 | ) 180 | ) 181 | } 182 | 183 | 184 | isHTML = function(x) { 185 | 186 | ## read first 10 lines to verify file 187 | ## <-> .html is downloaded and written to .hdf if earthdata login fails 188 | cnt = readLines( 189 | x 190 | , n = 10L 191 | , warn = FALSE 192 | ) 193 | 194 | if (any(grepl("", cnt))) { 195 | 196 | cnt1 = readLines( 197 | x 198 | , n = 500L 199 | , warn = FALSE 200 | ) 201 | 202 | # early exit: downloaded file is .html requiring user to login 203 | msg = if ( 204 | any( 205 | grepl( 206 | "login_please|please login" 207 | , cnt1 208 | , ignore.case = TRUE 209 | ) 210 | ) 211 | ) { 212 | "HTTP error 401." 213 | } else { 214 | "Unknown error." 215 | } 216 | 217 | stop( 218 | msg 219 | , call. = FALSE 220 | ) 221 | } 222 | 223 | return( 224 | invisible() 225 | ) 226 | } -------------------------------------------------------------------------------- /man/runGdal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/runGdal.R 3 | \name{runGdal} 4 | \alias{runGdal} 5 | \title{Process MODIS HDF with GDAL} 6 | \usage{ 7 | runGdal( 8 | product, 9 | collection = NULL, 10 | begin = NULL, 11 | end = NULL, 12 | extent, 13 | tileH, 14 | tileV, 15 | SDSstring = NULL, 16 | job = NULL, 17 | checkIntegrity = TRUE, 18 | forceDownload = TRUE, 19 | overwrite = FALSE, 20 | maskValue = NULL, 21 | ... 22 | ) 23 | } 24 | \arguments{ 25 | \item{product}{\code{character}, see \code{\link[=getProduct]{getProduct()}}.} 26 | 27 | \item{collection}{\code{character} or \code{integer}, see \code{\link[=getCollection]{getCollection()}}.} 28 | 29 | \item{begin, end}{\code{Date} or \code{character}. Begin and end date of MODIS time 30 | series, see \code{\link[=transDate]{transDate()}}.} 31 | 32 | \item{extent}{Extent information, defaults to 'global'. See \code{\link[=getTile]{getTile()}}.} 33 | 34 | \item{tileH, tileV}{\code{numeric} or \code{character}. Horizontal and vertical tile 35 | number, see \code{\link[=getTile]{getTile()}}.} 36 | 37 | \item{SDSstring}{\code{character}, see \code{\link[=getSds]{getSds()}}.} 38 | 39 | \item{job}{\code{character}. Name of the current job for the creation of the 40 | output folder. If not specified, it is created in 41 | 'PRODUCT.COLLECTION_DATETIME'.} 42 | 43 | \item{checkIntegrity, forceDownload}{\code{logical}, see \code{\link[=getHdf]{getHdf()}}.} 44 | 45 | \item{overwrite}{\code{logical}, defaults to \code{FALSE}. Determines whether or not to 46 | overwrite existing SDS output files.} 47 | 48 | \item{maskValue}{If \code{NULL} (default), i.e. not explicitly set, the per-band 49 | \verb{NoData Value} is taken into account. If not \code{NULL}, a vector of masking 50 | values with each value corresponding to a single band in 'SDSstring'. This 51 | can include \code{"None"} to ignore intrinsic no-data settings on the source 52 | data set. See also 53 | \url{https://gdal.org/en/stable/programs/gdalwarp.html#cmdoption-gdalwarp-srcnodata} 54 | for details.} 55 | 56 | \item{...}{Additional arguments passed to \code{\link[=MODISoptions]{MODISoptions()}}, e.g. 'wait'. 57 | Permanent settings for these arguments are temporarily overridden.} 58 | } 59 | \value{ 60 | A \code{list} of the same length as 'product'. Each product slot either holds a 61 | sub-\code{list} of processed dates which, for each time step, includes the 62 | corresponding output files as \code{character} objects or, if no files could be 63 | found for the specified time period, a single \code{NA}. 64 | } 65 | \description{ 66 | Downloads MODIS grid files from archive (HTTP or local) and processes them. 67 | } 68 | \details{ 69 | \itemize{ 70 | \item \verb{outProj, pixelSize, resamplingType, dataFormat, localArcPath, outDirPath}: 71 | See \code{\link[=MODISoptions]{MODISoptions()}}. 72 | \item \code{blockSize}: integer. If \code{NULL} (default), the stripe size is set by GDAL. 73 | Basically it is the \verb{-co BLOCKYSIZE=} parameter. See 74 | \url{https://gdal.org/en/stable/drivers/raster/gtiff.html}. 75 | \item \code{compression} logical. If \code{TRUE} (default), compress data with the lossless 76 | LZW compression with \code{predictor=2}. See 77 | \url{https://gdal.org/en/stable/drivers/raster/gtiff.html}. 78 | } 79 | 80 | \code{\link[=runGdal]{runGdal()}} uses numerous \strong{MODIS} functions under the hood, see the linked 81 | functions in Arguments for details and inputs. 82 | 83 | If 'extent' is a \verb{Raster*} object, the output has exactly the same extent, 84 | pixel size, and projection. 85 | If 'extent' is a \strong{sp} or \strong{sf} object, the output has exactly the same 86 | extent and projection except for point geometries with length 1 (i.e. a 87 | single point) where only the projection is inherited. 88 | If 'tileH' and 'tileV' are used (instead of 'extent') to define the area of 89 | interest, and 'outProj' and 'pixelSize' are \code{"asIn"}, the result is only 90 | converted from multi-layer HDF to 'dataFormat', default \code{"GTiff"}. 91 | } 92 | \examples{ 93 | \dontrun{ 94 | # LST in Austria 95 | runGdal( product="MOD11A1", extent="austria", begin="2010001", end="2010005", SDSstring="101") 96 | 97 | # LST with interactive tile selection 98 | runGdal( product="MOD11A1", begin="2010001", end="2010005", SDSstring="101") 99 | 100 | ### outProj examples 101 | # LST of Austria warped to UTM 34N (the three different possibilites to specify "outProj") 102 | # to find am EPSG or prj4 you may use: prj <- make_EPSG() See 103 | runGdal( job="LSTaustria", product="MOD11A1", extent="Austria", begin="2010001", end="2010005", 104 | SDSstring="101", outProj="EPSG:32634") 105 | 106 | runGdal( job="LSTaustria", product="MOD11A1", extent="Austria", begin="2010001", end="2010005", 107 | SDSstring="101", outProj=32634) 108 | 109 | runGdal( job="LSTaustria", product="MOD11A1", extent="Austria", begin="2010001", end="2010005", 110 | SDSstring="101", outProj="+proj=utm +zone=34 +ellps=WGS84 +datum=WGS84 +units=m +no_defs") 111 | 112 | ### resamplingType examples 113 | runGdal( job="LSTaustria", product="MOD11A1", extent="Austria", begin="2010001", end="2010005", 114 | SDSstring="1", resamplingType="lanczos", outProj="32634", pixelSize=100) 115 | 116 | ### processing entire tiles and keeping Sinusoidal projection 117 | # This corresponds to a format conversion (eos-hdf04 to Geotiff) and 118 | # layer extraction (multi-layer to single layer) 119 | runGdal( job="LSTaustria", product="MOD11A1", tileH=18:19,tileV=4, begin="2010001", end="2010005", 120 | SDSstring="1", outProj="asIn") 121 | 122 | } 123 | 124 | } 125 | \seealso{ 126 | \code{\link[=getHdf]{getHdf()}}, \code{\link[=runMrt]{runMrt()}}. 127 | } 128 | \author{ 129 | Matteo Mattiuzzi, Florian Detsch 130 | } 131 | -------------------------------------------------------------------------------- /R/getGranule.R: -------------------------------------------------------------------------------- 1 | # Get MODIS Swath Granules 2 | # 3 | # @description 4 | # Get MODIS swath granules for a specific geographic area, time period and 5 | # (optionally) time of day. 6 | # 7 | # @param product,collection,begin,end,tileH,tileV,extent,... See [getHdf()]. 8 | # @param DayNightFlag A `character` vector of allowed day/night flags. This can 9 | # be an arbitrary combination of `"D"` (day), `"N"` (night), `"B"` (both), 10 | # `"X"` (not designated). By default, all flags are accepted. 11 | # 12 | # @return 13 | # Identified granules as `character`. 14 | # 15 | # @author Florian Detsch 16 | # 17 | # @seealso [getHdf()], [getTile()]. 18 | # 19 | # @examples 20 | # \dontrun{ 21 | # data(meuse) 22 | # pts = sf::st_as_sf(meuse, coords = c("x", "y"), crs = 28992) 23 | # 24 | # begin <- '2017001' 25 | # end <- '2017010' 26 | # 27 | # grn = getGranule("MOD14", begin = begin, end = end 28 | # , extent = pts, DayNightFlag = "D") 29 | # 30 | # } 31 | # 32 | # @export 33 | getGranule = function(product, collection = NULL 34 | , begin = NULL, end = NULL 35 | , DayNightFlag = c("D", "N", "B", "X") 36 | , tileH = NULL, tileV = NULL, extent = NULL, ...) { 37 | 38 | ### ENVIRONMENT ---- 39 | 40 | ## set `stringsAsFactors = FALSE` 41 | saf = getOption("stringsAsFactors") 42 | options(stringsAsFactors = FALSE) 43 | on.exit(options(stringsAsFactors = saf)) 44 | 45 | ## suppress download.file() warnings 46 | w = getOption("warn") 47 | options(warn = -1) 48 | 49 | ## MODISoptions 50 | opts = combineOptions(...) 51 | sturheit = stubborn(level = opts$stubbornness) 52 | 53 | ## product info 54 | prd = getProduct(product, quiet = TRUE) 55 | 56 | ## date range 57 | if (is.null(begin)) { 58 | begin = ifelse(prd@PLATFORM == "Terra", "2000055", "2002184") 59 | } 60 | 61 | dts = transDate(begin, end) 62 | dts = seq(dts$begin, dts$end, "day") 63 | 64 | ## spatial extent 65 | if (inherits(extent, "Extent")) { 66 | extent = as(extent, "SpatialPolygons") 67 | sp::proj4string(extent) = "+init=epsg:4326" 68 | } else if (inherits(extent, "sf")) { 69 | extent = as(extent, "Spatial") 70 | } 71 | 72 | if (!raster::compareCRS(extent, sp::CRS("+init=epsg:4326"))) { 73 | extent = sp::spTransform(extent, sp::CRS("+init=epsg:4326")) 74 | } 75 | 76 | 77 | ### METADATA ---- 78 | 79 | ## loop over years and find relevant .txt files 80 | idr = file.path("https://ladsweb.modaps.eosdis.nasa.gov/archive/geoMeta" 81 | , as.integer(prd@CCC) 82 | , toupper(prd@PLATFORM)) 83 | 84 | yrs = unique(format(dts,'%Y')) 85 | mtd = do.call(c, lapply(yrs, function(yr) { 86 | ifl = file.path(idr, paste0(yr, ".csv")) 87 | ofl = tempfile(fileext = ".csv") 88 | 89 | success = try(log("a"), silent = TRUE); n = 1L 90 | while (inherits(success, "try-error") & n <= sturheit) { 91 | success = try(utils::download.file(ifl, ofl, quiet = opts$quiet 92 | , mode = "wb"), silent = TRUE) 93 | n = n + 1L; Sys.sleep(opts$wait) 94 | } 95 | 96 | onl = utils::read.csv(ofl) 97 | xtr = extractDate(onl[, 1] 98 | , pos1 = 7L, pos2 = 16L 99 | , asDate = TRUE, format = "%Y-%m-%d") 100 | 101 | ids = xtr$inputLayerDates %in% dts 102 | file.path(gsub(".csv$", "", ifl), onl[ids, 1]) 103 | })) 104 | 105 | 106 | ### INTERSECTING GRANULES ---- 107 | 108 | out = vector("list", length(mtd)) 109 | 110 | for (h in 1:length(mtd)) { 111 | 112 | ## download and import daily metadata 113 | ofl = tempfile(fileext = ".txt") 114 | 115 | success = try(log("a"), silent = TRUE); n = 1L 116 | while (inherits(success, "try-error") & n <= sturheit) { 117 | success = try(utils::download.file(mtd[h], ofl, quiet = opts$quiet 118 | , mode = "wb"), silent = TRUE) 119 | n = n + 1L; Sys.sleep(opts$wait) 120 | } 121 | 122 | grn = utils::read.csv(ofl, skip = 1L, header = FALSE) 123 | 124 | ## set column names 125 | lns = readLines(ofl, n = 1L) 126 | lns = regmatches(lns, regexpr("GranuleID[[:print:]]+", lns)) 127 | names(grn) = strsplit(lns, ",")[[1]] 128 | 129 | ## apply day/night flag 130 | grn = grn[grn$DayNightFlag %in% DayNightFlag, ] 131 | 132 | ## find and format g-ring coordinates 133 | crn = sapply(c("GRingLon", "GRingLat"), function(i) { 134 | grep(i, names(grn)) # [c(1:4, 1)] 135 | }) 136 | 137 | for (i in crn[, 1]) { 138 | ids = grn[, i] < 0 139 | grn[ids, i] = 360 + grn[ids, i] 140 | } 141 | 142 | crn = rbind(crn, crn[1, ]) # to close polygon 143 | 144 | ## create polygons from bounding box 145 | pys = do.call(raster::bind, lapply(1:nrow(grn), function(i) { 146 | crd = t(sapply(1:nrow(crn), function(j) { 147 | as.numeric(unlist(grn[i, crn[j, ]])) 148 | })); # crd[order(crd[, 1]), ] 149 | 150 | 151 | if (max(crd[, 1]) - min(crd[, 1]) >= 180) { 152 | crd[crd[, 1] < 0, 1] = crd[crd[, 1] < 0, 1] + 360 153 | spy1 = sf::st_polygon(list(crd)) 154 | spy1 = sf::st_sfc(spy1, crs = "+proj=longlat +lon_wrap=180") 155 | spy2 = sf::st_transform(spy1, crs = 4326) 156 | spy2 = sf::st_wrap_dateline(spy2) 157 | } else { 158 | spy1 = sf::st_polygon(list(crd)) 159 | spy2 = sf::st_sfc(spy1, crs = 4326) 160 | } 161 | 162 | return(as(spy2, "Spatial")) 163 | })) 164 | 165 | ## find intersecting granules 166 | ## TODO: rewrite to use `sf::st_intersects()` instead of {rgeos} 167 | sct = suppressWarnings(rgeos::gIntersects(extent, pys, byid = TRUE)) 168 | out[[h]] = grn[apply(sct, 1, FUN = any), "GranuleID"] 169 | } 170 | 171 | ## reset permanent warnings setting 172 | options(warn = w) 173 | 174 | names(out) = basename(mtd) 175 | return(out) 176 | } 177 | -------------------------------------------------------------------------------- /man/runMrt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/runMrt.R 3 | \name{runMrt} 4 | \alias{runMrt} 5 | \title{Run MODIS Reprojection Tool} 6 | \source{ 7 | The MRT software has been 8 | \href{https://www.earthdata.nasa.gov/news/mrtweb-mrt-services-retired}{retired}, 9 | and is hence no longer officially available for download through LP DAAC. 10 | } 11 | \usage{ 12 | runMrt( 13 | product, 14 | collection = NULL, 15 | begin = NULL, 16 | end = NULL, 17 | extent = NULL, 18 | tileH = NULL, 19 | tileV = NULL, 20 | SDSstring = NULL, 21 | job = NULL, 22 | datum = c("NODATUM", "NAD27", "NAD83", "WGS66", "WGS72", "WGS84"), 23 | zone = NULL, 24 | projPara = NULL, 25 | mosaic = TRUE, 26 | anonym = TRUE, 27 | ... 28 | ) 29 | } 30 | \arguments{ 31 | \item{product, collection, begin, end, extent, tileH, tileV, SDSstring, job}{See 32 | \code{\link[=runGdal]{runGdal()}} and functions linked therein.} 33 | 34 | \item{datum}{The output datum used for datum conversion as \code{character}, 35 | defaults to \code{"NODATUM"}. Supported datums are \code{"NAD27"}, \code{"NAD83"}, 36 | \code{"WGS66"}, \code{"WGS72"} and \code{"WGS84"}, see MRT User's Manual, p. 7-8.} 37 | 38 | \item{zone}{Output zone number as \code{integer}, relevant only for UTM 39 | projections (i.e., \code{outProj = "UTM"}). Valid values are \code{-60} to \code{+60}.} 40 | 41 | \item{projPara}{Output projection parameters as \code{character} string, see 42 | Details. Ignored if 'outProj' is one of \code{c("SIN", "GEO")}. If not specified 43 | and using another target projection, the default settings for \code{"GEO"} are 44 | assumed.} 45 | 46 | \item{mosaic}{A \code{logical} that toggles mosaicking on (default) or off. One 47 | example where \code{mosaic = FALSE} makes sense is for large spatial extents 48 | because maximum supported HDF4 file size is 2GB. If crossed, mosaicking 49 | will fail.} 50 | 51 | \item{anonym}{A \code{logical}, defaults to \code{TRUE}. If \code{FALSE}, the job name is 52 | appended to the root filename.} 53 | 54 | \item{...}{Additional arguments passed to \code{\link[=MODISoptions]{MODISoptions()}}, see also Details 55 | for some MRT specific settings.} 56 | } 57 | \value{ 58 | A \code{list} of output file names summarized by product and date, see also Value 59 | in \code{\link[=runGdal]{runGdal()}}. 60 | } 61 | \description{ 62 | Specifying input parameters, this function gets MODIS grid data from the 63 | archive (HTTP or local) and processes it with the MODIS Reprojection Tool 64 | (MRT). At any point, you are highly encouraged to consult the MRT User's 65 | Manual for further information. 66 | } 67 | \details{ 68 | Please note that in contrast to \code{\link[=runGdal]{runGdal()}}, MRT's \code{resample} function does 69 | not offer an 'overwrite' option, meaning that existing files will be 70 | overwritten (see also MRT User's Manual, p. 59). 71 | Further arguments that require particular attention when operating MRT are 72 | summarized in the following list: 73 | 74 | \strong{dataFormat}: 75 | Output file formats include: 76 | \itemize{ 77 | \item \code{"raw binary"}: \code{.hdr} and \code{.dat} 78 | \item \code{"HDF-EOS"}: \code{.hdf} 79 | \item \code{"GeoTiff"}: \code{.tif} (default) 80 | } 81 | 82 | Any other format specified through \code{\link[=MODISoptions]{MODISoptions()}} or 'dataFormat' is 83 | ignored and set to \code{"GeoTiff"}. 84 | 85 | \strong{outProj}: 86 | MRT uses calls to the General Cartographic Transformation Package (GCTP) and 87 | as such allows projection to the following mapping grids: 88 | \itemize{ 89 | \item Albers Equal Area (\code{"AEA"}) 90 | \item Equirectangular (\code{"ER"}) 91 | \item Geographic (\code{"GEO"}) 92 | \item Hammer (\code{"HAM"}) 93 | \item Integerized Sinusoidal (\code{"ISIN"}) 94 | \item Interrupted Goode Homolosine (\code{"IGH"}) 95 | \item Lambert Azimuthal (\code{"LA"}) 96 | \item Lambert Conformal Conic (\code{"LCC"}) 97 | \item Mercator (\code{"MERCAT"}) 98 | \item Molleweide (\code{"MOL"}) 99 | \item Polar Stereographic (\code{"PS"}) 100 | \item Sinusoidal (\code{"SIN"}) 101 | \item Transverse Mercator (\code{"TM"}) 102 | \item Universal Transverse Mercator (\code{"UTM"}) 103 | } 104 | 105 | See also 'References' and MRT User's Manual, pp. 6 and 29. 106 | 107 | \strong{projPara}: 108 | Output projection parameters are autodetected for 109 | \verb{outProj \\\%in\\\% c("SIN", "GEO")}: 110 | \itemize{ 111 | \item \code{"SIN"}: \code{"6371007.18 0.00 0.00 0.00 0.00 0.00 0.00 0.00 86400.00 0.00 0.00 0.00 0.00 0.00 0.00"} 112 | \item \code{"GEO"}: \code{"0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0"} 113 | } 114 | 115 | For detailed information on defining parameters for other target projections, 116 | please refer to 'Appendix C: Projection Parameters' in the MRT User's Manual, 117 | p. 65-66. 118 | } 119 | \examples{ 120 | \dontrun{ 121 | geo = runMrt(product="MOD11A1", extent="austria", begin="2010001", end="2010002", SDSstring="101", 122 | job="ExampleGEOdelme", outProj="GEO") 123 | sin = runMrt(product="MOD11A1", extent="austria", begin="2010001", end="2010002", SDSstring="101", 124 | job="ExampleSINdelme", outProj="SIN") 125 | utm = runMrt(product="MOD11A1", extent="austria", begin="2010001", end="2010002", SDSstring="101", 126 | job="ExampleUTMdelme", outProj="UTM", zone = 33) 127 | } 128 | 129 | } 130 | \references{ 131 | Dwyer J, Schmidt G (2006) The MODIS Reprojection Tool, 162-177, 132 | \doi{10.1007/978-3-540-37294-3_9}. In: Qu JJ, Gao W, Kafatos M, Murphy RE, 133 | Salomonson VV (eds) Earth Science Satellite Remote Sensing. Springer: Berlin, 134 | Heidelberg. 135 | 136 | Elassal AA (1989) General Cartographic Transformation Package (GCTP), Version 137 | II. NOAA Technical Report NOS124 CGS9. NOAA: Rockville, MD, USA. Available 138 | online \href{https://www.cmascenter.org/ioapi/documentation/all_versions/html/GCTP.pdf}{here} 139 | (2018-09-13). 140 | } 141 | \seealso{ 142 | \code{\link[=MODISoptions]{MODISoptions()}}, \code{\link[=runGdal]{runGdal()}}. 143 | } 144 | \author{ 145 | Matteo Mattiuzzi, Forrest Stevens and Florian Detsch 146 | } 147 | -------------------------------------------------------------------------------- /R/getProduct.R: -------------------------------------------------------------------------------- 1 | #' Check and Create Product-Related Information 2 | #' 3 | #' @description 4 | #' On user side, it is a function to find the desired product. On package site, 5 | #' it generates central internal information to handle files. 6 | #' 7 | #' @param x `character`. MODIS file name, product name, regular expression 8 | #' passed as pattern to [grep()], or missing. Use dot notation to address 9 | #' Terra and Aqua products at the same time, e.g. `"M.D13Q1"`. 10 | #' @param quiet `logical`, defaults to `FALSE`. 11 | #' @param ... Additional arguments passed to [getCollection()]. 12 | #' 13 | #' @return 14 | #' If 'x' is missing, a `data.frame` with information about all MODIS products 15 | #' available. In case of `character` input, an invisible [MODISproduct-class] or 16 | #' [MODISfile-class] object depending on the type of input (product, regular 17 | #' expression or file name); the object holds information usable by other 18 | #' functions. 19 | #' 20 | #' @author 21 | #' Matteo Mattiuzzi and Florian Detsch 22 | #' 23 | #' @examples 24 | #' getProduct() # list available products 25 | #' 26 | #' # or use regular expression style 27 | #' getProduct("M.D11C3") 28 | #' getProduct("M*D11C") 29 | #' 30 | #' # or get information about specific product 31 | #' internal_info <- getProduct("MOD11C3", quiet = TRUE) 32 | #' internal_info 33 | #' 34 | #' # or use a valid filename 35 | #' fileinfo <- getProduct("MYD11A1.A2009001.h18v04.006.2015363221538.hdf") 36 | #' fileinfo 37 | #' 38 | #' @export getProduct 39 | #' @name getProduct 40 | getProduct <- function(x = NULL, quiet = FALSE, ...) 41 | { 42 | 43 | #load(system.file("external", "MODIS_Products.RData", package="MODIS")) 44 | 45 | if (is.null(x)) { # if x isn't provided, return table of supported files. 46 | cls = c("PRODUCT", "TOPIC", "PLATFORM","TYPE", "RES", "TEMP_RES") 47 | products = as.data.frame(MODIS_Products[cls]) 48 | products = data.frame(products[order(products$PRODUCT), ] 49 | , row.names = 1:nrow(products)) 50 | 51 | return(products) 52 | } 53 | 54 | if (inherits(x, "MODISproduct")) 55 | { 56 | # if TRUE then it is a result from a getProduct() call. 57 | return(x) 58 | } 59 | 60 | ## moody but seams to work!! 61 | inbase <- basename(x) # if x is a filename(+path) remove the path 62 | inbase = gsub("\\.[[:digit:]]{3}", "", inbase) 63 | 64 | isProduct = any(sapply(inbase, function(i) { 65 | grepl(gsub(" ", "", i), getProduct()[, 1]) 66 | })) 67 | 68 | tmp = if (!isProduct) { 69 | isFile <- TRUE 70 | sapply(strsplit(inbase, "\\."), "[[", 1) 71 | } else { 72 | isFile <- FALSE 73 | gsub(" ", "", inbase) ## if 'isProduct', remove whitespaces 74 | } 75 | 76 | product = sapply(tmp, function(i) skipDuplicateProducts(i, quiet = quiet)) 77 | 78 | pattern <- sub(pattern="MXD", replacement="M.D", x=product, ignore.case=TRUE) # make a regEx out of "x" 79 | 80 | ids = do.call(c, lapply(pattern, function(i) { 81 | grep(i, MODIS_Products$PRODUCT, ignore.case = TRUE) 82 | })) 83 | 84 | if (length(ids) == 0) { 85 | if (!quiet) 86 | cat("No product found with the name ", inbase 87 | , ". Try 'getProduct()' to list available products.\n", sep = "") 88 | 89 | return(invisible(NULL)) 90 | } else { 91 | info <- listPather(MODIS_Products, ids) 92 | } 93 | 94 | info$PRODUCT <- toupper(info$PRODUCT) 95 | 96 | if (isFile) 97 | { # in this case it must be a filename 98 | 99 | fname = getInfo(x, product = info$PRODUCT, type = info$TYPE) 100 | result <- c(x, fname, info) 101 | result <- result[!duplicated(names(result))] 102 | 103 | out = methods::new("MODISfile" 104 | , request = x 105 | , PRODUCT = fname$PRODUCT 106 | , DATE = fname$DATE 107 | , TILE = fname$TILE 108 | , CCC = fname$CCC 109 | , PROCESSINGDATE = fname$PROCESSINGDATE 110 | , FORMAT = fname$FORMAT 111 | , SENSOR = info$SENSOR 112 | , PLATFORM = info$PLATFORM 113 | , PF1 = info$PF1 114 | , PF2 = info$PF2 115 | , PF3 = info$PF3 116 | , PF4 = info$PF4 117 | , TYPE = result$TYPE 118 | , SOURCE = result$SOURCE 119 | , POS1 = as.integer(result$POS1) 120 | , POS2 = as.integer(result$POS2)) 121 | 122 | } else # if not a file 123 | { 124 | if (!quiet) 125 | { 126 | for (i in seq_along(info$PRODUCT)) 127 | { 128 | cat(paste(info$PRODUCT[i],'the',info$TEMP_RES[i],info$TYPE[i], info$TOPIC[i],'product from MODIS', info$PLATFORM[i],'with a ground resolution of', info$RES[i],'\n', sep = " ")) 129 | } 130 | } 131 | 132 | PD <- substr(info$PRODUCT, 4, nchar(as.character(info$PRODUCT))) 133 | 134 | out = methods::new("MODISproduct" 135 | , request = x 136 | , PF1 = as.character(info$PF1) 137 | , PF2 = as.character(info$PF2) 138 | , PF3 = as.character(info$PF3) 139 | , PF4 = as.character(info$PF4) 140 | , PD = PD 141 | , PLATFORM = as.character(info$PLATFORM) 142 | , TYPE = as.character(info$TYPE) 143 | , PRODUCT = as.character(info$PRODUCT) 144 | , SENSOR = as.character(info$SENSOR) 145 | , SOURCE = info$SOURCE 146 | ) 147 | 148 | out@CCC = getCollection(out, quiet = TRUE, ...) 149 | } 150 | 151 | names(out@SOURCE) = out@PRODUCT 152 | return(invisible(out)) 153 | } 154 | -------------------------------------------------------------------------------- /R/orgStruc.R: -------------------------------------------------------------------------------- 1 | #' Reorganize MODIS Files in Local Data Archive 2 | #' 3 | #' @description 4 | #' Reorganize the storage structure of your MODIS archive according to the 5 | #' settings in `options("MODIS_arcStructure")`. Depending on the specified 6 | #' 'source', you can also use this function to gather all MODIS grid files on 7 | #' your machine and reorganize them. The main purpose is to organize the 8 | #' archive, but it is also possible to copy a subset of files to a desired 9 | #' location! 10 | #' 11 | #' @param from `character`. Local path to look for MODIS files, defaults to 12 | #' `options("MODIS_localArcPath")` (see [MODISoptions()]). 13 | #' @param to `character`. Target folder to move (or copy) MODIS files to, 14 | #' defaults to `options("MODIS_localArcPath")`. 15 | #' @param structure `character`. Storage structure, defaults to 16 | #' `options("MODIS_arcStructure")` (see Examples). 17 | #' @param pattern Regular expression passed to [list.files()]. Insert a pattern 18 | #' if you want to extract specific files from your archive. 19 | #' @param move `logical`. If `TRUE`, files are moved and duplicated files are 20 | #' deleted. If `FALSE` (default), files are just copied and thus remain in the 21 | #' origin folder. Note that the copying process performs rather slowly when 22 | #' dealing with large files, e.g. 250-m `"MOD13Q1"`. 23 | #' @param quiet `logical`, defaults to `FALSE`. 24 | #' 25 | #' @return 26 | #' If `quiet = FALSE` (default), information on how many files have been moved 27 | #' (or copied) and deleted is printed to the console. 28 | #' 29 | #' @author 30 | #' Matteo Mattiuzzi 31 | #' 32 | #' @examples 33 | #' \dontrun{ 34 | #' # MOVE all MODIS grid data to the directory and structure as defined in 35 | #' # options("MODIS_localArcPath", "MODIS_arcStructure") 36 | #' orgStruc(move = TRUE) 37 | #' 38 | #' # COPY all MOD13Q1 from 2001 to folder "MyFiles/MOD13Q1.collection/" 39 | #' orgStruc(pattern="MOD13Q1.A2001*.",to="MyFiles",structure="PRODUCT.CCC") 40 | #' 41 | #' # COPY all MOD13Q1 to folder "MyFiles/" 42 | #' orgStruc(pattern="MOD13Q1.*.",to="MyFiles",structure="") 43 | #' } 44 | #' 45 | #' @export orgStruc 46 | #' @name orgStruc 47 | orgStruc <- function(from,to,structure, pattern, move=FALSE, quiet=FALSE) 48 | { 49 | 50 | opts <- combineOptions() 51 | if (missing(from)) 52 | { 53 | from <- opts$localArcPath 54 | } 55 | 56 | if (missing(to)) 57 | { 58 | to <- opts$localArcPath 59 | } 60 | to <- setPath(to) 61 | 62 | if (!missing(structure)) 63 | { 64 | opts$arcStructure <- structure 65 | } 66 | ########################### 67 | 68 | if(missing(pattern)) 69 | { 70 | cat(paste0("No 'pattern' set, moving/coping all MODIS grid data found in '", from,"'.\n")) 71 | avFiles <- list.files(from, pattern=".hdf$", recursive=TRUE, full.names=TRUE) 72 | } else 73 | { 74 | avFiles <- list.files(from, pattern=pattern, recursive=TRUE, full.names=TRUE) 75 | } 76 | 77 | if (length(avFiles)==0) {stop("No HDF nor HDF.XML files found!\n")} 78 | doit <- isSupported(avFiles) 79 | if (sum(doit)==0) {stop("No supported files Found")} 80 | avFiles <- avFiles[doit] 81 | 82 | if (!quiet) 83 | { 84 | cat("Found",length(avFiles),"files \n") 85 | } 86 | ######################### 87 | moved <- sapply(avFiles,function(x) 88 | { 89 | 90 | orpath <- correctPath(dirname(x)) 91 | fname <- basename(x) 92 | ######################## 93 | # generate and create local path to file! 94 | path <- genString(x=fname,remote=FALSE,localArcPath=to)$localPath 95 | dir.create(path,showWarnings=FALSE,recursive=TRUE) 96 | ################### 97 | 98 | if (!file.exists(file.path(path,fname,fsep="/"))) 99 | { # if file doesn't exist in destdir copy/move 100 | 101 | if (move) 102 | { 103 | file.rename(from=x,to=paste0(path,fname)) 104 | if (file.exists(paste0(x,".xml"))) 105 | { 106 | file.rename(from=paste0(x,".xml"),to=paste0(path,fname,".xml",sep="")) 107 | } 108 | moved <- 1 109 | } else 110 | { 111 | file.copy(from=x,to=paste0(path,fname),overwrite=FALSE) 112 | if (file.exists(paste0(x,".xml"))) 113 | { 114 | file.copy(from=paste0(x,".xml"),to=paste0(path,fname,".xml")) 115 | } 116 | moved <- 2 117 | } 118 | 119 | } else if (file.exists(file.path(path,fname,fsep="/")) & orpath!=path & move) 120 | { # if file exists in destdir & inpath!=outPath...it is duplicated in 2 different locations, so remove it 121 | unlink(x) 122 | if (file.exists(paste0(x,".xml"))) 123 | { 124 | unlink(paste0(x,".xml")) 125 | } 126 | moved <- 3 127 | } else 128 | { 129 | moved <- 0 130 | } 131 | if (length(list.files(orpath))==0) 132 | { 133 | if (.Platform$OS=="unix") 134 | { # I'm looking for a windows/MAC(?) eqal to the linux "rmdir -p" command!! 135 | warn <- getOption("warn") 136 | options(warn=-2) 137 | try(xxx <- invisible(system(paste0("rmdir -p --ignore-fail-on-non-empty ", orpath),intern=TRUE)),silent=TRUE) 138 | options(warn=warn) 139 | } else 140 | { # work around for rmdir -p on windows/MAC(?) 141 | unlink(orpath,recursive=TRUE) 142 | secPath <- strsplit(orpath,"/")[[1]] 143 | 144 | for (o in length(secPath):1) 145 | { 146 | delpath <- paste0(secPath[-o:-length(secPath)],collapse="/") 147 | 148 | if (length(list.files(delpath))==0) 149 | { 150 | unlink(delpath,recursive=TRUE) 151 | } else 152 | { 153 | break 154 | } 155 | } 156 | } 157 | } 158 | return(moved) 159 | }) 160 | 161 | if (sum(moved==0)==length(avFiles)) 162 | { 163 | cat("All files in the query are fine, no files to move or to copy!\n") 164 | } else 165 | { 166 | cat("Moved files", sum(moved==1),"\n") 167 | cat("Copied files", sum(moved==2),"\n") 168 | cat("Not moved files", sum(moved==0),"\n") 169 | cat("Deleted multiple files", sum(moved==3),"\n") 170 | } 171 | } 172 | 173 | -------------------------------------------------------------------------------- /man/whittaker.raster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/whittaker.R 3 | \name{whittaker.raster} 4 | \alias{whittaker.raster} 5 | \title{Filter Vegetation Index with Modified Whittaker Approach} 6 | \usage{ 7 | whittaker.raster( 8 | vi, 9 | w = NULL, 10 | t = NULL, 11 | timeInfo = orgTime(vi), 12 | lambda = 5000, 13 | nIter = 3, 14 | outputAs = "single", 15 | collapse = FALSE, 16 | prefixSuffix = c("MCD", "ndvi"), 17 | outDirPath = ".", 18 | outlierThreshold = NULL, 19 | mergeDoyFun = "max", 20 | ... 21 | ) 22 | } 23 | \arguments{ 24 | \item{vi}{\verb{Raster*} or \code{character} file names, sorted VI. Use \code{\link[=preStack]{preStack()}} 25 | functionality to ensure the right input.} 26 | 27 | \item{w}{\verb{Raster*} or \code{character} file names. In case of MODIS composite, the 28 | sorted 'VI_Quality' layers.} 29 | 30 | \item{t}{\verb{Raster*} or \code{character} file names. In case of MODIS composite, the 31 | sorted 'composite_day_of_the_year' layers. If missing, the date is 32 | determined using 'timeInfo'.} 33 | 34 | \item{timeInfo}{Output from \code{\link[=orgTime]{orgTime()}}.} 35 | 36 | \item{lambda}{\code{character} or \code{integer}. Yearly lambda value passed to 37 | \code{\link[ptw:whit2]{ptw::whit2()}}. If set as \code{character} (i.e., \code{lambda = "600"}), it is not 38 | adapted to the time series length, but used as a fixed value (see Details). 39 | High values = stiff/rigid spline.} 40 | 41 | \item{nIter}{\code{integer}. Number of iterations for the upper envelope fitting.} 42 | 43 | \item{outputAs}{\code{character}, organization of output files. \code{"single"} 44 | (default) means each date one \code{RasterLayer}; \code{"yearly"} a \code{RasterBrick} for 45 | each year, and \code{"one"} one \code{RasterBrick} for the entire time series.} 46 | 47 | \item{collapse}{\code{logical}. Collapse input data of multiple years into one 48 | single year before filtering.} 49 | 50 | \item{prefixSuffix}{\code{character}, file naming. Names are dot-separated: 51 | \code{paste0(prefixSuffix[1], "YYYDDD", lambda, prefixSuffix[2], ".defaultFileExtension")}.} 52 | 53 | \item{outDirPath}{\code{character}, output path. Defaults to the current working 54 | directory.} 55 | 56 | \item{outlierThreshold}{\code{numeric} in the same unit as 'vi', used for outlier 57 | removal (see Details).} 58 | 59 | \item{mergeDoyFun}{Especially when using \code{collapse = TRUE}, multiple 60 | measurements for one day can be present. Here you can choose how those 61 | values are merged to one single value: \code{"max"} uses the highest value, 62 | \code{"mean"} or \code{"weighted.mean"} use \code{\link[=mean]{mean()}} or \code{\link[stats:weighted.mean]{stats::weighted.mean()}}.} 63 | 64 | \item{...}{Arguments passed to \code{\link[raster:writeRaster]{raster::writeRaster()}} (except for 65 | 'filename').} 66 | } 67 | \value{ 68 | A Whittaker-smoothed \code{RasterStack}. 69 | } 70 | \description{ 71 | Use a modified Whittaker filter function (see References) from package 72 | \strong{ptw} to filter a vegetation index (VI) time series of satellite data. 73 | } 74 | \details{ 75 | The argument 'lambda' is passed to \code{MODIS:::miwhitatzb1}. You can set it as 76 | yearly 'lambda', which means that it doesn't matter how long the input time 77 | series is because 'lambda' is adapted to it with: 78 | \code{lambda * ('length of input time series in days' / 365)}. The input length 79 | can differ from the output because of the 'pillow' argument in \code{\link[=orgTime]{orgTime()}}. 80 | But it can also be set as \code{character} (i.e., \code{lambda = "1000"}). In this 81 | case, the adaption to the time series length is not performed. 82 | } 83 | \note{ 84 | Currently tested on MODIS and Landsat data. Using M*D13, it is also possible 85 | to use the 'composite_day_of_the_year' and the 'VI_Quality' layers. 86 | } 87 | \examples{ 88 | \dontrun{ 89 | # The following function will download bit more than 1 year of MOD13A1 (~180mB) and therefore 90 | # take while to execute! Data will be downloaded to options("MODIS_localArcPath") and processed 91 | # to 'paste0(options("MODIS_outDirPath"),"fullCapa")' 92 | # You need to extract: 'vegetation index', 'VI_Quality layer', and 'composite day of the year', 93 | # this is expressed by the argument 'SDSstring' 94 | runGdal(product="MOD13A2",begin="2004340",extent="ireland",end="2006020", job="fullCapa", 95 | SDSstring="101000000010") 96 | path <- paste0(options("MODIS_outDirPath"),"fullCapa") 97 | 98 | # the only obligatory dataset is the vegetatino index 99 | # get the 'vi' data in the source directory: 100 | vi <- preStack(path=path, pattern="*_NDVI.tif$") 101 | 102 | # "orgTime" detects timing information of the input data and generates based on the arguments 103 | # the output date information. 104 | # For spline functions (in general) the beginning and the end of the time series 105 | # is always problematic. So there is the argument "pillow" (default 75 days) that adds 106 | # (if available) some more layers on the two endings. 107 | timeInfo <- orgTime(vi,nDays=16,begin="2005001",end="2005365",pillow=40) 108 | 109 | # now re-run "preStack" with two differences, 'files' (output of the first 'preStack' call) 110 | # and the 'timeInfo' 111 | # Here only the data needed for the filtering is extracted: 112 | vi <- preStack(files=vi,timeInfo=timeInfo) 113 | 114 | whittaker.raster(vi,timeInfo=timeInfo,lambda=5000) 115 | 116 | # if the files are M*D13 you can use also Quality layers and the composite day of the year: 117 | wt <- preStack(path=path, pattern="*_VI_Quality.tif$", timeInfo=timeInfo) 118 | # can also be already stacked: 119 | inT <- preStack(path=path, pattern="*_composite_day_of_the_year.tif$", timeInfo=timeInfo) 120 | 121 | whittaker.raster(vi=vi, wt=wt, inT=inT, timeInfo=timeInfo, lambda=5000, overwrite=TRUE) 122 | } 123 | 124 | } 125 | \references{ 126 | Modified Whittaker smoother, according to Atzberger & Eilers 2011 127 | International Journal of Digital Earth 4(5):365-386, 128 | \doi{10.1080/17538947.2010.505664}. 129 | Implementation in R: Agustin Lobo 2012 130 | } 131 | \seealso{ 132 | \code{\link[=smooth.spline.raster]{smooth.spline.raster()}}, \code{\link[raster:raster]{raster::raster()}}. 133 | } 134 | \author{ 135 | Matteo Mattiuzzi and Agustin Lobo 136 | } 137 | -------------------------------------------------------------------------------- /man/getTile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getTile.R 3 | \name{getTile} 4 | \alias{getTile} 5 | \alias{getTile,missing,missing,missing-method} 6 | \alias{getTile,missing,charORnum,charORnum-method} 7 | \alias{getTile,character,ANY,ANY-method} 8 | \alias{getTile,character-method} 9 | \alias{getTile,Raster,ANY,ANY-method} 10 | \alias{getTile,Raster-method} 11 | \alias{getTile,map,ANY,ANY-method} 12 | \alias{getTile,map-method} 13 | \alias{getTile,Extent,ANY,ANY-method} 14 | \alias{getTile,Extent-method} 15 | \alias{getTile,bbox,ANY,ANY-method} 16 | \alias{getTile,bbox-method} 17 | \alias{getTile,Spatial,ANY,ANY-method} 18 | \alias{getTile,Spatial-method} 19 | \alias{getTile,sf,ANY,ANY-method} 20 | \alias{getTile,sf-method} 21 | \alias{getTile,sfc,ANY,ANY-method} 22 | \alias{getTile,sfc-method} 23 | \title{Get MODIS Tile ID(s)} 24 | \usage{ 25 | \S4method{getTile}{missing,missing,missing}(mode = c("click", "draw"), ...) 26 | 27 | \S4method{getTile}{missing,charORnum,charORnum}(x, tileH, tileV, ...) 28 | 29 | \S4method{getTile}{character,ANY,ANY}(x, tileH, tileV, ...) 30 | 31 | \S4method{getTile}{Raster,ANY,ANY}(x, tileH, tileV, ...) 32 | 33 | \S4method{getTile}{map,ANY,ANY}(x, tileH, tileV, ...) 34 | 35 | \S4method{getTile}{Extent,ANY,ANY}(x, tileH, tileV, ...) 36 | 37 | \S4method{getTile}{bbox,ANY,ANY}(x, tileH, tileV, ...) 38 | 39 | \S4method{getTile}{Spatial,ANY,ANY}(x, tileH, tileV, ...) 40 | 41 | \S4method{getTile}{sf,ANY,ANY}(x, tileH, tileV, ...) 42 | 43 | \S4method{getTile}{sfc,ANY,ANY}(x, tileH, tileV, ...) 44 | } 45 | \arguments{ 46 | \item{mode}{Interactive selection mode as \code{character}. Available options are 47 | \code{"click"} (default) and \code{"draw"} that trigger interactive MODIS tile 48 | selection and free feature drawing, respectively. Triggered only if 'x' and 49 | tile IDs are omitted.} 50 | 51 | \item{...}{Additional arguments passed to \code{\link[=MODISoptions]{MODISoptions()}}, see Details.} 52 | 53 | \item{x}{Extent information, see Details.} 54 | 55 | \item{tileH, tileV}{\code{numeric} or \code{character}. Horizontal and vertical tile 56 | number(s) of the \href{https://modis-land.gsfc.nasa.gov/MODLAND_grid.html}{MODIS Sinusoidal grid} 57 | (e.g., \code{tileH = 1:5}). Cropping is disabled here and full tiles (if more than 58 | one then also mosaicked) are processed instead. Ignored if 'x' is specified.} 59 | } 60 | \value{ 61 | A \code{MODISextent} object. 62 | } 63 | \description{ 64 | Get MODIS tile ID(s) for a specific geographic area. 65 | } 66 | \details{ 67 | Unless stated otherwise in the following, target 'outProj' and 'pixelSize' 68 | are carried over from \code{\link[=MODISoptions]{MODISoptions()}}. 69 | 70 | If 'x' is of class (see Examples for use cases) 71 | \tabular{ll}{ 72 | \code{missing}:\cr 73 | \tab If tile IDs (see Arguments) are also missing, a viewer window 74 | pops up that allows for interactive tile selection from the global MODIS 75 | Sinusoidal grid or, if \code{mode = "draw"}, free feature drawing.\cr 76 | \cr 77 | \code{character}:\cr 78 | \tab The country name of a \code{map} object (see \code{\link[maps:map]{maps::map()}}) with pattern 79 | matching via regular expressions enabled. Alternatively, a valid file path 80 | to a single ESRI shapefile (.shp) or an image readable by 81 | \code{\link[raster:raster]{raster::raster()}}.\cr 82 | \cr 83 | \verb{Raster*}:\cr 84 | \tab Spatial extent, resolution, and projection of the specified \verb{Raster*} 85 | are determined automatically. This information is used by \code{\link[=runGdal]{runGdal()}} to 86 | create perfectly matching files. If the \verb{Raster*} comes with no valid CRS, 87 | \href{https://spatialreference.org/ref/epsg/4326/}{EPSG:4326} is assumed.\cr 88 | \cr 89 | \code{Extent}, \code{bbox}:\cr 90 | \tab Boundary coordinates from \code{Extent} objects are generally assumed to be 91 | in \href{https://spatialreference.org/ref/epsg/4326/}{EPSG:4326} as such objects 92 | have no projection information attached. The same applies for \code{bbox} 93 | objects lacking CRS information.\cr 94 | \cr 95 | \code{sf}, \code{sfc}, \code{Spatial}:\cr 96 | \tab Except for resolution, same as for \verb{Raster*}.\cr 97 | \cr 98 | Other:\cr 99 | \tab A \code{map} object. 100 | } 101 | } 102 | \note{ 103 | \strong{MODIS} does no longer support the tile identification and automated 104 | download of MERIS and SRTM data. At least as far as the latter is concerned, 105 | easy data access is granted through \code{\link[raster:getData]{raster::getData()}}. 106 | } 107 | \examples{ 108 | \dontrun{ 109 | # ex 1 ############ 110 | # interactive tile selection 111 | getTile() 112 | getTile(mode = "draw") 113 | } 114 | 115 | # ex 2: Spatial ############ 116 | dsn <- system.file("ex/lux.shp", package = "terra") 117 | Up <- raster::shapefile(dsn, "Up") 118 | getTile(Up) 119 | 120 | # ex 3: sf ############ 121 | ifl <- system.file("shape/nc.shp", package = "sf") 122 | nc <- sf::st_read(ifl, quiet = TRUE) 123 | getTile(nc) 124 | 125 | # ex 4: tileH,tileV ############ 126 | getTile(tileH = 18:19, tileV = 4) 127 | 128 | # ex 5: Raster* with valid CRS ############ 129 | rst1 <- raster(xmn = 9.2, xmx = 17.47, ymn = 46.12, ymx = 49.3) 130 | getTile(rst1) 131 | 132 | # this also works for projected data 133 | rst3 <- projectExtent(rst1, crs = "+init=epsg:32633") 134 | getTile(rst3) 135 | 136 | # ex 6: Raster* without CRS or, alternatively, Extent or bbox --> treated as EPSG:4326 ############ 137 | mat2 <- matrix(seq(180 * 360), byrow = TRUE, ncol = 360) 138 | rst2 <- raster(mat2, xmn = -180, xmx = 180, ymn = -90, ymx = 90) 139 | getTile(rst2) 140 | getTile(extent(rst1)) 141 | getTile(sf::st_bbox(nc)) 142 | 143 | # ex 7: map names as returned by search4map() ############ 144 | getTile("Austria") 145 | getTile(c("Austria", "Germany")) 146 | 147 | # or search for specific map name patterns (use with caution): 148 | m1 <- search4map("Per") 149 | getTile(m1) 150 | 151 | # or use 'map' objects directly (remember to use map(..., fill = TRUE)): 152 | m2 <- map("state", region = "new jersey", fill = TRUE) 153 | getTile(m2) 154 | 155 | } 156 | \seealso{ 157 | \code{\link[raster:extent]{raster::extent()}}, \code{\link[sf:st_bbox]{sf::st_bbox()}}, \code{\link[maps:map]{maps::map()}}, \code{\link[=search4map]{search4map()}}. 158 | } 159 | \author{ 160 | Matteo Mattiuzzi, Florian Detsch 161 | } 162 | --------------------------------------------------------------------------------