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