.RAMavailable funtion and mem options changes

ChangeLog

@@ -11,6 +11,7 @@ Better handling of NA values in 1 byte raster files
 --- current version
 testthat unit tests introduced by Mike Sumner and Jakub Nowosad
 as.character() for Raster objects to create the R code to re-create the Raster skeleton in examples.
+improved estimation of available RAM with contributions by Lorenzo Busetto 
 
 Bug fixes:
 fixed the link for GADM countries download. Bug reported by Loic Dutrieux
@@ -609,7 +610,7 @@ predict automatic removal (to NA) of factor levels not used to build the model
 --- 29-Nov-2010,  version 1.7-6
 New function as.array
 improved sampleRegular for multi-layer objects
-Code simplications for 'raster', 'stack', and 'brick' functions
+Code simplifications for 'raster', 'stack', and 'brick' functions
 raster no longer has the "values" argument (use setValues)
 When adding layers to a RasterBrick, a RasterStack will be returned.
 Fixed calc for regression functions

R/RcppExports.R

@@ -13,6 +13,10 @@
     .Call(`_raster_getPolygons`, xyv, res, nodes)
 }
 
+.availableRAM <- function(defmem) {
+    .Call(`_raster_availableRAM`, defmem)
+}
+
 .getMode <- function(values, ties) {
     .Call(`_raster_getMode`, values, ties)
 }

R/canProcessInMemory.R

@@ -4,8 +4,30 @@
 # Licence GPL v3
 
 
-canProcessInMemory <- function(x, n=4) {
+.RAMavailable <- function(defmem, useC=TRUE) {
+
+	if (useC) {
+		memavail <- .availableRAM(defmem)
+	} else {
+		if ( .Platform$OS.type == "windows" ) {
+			mem <- system2("wmic", args = "OS get FreePhysicalMemory /Value", stdout = TRUE)
+			mem3 <- gsub("\r", "", mem[3])
+			mem3 <- gsub("FreePhysicalMemory=", "", mem3)
+			memavail <- as.numeric(mem3) * 1024
+			#memavail <- 0.5 * (utils::memory.size(NA) - utils::memory.size(FALSE))
+		} else if ( .Platform$OS.type == "unix" ) {
+			memavail <- as.numeric(system("awk '/MemFree/ {print $2}' /proc/meminfo", intern=TRUE))
+		} else {
+			#don't know how to do it for mac
+			memavail <- defmem
+		}
+	}
+	memavail
+
+}
+
 
+canProcessInMemory <- function(x, n=4, verbose=FALSE) {
 
 # for testing purposes
 #	rasterOptions(format='GTiff')
@@ -23,43 +45,23 @@ canProcessInMemory <- function(x, n=4) {
 	n <- n * nlayers(x)
 	memneed <- ncell(x) * n * 8
 
-	if (.estimateMem()) {
-
-		if ( .Platform$OS.type == "windows" ) {
-
-			mem <- system2("wmic", args = "OS get FreePhysicalMemory /Value", stdout = TRUE)
-			mem3 <- gsub("\r", "", mem[3])
-			mem3 <- gsub("FreePhysicalMemory=", "", mem3)
-			memavail <- as.numeric(mem3) * 1024
-
-			#memavail <- 0.5 * (utils::memory.size(NA) - utils::memory.size(FALSE))
-		} else { #if ( .Platform$OS.type == "unix" ) {
-			memavail <- as.numeric(system("awk '/MemFree/ {print $2}' /proc/meminfo", intern=TRUE))
-		} #else {
-			# mac? or is that also "unix"
-		#}
-
-		# can't use all of it
-		memavail <- 0.75 * memavail
-
-		#print(paste("mem available:", memavail))
-		#print(paste("mem needed:", memneed))
-
+	maxmem <- .maxmemory()
+	memavail <- .RAMavailable(maxmem, TRUE)
+	if (verbose) {
+		print(paste("mem available:", memavail))
+		print(paste("mem needed:", memneed))
+	}
+	memavail <- min(memavail, maxmem)
 
-		if (memneed > memavail) {
-			# options(rasterChunkSize = memavail * 0.5 )
-			return(FALSE)
-		} else {
-			return(TRUE)
-		}
+	# can't use all of it
+	memavail <- 0.75 * memavail
 
+	if (memneed > memavail) {
+		# options(rasterChunkSize = memavail * 0.5 )
+		return(FALSE)
 	} else {
-
-		if ( memneed > .maxmemory() ) {
-			return(FALSE)
-		} else {
-			return(TRUE)
-		}
+		return(TRUE)
 	}
+
 }
 

R/rasterOptions.R

@@ -4,7 +4,7 @@
 # Licence GPL v3
 
 
-rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress, timer, chunksize, maxmemory, todisk, setfileext, tolerance, standardnames, depracatedwarnings, addheader, estimatemem, default=FALSE) {
+rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress, timer, chunksize, maxmemory, todisk, setfileext, tolerance, standardnames, depracatedwarnings, addheader, default=FALSE) {
 
 
 
@@ -111,13 +111,13 @@ rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress
 		options(rasterMaxMemory = maxmemory )
 	}
 
-	setEstimateMem <- function(estimatemem) {
-		if (is.logical(estimatemem)) { 
-			options(rasterEstimateMem = estimatemem )
-		} else {
-			warning(paste('estimateMem argument must be a logical value'))	
-		}
-	}
+#	setEstimateMem <- function(estimatemem) {
+#		if (is.logical(estimatemem)) { 
+#			options(rasterEstimateMem = estimatemem )
+#		} else {
+#			warning(paste('estimateMem argument must be a logical value'))	
+#		}
+#	}
 
 
 	setTolerance <- function(x) {
@@ -168,9 +168,9 @@ rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress
 		options(rasterTmpTime = 24*7)
 		options(rasterToDisk = FALSE)
 		options(rasterSetFileExt = TRUE)
-		options(rasterChunkSize = 10^7)
-		options(rasterMaxMemory = 10^8)
-		options(rasterEstimateMem = FALSE)
+		options(rasterChunkSize = 10^8)
+		options(rasterMaxMemory = 10^9)
+#		options(rasterEstimateMem = TRUE)
 		options(rasterTolerance = 0.1)
 		options(rasterStandardNames = TRUE)
 		options(rasterDepracatedWarnings = TRUE)
@@ -191,7 +191,7 @@ rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress
 	if (!missing(todisk)) { setToDisk(todisk); cnt <- cnt+1 }
 	if (!missing(setfileext)) { setFileExt(setfileext); cnt <- cnt+1 }
 	if (!missing(maxmemory)) { setMaxMemorySize(maxmemory); cnt <- cnt+1 }
-	if (!missing(estimatemem)) { setEstimateMem(estimatemem); cnt <- cnt+1 }
+#	if (!missing(estimatemem)) { setEstimateMem(estimatemem); cnt <- cnt+1 }
 	if (!missing(chunksize)) { setChunksize(chunksize); cnt <- cnt+1 }
 	if (!missing(tolerance)) { setTolerance(tolerance); cnt <- cnt+1 }
 	if (!missing(standardnames)) { setStandardNames(standardnames); cnt <- cnt+1 }
@@ -214,8 +214,8 @@ rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress
 		tolerance=.tolerance(),
 		standardnames=.standardnames(),
 		depwarning=.depracatedwarnings(),
-		addheader=.addHeader(),
-		estimatemem = .estimateMem()
+		addheader=.addHeader()
+#		estimatemem = .estimateMem()
 	)
 
 	save <- FALSE
@@ -233,7 +233,7 @@ rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress
 		oplst <- c(oplst, paste("rasterTimer=", lst$timer, sep=''))
 		oplst <- c(oplst, paste("rasterChunkSize=", lst$chunksize, sep=''))
 		oplst <- c(oplst, paste("rasterMaxMemory=", lst$maxmemory, sep=''))
-		oplst <- c(oplst, paste("rasterEstimateMem=", lst$estimatemem, sep=''))
+#		oplst <- c(oplst, paste("rasterEstimateMem=", lst$estimatemem, sep=''))
 		oplst <- c(oplst, paste("rasterSetFileExt=", lst$setfileext, sep=''))
 		oplst <- c(oplst, paste("rasterTolerance=", lst$tolerance, sep=''))
 		oplst <- c(oplst, paste("rasterStandardNames=", lst$standardnames, sep=''))
@@ -254,7 +254,7 @@ rasterOptions <- function(format, overwrite, datatype, tmpdir, tmptime, progress
 		cat('timer         :', lst$timer, '\n')
 		cat('chunksize     :', lst$chunksize, '\n')
 		cat('maxmemory     :', lst$maxmemory, '\n')
-		cat('estimatemem   :', lst$estimatemem, '\n')
+#		cat('estimatemem   :', lst$estimatemem, '\n')
 		cat('tmpdir        :', lst$tmpdir, '\n')
 		cat('tmptime       :', lst$tmptime, '\n')
 		cat('setfileext    :', lst$setfileext, '\n')
@@ -342,21 +342,6 @@ tmpDir <- function(create=TRUE) {
 
 
 
-.chunksize <- function(){
-	default <- 10^7
-	d <- getOption('rasterChunkSize')
-	if (is.null(d)) {
-		return( default )
-	} 
-	d <- round(as.numeric(d[1]))
-	if (is.na(d) | d < 10000) {
-		d <- default
-	} 
-	return(d)
-}	
-
-
-
 .setfileext <- function() {
 	d <- getOption('rasterSetFileExt')
 	if (is.null(d)) {
@@ -381,20 +366,34 @@ tmpDir <- function(create=TRUE) {
 }	
 
 
-.estimateMem <- function() {
-	default <- FALSE
-	d <- getOption('rasterEstimateMem')
+#.estimateMem <- function() {
+#	default <- FALSE
+#	d <- getOption('rasterEstimateMem')
+#	if (is.null(d)) {
+#		return( default )
+#	} else {
+#		return(isTRUE(d))
+#	}
+#}
+
+
+.maxmemory <- function() {
+	default <- 10^9
+	d <- getOption('rasterMaxMemory')
 	if (is.null(d)) {
 		return( default )
-	} else {
-		return(isTRUE(d))
-	}
+	} 
+	d <- round(as.numeric(d[1]))
+	if (is.na(d) | d < 10000) {
+		d <- default
+	} 
+	return(d)
 }
 
 
-.maxmemory <- function() {
+.chunksize <- function(){
 	default <- 10^8
-	d <- getOption('rasterMaxMemory')
+	d <- getOption('rasterChunkSize')
 	if (is.null(d)) {
 		return( default )
 	} 
@@ -403,7 +402,8 @@ tmpDir <- function(create=TRUE) {
 		d <- default
 	} 
 	return(d)
-}
+}	
+
 
 
 .tolerance <- function() {

man/programming.Rd

@@ -27,7 +27,7 @@ pbCreate creates a progress bar, pbStep sets the progress, and pbClose closes it
 }
 
 \usage{
-canProcessInMemory(x, n=4)
+canProcessInMemory(x, n=4, verbose=FALSE)
 pbCreate(nsteps, progress, style=3, label='Progress', ...)
 pbStep(pb, step=NULL, label='')
 pbClose(pb, timer)
@@ -40,6 +40,7 @@ returnCluster()
 \arguments{
   \item{x}{RasterLayer or RasterBrick object (for connections) or RasterStack object (canProcessInMemory)}
   \item{n}{integer. The number of copies of the Raster* object cell values that a function needs to be able to have in memory}  
+  \item{verbose}{logical. If \code{TRUE} the amount of memory needed and available is printed}
   \item{nsteps}{integer. Number of steps the progress bar will make from start to end (e.g. nrow(raster)) }
   \item{progress}{character. 'text', 'window', or ''}
   \item{style}{style for text progress bar. See \code{\link[utils]{txtProgressBar}} }

man/rasterOptions.Rd

@@ -21,7 +21,7 @@ Function \code{tmpDir} returns the location of the temporary files
 \usage{
 rasterOptions(format, overwrite, datatype, tmpdir, tmptime, progress,
      timer, chunksize, maxmemory, todisk, setfileext, tolerance,
-     standardnames, depracatedwarnings, addheader, estimatemem, default=FALSE)
+     standardnames, depracatedwarnings, addheader, default=FALSE)
 
 
 tmpDir(create=TRUE)
@@ -37,7 +37,7 @@ tmpDir(create=TRUE)
 \item{progress}{character. Valid values are "text",  "window" and "" (the default in most functions, no progress bar)}
 \item{timer}{Logical. If \code{TRUE}, the time it took to complete the function is printed}
 \item{chunksize}{integer. Maximum number of bytes to read/write in a single chunk while processing (chunk by chunk) disk based Raster* objects}
-\item{maxmemory}{integer. Maximum bytes to read into memory. I.e., if a Raster* function is expected to require more than this value, \code{\link[raster]{canProcessInMemory}} will return \code{FALSE} }
+\item{maxmemory}{integer. Maximum number of bytes to read into memory. I.e., if a Raster* function is expected to require more than this value, \code{\link[raster]{canProcessInMemory}} will return \code{FALSE} }
 \item{todisk}{logical. For debugging only. Default is \code{FALSE} and should normally not be changed. If \code{TRUE}, results are always written to disk, even if no filename is supplied (a temporary filename is used)}
 \item{setfileext}{logical. Default is \code{TRUE}. If \code{TRUE}, the file extension will be changed when writing (if known for the file type). E.g. GTiff files will be saved with the .tif extension }
 \item{tolerance}{numeric. The tolerance used when comparing the origin and resolution of Raster* objects. Expressed as the fraction of a single cell. This should be a number between 0 and 0.5 }
@@ -46,7 +46,6 @@ tmpDir(create=TRUE)
 \item{addheader}{character. If not equal to \code{''} (the default) an additional header file is written when a raster format file (grd/gri) is written. Supported formats are as in \code{\link{hdr}}}
 \item{default}{logical. If \code{TRUE}, all options are set to their default values}
 \item{create}{logical. If \code{TRUE}, the temporary files directory is created if it does not exist}
-\item{estimatemem}{logical. If \code{TRUE}, the amount of RAM available is estimated, and the value of maxmemory is ignored}
 }
 
 \value{

src/RasterModule.cpp

@@ -5,9 +5,6 @@ using namespace Rcpp;
 
 RCPP_EXPOSED_CLASS(SpExtent)
 
-//RCPP_EXPOSED_CLASS(RasterSource)
-//RCPP_EXPOSED_CLASS(SpRaster)
-
 RCPP_EXPOSED_CLASS(SpPolyPart)
 RCPP_EXPOSED_CLASS(SpPoly)
 RCPP_EXPOSED_CLASS(SpPolygons)

src/RcppExports.cpp

@@ -46,6 +46,17 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// availableRAM
+double availableRAM(double defmem);
+RcppExport SEXP _raster_availableRAM(SEXP defmemSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< double >::type defmem(defmemSEXP);
+    rcpp_result_gen = Rcpp::wrap(availableRAM(defmem));
+    return rcpp_result_gen;
+END_RCPP
+}
 // getMode
 double getMode(NumericVector values, int ties);
 RcppExport SEXP _raster_getMode(SEXP valuesSEXP, SEXP tiesSEXP) {
@@ -301,6 +312,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_raster_doBilinear", (DL_FUNC) &_raster_doBilinear, 4},
     {"_raster_doCellFromRowCol", (DL_FUNC) &_raster_doCellFromRowCol, 4},
     {"_raster_getPolygons", (DL_FUNC) &_raster_getPolygons, 3},
+    {"_raster_availableRAM", (DL_FUNC) &_raster_availableRAM, 1},
     {"_raster_getMode", (DL_FUNC) &_raster_getMode, 2},
     {"_raster_doSpmin", (DL_FUNC) &_raster_doSpmin, 2},
     {"_raster_doSpmax", (DL_FUNC) &_raster_doSpmax, 2},

src/memory.cpp

@@ -0,0 +1,33 @@
+#ifdef _WIN32 
+#include <windows.h>
+#elif __linux__
+#include "sys/types.h"
+#include "sys/sysinfo.h"
+#include <unistd.h>
+#elif __APPLE__
+//#include mac hdr	
+#endif
+
+// [[Rcpp::export(name = ".availableRAM")]]
+double availableRAM(double defmem) {
+	// return available RAM
+	double ram;
+	#ifdef _WIN32
+		MEMORYSTATUSEX statex;
+		statex.dwLength = sizeof(statex);
+		GlobalMemoryStatusEx(&statex);
+		ram = statex.ullAvailPhys;
+	#elif __linux__
+		struct sysinfo memInfo;
+		sysinfo (&memInfo);
+		ram = memInfo.freeram;
+	#else
+		// mac
+	    // perhaps use this
+		// https://stackoverflow.com/questions/38490320/how-to-query-amount-of-allocated-memory-on-linux-and-osx
+		ram = defmem;		
+	#endif
+
+	return ram;
+}
+

src/memory.h

@@ -0,0 +1 @@
+double availableRAM();