1# Author: Robert J. Hijmans 2# September 2009 3# Version 1.0 4# Licence GPL v3 5 6 7rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress, timer, chunksize, maxmemory, memfrac, todisk, setfileext, tolerance, standardnames, depracatedwarnings, addheader, default=FALSE) { 8 9 setFiletype <- function(format) { 10 if (.isSupportedFormat(format)) { 11 options(rasterFiletype = format) 12 } else { 13 warning(paste('Cannot set filetype to unknown or unsupported file format:', format, '. See writeFormats()')) 14 } 15 } 16 17 setOverwrite <- function(overwrite) { 18 if (is.logical(overwrite)) { 19 options(rasterOverwrite = overwrite) 20 } else { 21 warning(paste('Could not set overwrite. It must be a logical value')) 22 } 23 } 24 25 setDataType <- function(datatype) { 26 if (datatype %in% c('LOG1S', 'INT1S', 'INT2S', 'INT4S', 'INT4U', 'INT1U', 'INT2U', 'FLT4S', 'FLT8S')) { 27 options(rasterDatatype = datatype) 28 } else { 29 warning(paste('Cannot set datatype to unknown type:',datatype)) 30 } 31 } 32 33 setTmpdir <- function(tmpdir) { 34 if (!missing(tmpdir)) { 35 tmpdir <- trim(tmpdir) 36 if (tmpdir != '') { 37 lastchar = substr(tmpdir, nchar(tmpdir), nchar(tmpdir)) 38 if (lastchar != "/" & lastchar != '\\') { 39 tmpdir <- paste(tmpdir, '/', sep='') 40 } 41 #res <- file.exists(substr(tmpdir, 1, nchar(tmpdir)-1)) 42 #if (!res) { 43 # res <- dir.create(tmpdir, recursive=TRUE, showWarnings = FALSE) 44 #} 45 #if (res) { 46 options(rasterTmpDir = tmpdir) 47 #} else { 48 # warning(paste('could not create tmpdir:', tmpdir)) 49 #} 50 } 51 } 52 } 53 54 setTmpTime <- function(tmptime) { 55 if (is.numeric(tmptime)) { 56 if (tmptime > 1) { 57 options(rasterTmpTime = tmptime) 58 } else { 59 warning(paste('Could not set tmptime. It must be > 1')) 60 } 61 } else { 62 warning(paste('Could not set tmptime. It must be a numerical value')) 63 } 64 } 65 66 setProgress <- function(progress) { 67 if (is.character(progress)) { 68 progress <- tolower(trim(progress)) 69 if (progress %in% c('window', 'tcltk', 'windows')) { progress <- 'window' } 70 if (! progress %in% c('text', 'window', '')) { 71 warning('invalid value for progress. Should be "window", "text", or ""') 72 } else { 73 options(rasterProgress = progress ) 74 } 75 } else { 76 warning('progress must be a character value') 77 } 78 } 79 80 setTimer <- function(timer) { 81 if (is.logical(timer)) { 82 options(rasterTimer = timer ) 83 } else { 84 warning(paste('timer must be a logical value')) 85 } 86 } 87 88 89 setToDisk <- function(todisk) { 90 if (is.logical(todisk)) { 91 options(rasterToDisk = todisk ) 92 } else { 93 warning(paste('todisk argument must be a logical value')) 94 } 95 } 96 97 setChunksize <- function(chunksize) { 98 chunksize <- max(1, round(chunksize[1])) 99 #chunksize <- min(chunksize, 10^7) 100 options(rasterChunkSize = chunksize ) 101 } 102 103 setFileExt <- function(setfileext) { 104 options(rasterSetFileExt = as.logical(setfileext) ) 105 } 106 107 setMaxMemorySize <- function(maxmemory) { 108 maxmemory = max(10000, round(maxmemory[1])) 109 options(rasterMaxMemory = maxmemory ) 110 } 111 112 setMemfrac <- function(memfrac) { 113 if (memfrac >= 0.1 & memfrac <= 0.9) { 114 options(rasterMemfrac = memfrac ) 115 } else { 116 warning(paste('memfrac argument must be a value between 0.1 and 0.9')) 117 } 118 } 119 120 121 setTolerance <- function(x) { 122 x <- max(0.000000001, min(x, 0.5)) 123 options(rasterTolerance = x) 124 } 125 126 setStandardNames <- function(x) { 127 if (is.logical(x)) { 128 if (is.na(x)) { 129 x <- TRUE 130 } 131 options(rasterStandardNames = x) 132 } 133 } 134 135 depracatedWarnings <- function(x) { 136 if (is.logical(x)) { 137 if (is.na(x)) { 138 x <- TRUE 139 } 140 options(rasterDepracatedWarnings = x) 141 } 142 } 143 144 145 addHeader <- function(x) { 146 x <- x[1] 147 if (is.character(x)) { 148 x <- toupper(trim(x)) 149 if (nchar(x) < 3) { 150 x <- '' 151 } 152 options(rasterAddHeader = x) 153 } 154 } 155 156 157 cnt <- 0 158 if (default) { 159 cnt <- 1 160 options(rasterFiletype = 'raster') 161 options(rasterOverwrite = FALSE) 162 options(rasterDatatype = 'FLT4S') 163 options(rasterProgress = 'none') 164 options(rasterTimer = FALSE) 165 options(rasterTmpDir = tmpDir(create=FALSE)) 166 options(rasterTmpTime = 24*7) 167 options(rasterToDisk = FALSE) 168 options(rasterSetFileExt = TRUE) 169 options(rasterChunkSize = 10^9) 170 options(rasterChunk = 10^9) 171 options(rasterMaxMemory = 2e+10) 172 options(rasterMemfrac = 0.6) 173 options(rasterTolerance = 0.1) 174 options(rasterStandardNames = TRUE) 175 options(rasterDepracatedWarnings = TRUE) 176 options(rasterAddHeader = '') 177 v <- utils::packageDescription('raster')[["Version"]] 178# fn <- paste(options('startup.working.directory'), '/rasterOptions_', v, sep='') 179# if (file.exists(fn)) { file.remove(fn) } 180 } 181 182 183 if (!missing(format)) { setFiletype(format); cnt <- cnt+1 } 184 if (!missing(overwrite)) { setOverwrite(overwrite); cnt <- cnt+1 } 185 if (!missing(datatype)) { setDataType(datatype); cnt <- cnt+1 } 186 if (!missing(progress)) { setProgress(progress); cnt <- cnt+1 } 187 if (!missing(timer)) { setTimer(timer); cnt <- cnt+1 } 188 if (!missing(tmpdir)) { setTmpdir(tmpdir); cnt <- cnt+1 } 189 if (!missing(tmptime)) { setTmpTime(tmptime); cnt <- cnt+1 } 190 if (!missing(todisk)) { setToDisk(todisk); cnt <- cnt+1 } 191 if (!missing(setfileext)) { setFileExt(setfileext); cnt <- cnt+1 } 192 if (!missing(maxmemory)) { setMaxMemorySize(maxmemory); cnt <- cnt+1 } 193 if (!missing(memfrac)) { setMemfrac(memfrac); cnt <- cnt+1 } 194 if (!missing(chunksize)) { setChunksize(chunksize); cnt <- cnt+1 } 195 if (!missing(tolerance)) { setTolerance(tolerance); cnt <- cnt+1 } 196 if (!missing(standardnames)) { setStandardNames(standardnames); cnt <- cnt+1 } 197 if (!missing(depracatedwarnings)) { depracatedWarnings(depracatedwarnings); cnt <- cnt+1 } 198 if (!missing(addheader)) {addHeader(addheader) ; cnt <- cnt+1 } 199 200 201 lst <- list( 202 format=.filetype(), 203 overwrite=.overwrite(), 204 datatype=.datatype(), 205 tmpdir= tmpDir(create=FALSE), 206 tmptime=.tmptime(), 207 progress=.progress(), 208 timer=.timer(), 209 chunksize=.chunksize(), 210 maxmemory=.maxmemory(), 211 memfrac = .memfrac(), 212 todisk=.toDisk(), 213 setfileext=.setfileext(), 214 tolerance=.tolerance(), 215 standardnames=.standardnames(), 216 depwarning=.depracatedwarnings(), 217 addheader=.addHeader() 218 ) 219 220 save <- FALSE 221 if (save) { 222 223 v <- utils::packageDescription('raster')[["Version"]] 224 fn <- paste(options('startup.working.directory'), '/rasterOptions_', v, sep='') 225 oplst <- NULL 226 oplst <- c(oplst, paste("rasterFiletype='", lst$format, "'", sep='')) 227 oplst <- c(oplst, paste("rasterOverwrite=", lst$overwrite, sep='')) 228 oplst <- c(oplst, paste("rasterDatatype='", lst$datatype, "'", sep='')) 229 oplst <- c(oplst, paste("rasterTmpDir='", lst$tmpdir, "'", sep='')) 230 oplst <- c(oplst, paste("rasterTmpTime='", lst$tmptime, "'", sep='')) 231 oplst <- c(oplst, paste("rasterProgress='", lst$progress, "'", sep='')) 232 oplst <- c(oplst, paste("rasterTimer=", lst$timer, sep='')) 233 oplst <- c(oplst, paste("rasterChunkSize=", lst$chunksize, sep='')) 234 oplst <- c(oplst, paste("rasterMaxMemory=", lst$maxmemory, sep='')) 235 oplst <- c(oplst, paste("rasterMemfrac=", lst$memfrac, sep='')) 236 oplst <- c(oplst, paste("rasterSetFileExt=", lst$setfileext, sep='')) 237 oplst <- c(oplst, paste("rasterTolerance=", lst$tolerance, sep='')) 238 oplst <- c(oplst, paste("rasterStandardNames=", lst$standardnames, sep='')) 239 oplst <- c(oplst, paste("rasterDepracatedWarnings=", lst$depwarning, sep='')) 240 oplst <- c(oplst, paste("rasterAddHeader=", lst$addheader, sep='')) 241 242 r <- try( write(unlist(oplst), fn), silent = TRUE ) 243 244 cnt <- 1 245 } 246 247 248 if (cnt == 0) { 249 cat('format :', lst$format, '\n' ) 250 cat('datatype :', lst$datatype, '\n') 251 cat('overwrite :', lst$overwrite, '\n') 252 cat('progress :', lst$progress, '\n') 253 cat('timer :', lst$timer, '\n') 254 cat('chunksize :', lst$chunksize, '\n') 255 cat('maxmemory :', lst$maxmemory, '\n') 256 cat('memfrac :', lst$memfrac, '\n') 257 cat('tmpdir :', lst$tmpdir, '\n') 258 cat('tmptime :', lst$tmptime, '\n') 259 cat('setfileext :', lst$setfileext, '\n') 260 cat('tolerance :', lst$tolerance, '\n') 261 cat('standardnames :', lst$standardnames, '\n') 262 cat('warn depracat.:', lst$depwarning, '\n') 263 if (lst$addheader == '') { 264 cat('header : none\n') 265 } else { 266 cat('header :', lst$addheader, '\n') 267 } 268 if (lst$todisk) { 269 cat('todisk : TRUE\n') 270 } 271 } 272 273 invisible(lst) 274} 275 276 277.loadOptions <- function(f) { 278 if (file.exists(f)) { 279 dd <- readLines(f) 280 for (d in dd) { 281 try(eval(parse(text=paste("options(", d, ")")))) 282 } 283 } 284} 285 286 287 288.addHeader <- function() { 289 d <- getOption('rasterAddHeader') 290 if (is.null(d)) { 291 return( '' ) 292 } else { 293 return(trim(d)) 294 } 295} 296 297.depracatedwarnings <- function() { 298 d <- getOption('rasterDepracatedWarnings') 299 if (is.null(d)) { 300 return( TRUE ) 301 } else { 302 return(as.logical(d)) 303 } 304} 305 306 307 308.dataloc <- function() { 309 d <- getOption('rasterDataDir') 310 if (is.null(d) ) { 311 d <- getwd() 312 } else { 313 d <- trim(d) 314 if (d=='') { 315 d <- getwd() 316 } 317 } 318 return(d) 319} 320 321 322.tmpdir <- function(...) { 323 tmpDir(...) 324} 325 326 327tmpDir <- function(create=TRUE) { 328 d <- getOption('rasterTmpDir') 329 if (is.null(d)) { 330 d <- .tmppath() 331 } 332 #lastchar <- substr(d, nchar(d), nchar(d)) 333 # if (lastchar == '/' | lastchar == '\\') { 334 # d <- substr( d, 1, nchar(d)-1 ) 335 #} 336 if (!file.exists(d) & create) { 337 dir.create( d, recursive=TRUE, showWarnings=FALSE ) 338 } 339 return(d) 340} 341 342 343 344.setfileext <- function() { 345 d <- getOption('rasterSetFileExt') 346 if (is.null(d)) { 347 return( TRUE ) 348 } 349 return(as.logical(d)) 350} 351 352 353 354.tmptime <- function() { 355 d <- getOption('rasterTmpTime') 356 if (is.null(d)) { 357 d <- 24 * 7 358 } else { 359 d <- as.numeric(d) 360 if (d < 0) { 361 d <- 24 * 7 362 } 363 } 364 return(d) 365} 366 367 368.memfrac <- function() { 369 default <- 0.6 370 d <- getOption('rasterMemfrac') 371 if (is.null(d)) { 372 return( default ) 373 } else { 374 return(d) 375 } 376} 377 378 379.maxmemory <- function() { 380 default <- 5e+9 381 d <- getOption('rasterMaxMemory') 382 if (is.null(d)) { 383 return( default ) 384 } 385 d <- round(as.numeric(d[1])) 386 if (is.na(d) | d < 1e+6) { 387 d <- 1e+6 388 } 389 return(d) 390} 391 392 393.chunksize <- function(){ 394 default <- 10^8 395 d <- getOption('rasterChunkSize') 396 if (is.null(d)) { 397 return( default ) 398 } 399 d <- round(as.numeric(d[1])) 400 if (is.na(d) | d < 10000) { 401 d <- default 402 } 403 return(d) 404} 405 406 407.chunk <- function(){ 408 d <- getOption('rasterChunk') 409 if (is.null(d)) { 410 return( .chunksize() ) 411 } 412 if (is.na(d) | d < 10000) { 413 return( .chunksize() ) 414 } 415 return(d) 416} 417 418 419 420.tolerance <- function() { 421 d <- getOption('rasterTolerance') 422 if (is.null(d)) { 423 d <- 0.1 424 } else { 425 d <- max(0.000000001, min(d, 0.5)) 426 } 427 return(d) 428} 429 430 431.overwrite <- function(..., overwrite) { 432 if (missing(overwrite)) { 433 overwrite <- getOption('rasterOverwrite') 434 if (is.null(overwrite)) { 435 return(FALSE) 436 } else { 437 if (is.logical(overwrite)) { 438 return(overwrite) 439 } else { 440 return(FALSE) 441 } 442 } 443 } else { 444 if (is.logical(overwrite)) { 445 return(overwrite) 446 } else { 447 return(FALSE) 448 } 449 } 450} 451 452 453.datatype <- function(..., datatype, dataType) { 454 455 if (missing(datatype) && !missing(dataType)) { 456 warning('argument "datatype" misspelled as "dataType"') 457 datatype <- dataType 458 } else if (missing(datatype)) { 459 datatype <- getOption('rasterDatatype') 460 if (is.null(datatype)) { 461 return('FLT4S') 462 } 463 } 464 if (! datatype %in% c('LOG1S', 'INT1S', 'INT2S', 'INT4S', 'INT1U', 'INT2U', 'INT4U', 'FLT4S', 'FLT8S')) { 465 warning(datatype, ' is an invalid datatype value, changed to "FLT4S"') 466 datatype <- 'FLT4S' 467 } 468 return(datatype) 469} 470 471.getFormat <- function(filename) { 472 ext <- tolower(extension(filename, maxchar=5)) 473 if (nchar(ext) < 3) { 474 return('') 475 } else { 476 if (ext == '.tif' | ext == '.tiff') { return('GTiff') 477 } else if (ext == '.grd') { return('raster') 478 } else if (ext == '.asc') { return('ascii') 479 } else if (ext == '.nc' | ext == '.cdf' | ext == '.ncdf') { return('CDF') 480 } else if (ext == '.kml') { return('KML') 481 } else if (ext == '.kmz') { return('KML') 482# } else if (ext == '.big') { return('big.matrix') 483 } else if (ext == '.sgrd') { return('SAGA') 484 } else if (ext == '.sdat') { return('SAGA') 485 } else if (ext == '.bil') { return('BIL') 486 } else if (ext == '.bsq') { return('BSQ') 487 } else if (ext == '.bip') { return('BIP') 488 } else if (ext == '.bmp') { return('BMP') 489 } else if (ext == '.gen') { return('ADRG') 490 } else if (ext == '.bt') { return('BT') 491 } else if (ext == '.envi') { return('ENVI') 492 } else if (ext == '.ers') { return('ERS') 493 } else if (ext == '.img') { return( 'HFA') 494 } else if (ext == '.rst') { return('RST') 495 } else if (ext == '.mpr') { return('ILWIS') 496 } else if (ext == '.rsw') { return('RMF') 497 } else if (ext == '.flt') { return('EHdr') 498 } else { 499 warning('extension ', ext, ' is unknown. Using default format.') 500 return('') 501 } 502 } 503 504} 505 506 507.filetype <- function(format, filename='', ...) { 508 if (missing(format)) { 509 format <- .getFormat(filename) 510 if (format != '') { 511 return(format) 512 } 513 514 format <- getOption('rasterFiletype') 515 if (is.null(format)) { 516 return('raster') 517 } else { 518 return(format) 519 } 520 521 } else { 522 return(format) 523 } 524} 525 526.progress <- function(..., progress) { 527 if (missing(progress)) { 528 progress <- getOption('rasterProgress') 529 if (is.null(progress)) { 530 return('none') 531 } else { 532 if (is.character(progress)) { 533 if (progress[1] %in% c('text', 'window', 'tcltk', 'windows')) { 534 return(progress[1]) 535 } else { 536 return('none') 537 } 538 } else { 539 return('none') 540 } 541 } 542 } else { 543 if (is.character(progress)) { 544 if (progress[1] %in% c('text', 'window', 'tcltk', 'windows')) { 545 return(progress[1]) 546 } else { 547 return('none') 548 } 549 } else { 550 return('none') 551 } 552 } 553} 554 555 556.timer <- function(..., timer) { 557 if (missing(timer)) { 558 timer <- getOption('rasterTimer') 559 if (is.null(timer)) { 560 return(FALSE) 561 } else { 562 return( as.logical(timer) ) 563 } 564 } else { 565 return(as.logical(timer)) 566 } 567} 568 569.standardnames <- function(..., standardnames) { 570 if (missing(standardnames)) { 571 standardnames <- getOption('rasterStandardNames') 572 if (is.null(standardnames)) { 573 return(TRUE) # the default 574 } else { 575 try (todisk <- as.logical(standardnames)) 576 if (is.logical(standardnames)) { 577 return(standardnames) 578 } else { 579 return(TRUE) 580 } 581 } 582 } else { 583 if (is.logical(todisk)) { 584 return(todisk) 585 } else { 586 return(TRUE) 587 } 588 } 589} 590 591 592.toDisk <- function(..., todisk) { 593 if (missing(todisk)) { 594 todisk <- getOption('rasterToDisk') 595 if (is.null(todisk)) { 596 return(FALSE) # the default 597 } else { 598 try (todisk <- as.logical(todisk)) 599 if (is.logical(todisk)) { 600 return(todisk) 601 } else { 602 return(FALSE) 603 } 604 } 605 } else { 606 if (is.logical(todisk)) { 607 return(todisk) 608 } else { 609 return(FALSE) 610 } 611 } 612} 613 614 615.usecluster <- function(...) { 616 usecluster <- list(...)$usecluster 617 if (is.null(usecluster)) { 618 usecluster <- getOption('rasterUseCluster') 619 if (is.null(usecluster)) { 620 return(FALSE) # the default 621 } else { 622 try (usecluster <- as.logical(usecluster), silent=TRUE) 623 if (isTRUE(usecluster)) { 624 return(TRUE) 625 } else { 626 return(FALSE) 627 } 628 } 629 } else { 630 if (is.logical(usecluster)) { 631 return(usecluster) 632 } else { 633 return(FALSE) 634 } 635 } 636} 637 638.removeRasterOptions <- function(x) { 639 y <- list() 640 for (i in seq(along.with=x)) { 641 if (!trim(x[[i]]) == "# Options for the 'raster' package" & !substr(trim(x[[i]]),1,14) == 'options(raster') { 642 y <- c(y, x[[i]]) 643 } 644 } 645 return(y) 646} 647 648 649.tmppath <- function() { 650 file.path(tempdir(), 'raster', '/') 651} 652 653