# this function handles the parameter resamplingTpye and must be placed inside runMrt() and runGdal() checkResamplingType <- function(resamplingType,tool,quiet=FALSE) { if (missing(resamplingType)) { resamplingType <- "near" } resamplingType <- raster::trim(tolower(as.character(resamplingType))) tool <- toupper(tool) if (!tool %in% c("GDAL","MRT")) { stop("Unknown 'tool'. Allowed are 'MRT' or 'GDAL'") } if ("GDAL" %in% tool) { if (resamplingType %in% c("nn","cc","bil")) { if(resamplingType=="nn") { resamplingType <- "near" } if(resamplingType=="cc") { resamplingType <- "cubic" } if(resamplingType=="bil") { resamplingType <- "bilinear" } } else { # for efficiency gdv should be stored as variable gdv <- checkTools('GDAL',quiet=TRUE)$GDAL$vercheck if (gdv[2] < 10 & resamplingType %in% c("average","mode")) { stop("resamplingType= 'average' and 'mode' requires GDAL >= 1.10.0") } } } if (tool=="MRT") { if(resamplingType %in% c("near","nn")) { resamplingType <- "nn" } else if(resamplingType %in% c("cc","cubic")) { resamplingType <- "cc" } else if(resamplingType %in% c("bil","bilinear")) { resamplingType <- "bil" } else if (resamplingType %in% c("cubicspline","lanczos")) { if(!quiet) { warning(resamplingType," resamling is only supported by GDAL, not by MRT tool. If you use MRT 'near' is used insead") } resamplingType='nn' } else { if(!quiet) { warning(resamplingType," not supported by 'MRT' using 'NN'") } resamplingType='nn' } } if (resamplingType %in% c("cc","bil","bilinear","cubic","cubicspline","lanczos")) { if(!quiet) { warning("By not using resamplingType='near'/'nn' some SDS become useless (ie all bit encoded Quality SDS's, or 'day of the year' SDS's). It is strongly recommanded to use resamplingType='near'!") } } if (tool=="MRT") { toupper(resamplingType) } else { tolower(resamplingType) } return(resamplingType) } # checks validity of outProj and returns for tool="MRT" the short name (see mrt manual) and in case of "GDAL" the prj4 string! checkOutProj <- function(proj, tool, quiet=FALSE) { tool <- toupper(tool) if (!tool %in% c("GDAL", "MRT")) { stop("checkOptProj Error: Unknown 'tool'. Allowed are 'MRT' or 'GDAL'") } if(proj=="asIn") # lot of troubles because of this! { return(proj) } # this is here because we could think in a conversion between GDAL and MRT inputs! (the available in MRT is the limiting factor) MRTprojs <- matrix(byrow=T,ncol=2, c("AEA", "Albers Equal Area", "ER", "Equirectangular", "GEO", "Geographic", "IGH", "Interrupted Goode Homolosine", "HAM", "Hammer", "ISIN", "Integerized Sinusoidal", "LA", "Lambert Azimuthal Equal Area", "LCC", "Lambert Conformal Conic", "MERCAT", "Mercator", "MOL", "Molleweide", "PS", "Polar Stereographic", "SIN", "Sinusoidal", "TM", "Transverse Mercator", "UTM", "Universal Transverse Mercator"), dimnames=list(NULL,c("short","long"))) if (tool=="GDAL") # EPRS:xxxx or xxxx or "+proj=sin...." { # EPSGinfo is lazy loaded (see: minorFuns.R) inW <- getOption("warn") on.exit(options(warn=inW)) options(warn=-1) if(toupper(proj) %in% toupper(MRTprojs)) { if (toupper(proj) %in% c("GEO","GEOGRAPHIC")) { proj <- CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")@projargs } else if (toupper(proj) %in% c("SIN","SINUSOIDAL")) { proj <- CRS("+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs")@projargs } else { stop("Could not convert 'outProj' argunemt",proj, "to a sp::CRS compatible string!") } } else if(!is.na(as.numeric(proj))) { proj <- CRS(paste0("+init=epsg:",proj))@projargs } else if(length(grep(proj,pattern="EPSG:",ignore.case=TRUE))==1) { proj <- CRS(gsub(proj,pattern="^EPSG:",replacement="+init=epsg:", ignore.case=TRUE))@projargs } else if (inherits(proj,"CRS")) { proj <- proj@projargs } else { options(warn=inW) # here warning is usefull proj <- CRS(proj)@projargs } return(proj) } if (tool == "MRT") { ind <- grep(MRTprojs,pattern=paste("^",proj,"$",sep=""),ignore.case=TRUE) if(length(ind)==0) { cat("'outProj' must be one of:\n") return(MRTprojs) } else { if(ind > nrow(MRTprojs)) # catch short name { indL <- ind ind <- ind-nrow(MRTprojs) } else { indL <- ind+nrow(MRTprojs) } return(list(short = MRTprojs[ind],long = MRTprojs[indL])) } } } # returns 0 if a given GDAL supports HDF4 else 1 checkGdalDriver <- function(path=NULL) { inW <- getOption("warn") on.exit(options(warn=inW)) options(warn=-1) path <- correctPath(path) cmd <- paste0(path,'gdalinfo --formats') if(.Platform$OS=="windows") { driver <- try(shell(cmd,intern=TRUE),silent=TRUE) } else { driver <- try(system(cmd,intern=TRUE), silent=TRUE) } if (class(driver) == "try-error") { options(warn=inW) warning("No gdal installation found please install 'gdal' on your system first!") return(FALSE) } if(length(grep(driver,pattern="HDF4"))==0) { return(FALSE) } else { return(TRUE) } } combineOptions <- function(checkTools = TRUE, ...) { opts <- options() opts <- opts[grep(names(opts),pattern="^MODIS_*.")] # isolate MODIS_opts if(length(opts)==0) # if nothing available look for initial options { # if(!file.exists("~/.MODIS_Opts.R")) { # warning("File '~/.MODIS_Opts.R' not found. " # , "Run MODISoptions() to make settings permanent!") # } requireNamespace("MODIS", quietly = TRUE) MODISoptions(save=FALSE, checkTools = checkTools) opts <- options() # collects all options opts <- opts[grep(names(opts),pattern="^MODIS_*.")] # isolate MODIS_opts } names(opts) <- gsub(names(opts),pattern="MODIS_",replacement="") # convert names to function arg style Fopts <- list(...) # collects fun args if (length(Fopts)==0) { Fopts <- NULL } opts <- c(Fopts, opts[(!names(opts) %in% names(Fopts))]) return(opts) }