1 2.terra_environment <- new.env(parent=emptyenv()) 3 4 5.create_options <- function() { 6 opt <- methods::new("SpatOptions") 7 opt@ptr <- SpatOptions$new() 8 # check=T does not exist in ancient R 9 tmpdir <- try(tempdir(check = TRUE), silent=TRUE) 10 opt@ptr$tempdir <- normalizePath(tempdir(), winslash="/") 11 .terra_environment$options <- opt 12} 13 14.options_names <- function() { 15 c("progress", "tempdir", "memfrac", "datatype", "filetype", "filenames", "overwrite", "todisk", "names", "verbose", "NAflag", "statistics", "steps", "ncopies", "tolerance") #, "append") 16} 17 18 19.setOptions <- function(x, wopt) { 20 21 nms <- names(wopt) 22 23 g <- which(nms == "gdal") 24 if (length(g) > 0) { 25 gopt <- unlist(wopt[g]) 26 wopt <- wopt[-g] 27 nms <- nms[-g] 28 i <- grep("=", gopt) 29 gopt <- gopt[i] 30 gopt <- gsub(" ", "", gopt) 31 x$gdal_options <- gopt 32 } 33 34 s <- nms %in% .options_names() 35 36 if (any(!s)) { 37 bad <- paste(nms[!s], collapse=",") 38 error("write", "unknown option(s): ", bad) 39 } 40 41 if (any(s)) { 42 nms <- nms[s] 43 wopt <- wopt[s] 44 i <- which(nms == "names") 45 if (length(i) > 0) { 46 namevs <- trimws(unlist(strsplit(wopt[[i]], ","))) 47 x[["names"]] <- namevs 48 wopt <- wopt[-i] 49 nms <- nms[-i] 50 } 51 52 for (i in seq_along(nms)) { 53 x[[nms[i]]] <- wopt[[i]] 54 } 55 if ("datatype" %in% nms) { 56 x$datatype_set = TRUE; 57 } 58 } 59 60 x 61} 62 63defaultOptions <- function() { 64 ## work around onLoad problem 65 if (is.null(.terra_environment$options)) .create_options() 66 .terra_environment$options@ptr$deepcopy() 67} 68 69spatOptions <- function(filename="", overwrite=FALSE, ..., wopt=NULL) { 70 71 wopt <- c(list(...), wopt) 72 73 ## work around onLoad problem 74 if (is.null(.terra_environment$options)) .create_options() 75 76 opt <- .terra_environment$options@ptr$deepcopy() 77 78 filename <- .fullFilename(filename, mustExist=FALSE) 79 if (!is.null(unlist(wopt))) { 80 wopt$filenames <- filename 81 wopt$overwrite <- overwrite[1] 82 opt <- .setOptions(opt, wopt) 83 } else { 84 opt$filenames <- filename 85 opt$overwrite <- overwrite[1] 86 } 87 #messages(opt) 88 #opt$todisk <- TRUE 89 opt 90} 91 92#..getOptions <- function() { 93# spatOptions("", TRUE, list()) 94#} 95 96#..showOptions <- function(opt) { 97# cat("Options for package 'terra'\n") 98# cat("memfrac :" , opt$memfrac, "\n") 99# cat("tempdir :" , opt$tempdir, "\n") 100# cat("datatype :" , opt$def_datatype, "\n") 101# cat("filetype :" , opt$def_filetype, "\n") 102# cat("progress :" , opt$progress, "\n") 103# cat("verbose :" , opt$verbose, "\n") 104# if (opt$todisk) { 105# cat("todisk :" , opt$todisk, "\n") 106# } 107#} 108 109.showOptions <- function(opt) { 110 nms <- c("memfrac", "tempdir", "datatype", "progress", "todisk", "verbose", "tolerance") 111 for (n in nms) { 112 v <- eval(parse(text=paste0("opt$", n))) 113 cat(paste0(substr(paste(n, " "), 1, 10), ": ", v, "\n")) 114 } 115} 116 117 118.default_option_names <- function() { 119 c("datatype", "filetype") #, "verbose") 120} 121 122 123 124terraOptions <- function(...) { 125 dots <- list(...) 126 if (is.null(.terra_environment$options)) .create_options() 127 opt <- .terra_environment$options@ptr 128 if (length(dots) == 0) { 129 .showOptions(opt) 130 } else { 131 nms <- names(dots) 132 d <- nms %in% .default_option_names() 133 dnms <- paste0("def_", nms) 134 for (i in 1:length(nms)) { 135 if (d[i]) { 136 opt[[ dnms[i] ]] <- dots[[ i ]] 137 } else { 138 opt[[ nms[i] ]] <- dots[[ i ]] 139 } 140 } 141 if ("memfrac" %in% nms) { 142 if (dots$memfrac > 0.9) { 143 warn("terraOptions", "memfrac > 0.9") 144 } 145 } 146 .terra_environment$options@ptr <- opt 147 } 148} 149 150