[Raster-commits] r427 - in pkg/raster: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Apr 23 14:07:30 CEST 2009


Author: rhijmans
Date: 2009-04-23 14:07:30 +0200 (Thu, 23 Apr 2009)
New Revision: 427

Removed:
   pkg/raster/R/cellStats2.R
Modified:
   pkg/raster/DESCRIPTION
   pkg/raster/R/cellStats.R
   pkg/raster/man/cellStats.Rd
Log:


Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION	2009-04-23 09:15:18 UTC (rev 426)
+++ pkg/raster/DESCRIPTION	2009-04-23 12:07:30 UTC (rev 427)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Raster data handling for geographic data analysis and modeling
 Version: 0.8.9-14
-Date: 22-April-2009
+Date: 23-April-2009
 Depends: methods, sp, rgdal (>= 0.5-33), R (>= 2.8.0)
 Author: Robert J. Hijmans & Jacob van Etten
 Maintainer: Robert J. Hijmans <r.hijmans at gmail.com> 

Modified: pkg/raster/R/cellStats.R
===================================================================
--- pkg/raster/R/cellStats.R	2009-04-23 09:15:18 UTC (rev 426)
+++ pkg/raster/R/cellStats.R	2009-04-23 12:07:30 UTC (rev 427)
@@ -1,34 +1,65 @@
 # Author: Robert J. Hijmans, r.hijmans at gmail.com
 # International Rice Research Institute
-# Date : June 2008
+# Date : March 2009
 # Version 0.8
 # Licence GPL v3
 
-.Old.cellStats <- function(x, ..., na.rm=TRUE) {
-	funs <- list(...)
-	if (length(funs) == 0) {
-		stop('you must provide a function as argument')
-	}
-	res <- list()
-	if (dataContent(x) != 'all') {
-		if (dataSource(x) == 'ram') {
-			stop('no values associated with this RasterLayer')
+cellStats <- function(raster, stat='mean', track=-1) {
+
+	if (class(stat) != 'character') {
+		if (dataContent(raster) == 'all') { n <- 1 } else {n <- 2}
+		if (canProcessInMemory(raster, n)) {
+			if (dataContent(raster) != 'all') {
+				raster <- readAll(raster)
+			}
+			d <- na.omit(values(raster))
+			return( stat(d) )
+		} else {
+			stop("RasterLayer is too large. You can use fun='sum', 'mean', 'min', or 'max', but not a function")
 		}
-		if (canProcessInMemory(x, 2)) {
-			x <- readAll(x)
+	} else {
+
+		counts <- FALSE
+		if (stat == 'sum') {
+			fun <- sum
+		} else if (stat == 'min') {
+			fun <- min
+		} else if (stat == 'max') {
+			fun <- max
+		} else if (stat == 'mean' | stat == 'sd') {
+			# do nothing
+		} else { 
+			stop("invalid 'stat', should be 'sum', 'min', 'max', 'sd' or 'mean'") 
 		}
-	}
-	if (dataContent(x) == 'all') {
-		for(i in seq(along=funs)) {
-			if (na.rm) {
-				res[i] <- funs[[i]](na.omit(x at data@values))
+
+		cnt <- 0
+		sumsq <- 0
+		st  <- NULL
+		starttime <- proc.time()
+		for (r in 1:nrow(raster)) {
+			d <- na.omit(valuesRow(raster, r))
+			if (length(d) == 0) { next }
+			if (stat == 'sd') {
+				st <- sum(d, st)
+				cnt <- cnt + length(d)
+				sumsq <- sum(d^2, sumsq)
+			} else if (stat=='mean') {
+				st <- sum(d, st)
+				cnt <- cnt + length(d)
 			} else {
-				res[i] <- funs[[i]](x at data@values)
+				st <- fun(c(d, st))
 			}
+			if (r %in% track) { 
+				.showTrack(r, raster at nrows, track, starttime) 
+			}
 		}
-	} else {
-		stop('sorry, only implemented for rasters that can be loaded into memory')
+		if (stat == 'sd') {
+			meansq <- (st/cnt)^2
+			st <- sqrt( (1 / cnt) * sumsq - meansq )
+		} else if (stat == 'mean') {
+			st <- st / cnt
+		}
+		return(st)
 	}
-	return(unlist(res))
 }
-	
+

Deleted: pkg/raster/R/cellStats2.R
===================================================================
--- pkg/raster/R/cellStats2.R	2009-04-23 09:15:18 UTC (rev 426)
+++ pkg/raster/R/cellStats2.R	2009-04-23 12:07:30 UTC (rev 427)
@@ -1,52 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : March 2009
-# Version 0.8
-# Licence GPL v3
-
-cellStats <- function(raster, stat='mean', track=-1) {
-
-	if (class(stat) != 'character') {
-		if (canProcessInMemory(raster, 2)) {
-			if (dataContent(raster) != 'all') {
-				raster <- readAll(raster)
-			}
-			d <- na.omit(values(raster))
-			return( stat(d) )
-		} else {
-			stop("RasterLayer is too large. You can use fun='sum', 'mean', 'min', or 'max', but not a function")
-		}
-	} else {
-
-		counts <- FALSE
-		if (stat == 'sum') {
-			fun <- sum
-		} else if (stat == 'min') {
-			fun <- min
-		} else if (stat == 'max') {
-			fun <- max
-		} else if (stat == 'mean') {
-			fun <- sum
-			counts <- TRUE
-		} else { 
-			stop("invalid 'stat', should be 'sum', 'min', 'max', or 'mean'") 
-		}
-
-		cnt <- vector(length=0)
-		st  <- vector(length=0)
-		starttime <- proc.time()
-		for (r in 1:nrow(raster)) {
-			d <- na.omit(valuesRow(raster, r))
-			st <- fun(d, st)
-			if (counts) {
-				cnt <- cnt + length(d)
-			}
-			if (r %in% track) { .showTrack(r, raster at nrows, track, starttime) }
-		}
-		if (counts) {
-			st <- st / cnt
-		}
-		return(st)
-	}
-}
-

Modified: pkg/raster/man/cellStats.Rd
===================================================================
--- pkg/raster/man/cellStats.Rd	2009-04-23 09:15:18 UTC (rev 426)
+++ pkg/raster/man/cellStats.Rd	2009-04-23 12:07:30 UTC (rev 427)
@@ -16,7 +16,7 @@
 
 \arguments{
   \item{raster}{A RasterLayer}
-  \item{stat}{The function to be applied. Either as character: 'mean', 'min', 'max', 'sum'; or a function (see Details) }
+  \item{stat}{The function to be applied. Either as character: 'mean', 'min', 'max', 'sum', or 'sd'; or a function (see Details) }
   \item{track}{vector of row numbers for which the function will report that they have been processed}   
 }
 
@@ -25,7 +25,10 @@
 }
 
 \details{
-If \code{stat} is a \code{function}, \code{zonal} will fail (gracefully) for very large RasterLayers
+If \code{stat} is a \code{function} rather than a character string, \code{zonal} will fail (gracefully) for very large RasterLayers.
+
+\code{stat='sd'} returns slightly different values than \code{stat=sd}, because the former computes the standard deviation of the population
+using this \code{sqrt((1/N) * sum(x^2) - mean(x)^2)} formula
 }
 
 \seealso{ \code{\link[raster]{setMinMax} } }



More information about the Raster-commits mailing list