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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Mar 4 05:46:29 CET 2009


Author: rhijmans
Date: 2009-03-04 05:46:29 +0100 (Wed, 04 Mar 2009)
New Revision: 307

Added:
   pkg/raster/R/drawBbox.R
   pkg/raster/R/lines.R
   pkg/raster/R/median.R
   pkg/raster/man/drawBbox.Rd
Modified:
   pkg/raster/NAMESPACE
   pkg/raster/R/click.R
   pkg/raster/R/coercion.R
   pkg/raster/R/dropLayer.R
   pkg/raster/R/mean.R
   pkg/raster/R/plot.R
   pkg/raster/R/setBbox.R
   pkg/raster/R/summary.R
   pkg/raster/man/Summary-methods.Rd
   pkg/raster/man/click.Rd
   pkg/raster/man/coerce.Rd
Log:


Modified: pkg/raster/NAMESPACE
===================================================================
--- pkg/raster/NAMESPACE	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/NAMESPACE	2009-03-04 04:46:29 UTC (rev 307)
@@ -1,8 +1,8 @@
 importFrom("methods", Ops, Math)
-importFrom("graphics", hist, plot)
+importFrom("graphics", hist, plot, lines)
 importFrom("stats", median, aggregate)
 importFrom("utils", stack)
 importFrom("sp", overlay, bbox, Spatial, SpatialPixels, SpatialPixelsDataFrame, SpatialGrid, SpatialGridDataFrame)
 exportClasses(BoundingBox, BasicRaster, Raster, RasterLayer, RasterStack)
-exportMethods(calc, overlay, bbox, aggregate, stack, show, summary, plot, hist, ncol, nrow, ncell, length, dim)
+exportMethods(calc, overlay, bbox, aggregate, stack, show, summary, plot, hist, ncol, nrow, ncell, length, dim, lines, median)
 exportPattern("^[^\\.]")
\ No newline at end of file

Modified: pkg/raster/R/click.R
===================================================================
--- pkg/raster/R/click.R	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/R/click.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -8,17 +8,7 @@
 
 
 
-clickBbox <- function(show=TRUE, col="red") {
-	loc <- locator(n=2, type="p")
-	bb <- newBbox(min(loc$x), max(loc$x), min(loc$y), max(loc$y))
-	if (show) {
-		p <- rbind(c(bb at xmin, bb at ymin), c(bb at xmin, bb at ymax), c(bb at xmax, bb at ymax), c(bb at xmax, bb at ymin), c(bb at xmin, bb at ymin) )
-		lines(p, col=col)
-	}
-	return(bb)
-}
 
-
 click <- function(object, n=1, xy=FALSE, type="n", ...) {
 	loc <- locator(n, type, ...)
 	xyCoords <- cbind(loc$x, loc$y)

Modified: pkg/raster/R/coercion.R
===================================================================
--- pkg/raster/R/coercion.R	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/R/coercion.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -103,24 +103,24 @@
 
 
 if (!isGeneric("asRasterLayer")) {
-	setGeneric("asRasterLayer", function(object, index)
+	setGeneric("asRasterLayer", function(x, index)
 		standardGeneric("asRasterLayer"))
 }	
 
 
-setMethod('asRasterLayer', signature(object='RasterStack'), 
-	function(object, index){
-		if (nlayers(object) > 0) {
-			dindex <- max(1, min(nlayers(object), index))
+setMethod('asRasterLayer', signature(x='RasterStack'), 
+	function(x, index){
+		if (nlayers(x) > 0) {
+			dindex <- max(1, min(nlayers(x), index))
 			if (dindex != index) { warning(paste("index was changed to", dindex))}
-			rs <- object at layers[[dindex]]
-			if (dataContent(object) == 'all') {
-				rs <- setValues(rs, values(object)[,dindex])
+			rs <- x at layers[[dindex]]
+			if (dataContent(x) == 'all') {
+				rs <- setValues(rs, values(x)[,dindex])
 			}
 		} else {
 			rs <- new("RasterLayer")
-			rs <- setBbox(rs, getBbox(object))
-			rs <- setRowCol(rs, nrow(object), ncol(object))
+			rs <- setBbox(rs, getBbox(x))
+			rs <- setRowCol(rs, nrow(x), ncol(x))
 		}
 		return(rs)
 	}
@@ -128,25 +128,25 @@
 
 
 
-setMethod('asRasterLayer', signature(object='SpatialPixelsDataFrame'), 
-	function(object, index){
+setMethod('asRasterLayer', signature(x='SpatialPixelsDataFrame'), 
+	function(x, index){
 		r <- raster()
-		r <- setBbox(r, getBbox(object))
-		r <- setProjection(r, object at proj4string)
-		r <- setRowCol(r, object at grid@cells.dim[2], object at grid@cells.dim[1])
-		dindex <- max(1, min(dim(object at data)[2], index))
+		r <- setBbox(r, getBbox(x))
+		r <- setProjection(r, x at proj4string)
+		r <- setRowCol(r, x at grid@cells.dim[2], x at grid@cells.dim[1])
+		dindex <- max(1, min(dim(x at data)[2], index))
 		if (dindex != index) { warning(paste("index was changed to", dindex))}
 # to become an option, but currently support for sparse is too .....  sparse	
 		sparse <- FALSE
 		if (!sparse) {
-				object <- as(object, 'SpatialGridDataFrame')
-				r <- setValues(r, object at data[[dindex]])
+				x <- as(x, 'SpatialGridDataFrame')
+				r <- setValues(r, x at data[[dindex]])
 		} else {
-				cells <- object at grid.index
+				cells <- x at grid.index
 				if (length(cells)==0) {
-					cells <- cellFromXY(r, object at coords)
+					cells <- cellFromXY(r, x at coords)
 				}
-				r <- setValuesSparse(r, cells, object at data[[dindex]])
+				r <- setValuesSparse(r, cells, x at data[[dindex]])
 		}
 		return(r)
 	}
@@ -154,15 +154,15 @@
 
 
 
-setMethod('asRasterLayer', signature(object='SpatialGridDataFrame'), 
-	function(object, index){
+setMethod('asRasterLayer', signature(x='SpatialGridDataFrame'), 
+	function(x, index){
 		r <- raster()
-		r <- setBbox(r, getBbox(object))
-		r <- setProjection(r, object at proj4string)
-		r <- setRowCol(r, object at grid@cells.dim[2], object at grid@cells.dim[1])
-		dindex <- max(1, min(dim(object at data)[2], index))
+		r <- setBbox(r, getBbox(x))
+		r <- setProjection(r, x at proj4string)
+		r <- setRowCol(r, x at grid@cells.dim[2], x at grid@cells.dim[1])
+		dindex <- max(1, min(dim(x at data)[2], index))
 		if (dindex != index) { warning(paste("index was changed to", dindex))}
-		r <- setValues(r, object at data[[dindex]])
+		r <- setValues(r, x at data[[dindex]])
 		return(r)
 	}	
 )

Added: pkg/raster/R/drawBbox.R
===================================================================
--- pkg/raster/R/drawBbox.R	                        (rev 0)
+++ pkg/raster/R/drawBbox.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -0,0 +1,19 @@
+# R function for the raster package
+# Author: Robert J. Hijmans
+# International Rice Research Institute. Philippines
+# contact: r.hijmans at gmail.com
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+
+drawBbox <- function(show=TRUE, col="red") {
+	loc <- locator(n=2, type="p")
+	bb <- newBbox(min(loc$x), max(loc$x), min(loc$y), max(loc$y))
+	if (show) {
+		p <- rbind(c(bb at xmin, bb at ymin), c(bb at xmin, bb at ymax), c(bb at xmax, bb at ymax), c(bb at xmax, bb at ymin), c(bb at xmin, bb at ymin) )
+		lines(p, col=col)
+	}
+	return(bb)
+}

Modified: pkg/raster/R/dropLayer.R
===================================================================
--- pkg/raster/R/dropLayer.R	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/R/dropLayer.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -4,8 +4,6 @@
 # Version 0.8
 # Licence GPL v3
 
-
-
 dropLayer <- function(rstack, indices) {
 	indices <- sort(indices, decreasing=TRUE)
 	for (i in 1:length(indices)) {

Added: pkg/raster/R/lines.R
===================================================================
--- pkg/raster/R/lines.R	                        (rev 0)
+++ pkg/raster/R/lines.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -0,0 +1,27 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date: March 2009
+# Version 0.8
+# Licence GPL v3
+
+
+if (!isGeneric("lines")) {
+	setGeneric("lines", function(x, ...)
+		standardGeneric("lines"))
+}
+
+#setMethod("lines", signature(x='ANY'), 
+#	function(x, ...) {
+#		graphics::lines(x, ...)
+#	}
+#)
+
+
+setMethod("lines", signature(x='BoundingBox'), 
+	function(x, ...)  {
+		xy <- .bboxmatrix(x)
+		xy[5,] <- xy[1,]
+		lines(xy, ...)
+	}
+)	
+

Modified: pkg/raster/R/mean.R
===================================================================
--- pkg/raster/R/mean.R	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/R/mean.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -11,31 +11,24 @@
 	function(x, ..., na.rm=FALSE){
 
 		rasters <- list(...)
-		if (length(rasters)==0) { return(x) }
 
+		if (class(x) == 'RasterLayer') {
+			if (length(rasters)==0) { 
+				return(x) 
+			}
+		}
+		rasters <- c(x, rasters)
+		rm(x)
+
 		for (i in 1:length(rasters)) {
 			if (class(rasters[[i]]) == 'RasterStack') {
 				r <- rasters[[i]]
-				rasters <- rasters[-i]
-				rasters <- c(rasters, unstack(r))
+				rasters <- c(rasters[-i], unstack(r))
 				rm(r)
 			}
 		}
-		rasters <- c(x, rasters)
-		rm(x)
 
 		return( .summaryRasters(rasters, mean, 'mean', na.rm=na.rm) )
 	}
 )
 
-
-setMethod("mean", signature(x='RasterStack'),
-	function(x, ..., na.rm=FALSE){
-
-		x1 <- asRasterLayer(x, 1)
-		x <- dropLayer(x, 1)
-		
-		return(  mean(x1, x, ..., na.rm=na.rm) )
-	}
-)
-

Added: pkg/raster/R/median.R
===================================================================
--- pkg/raster/R/median.R	                        (rev 0)
+++ pkg/raster/R/median.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -0,0 +1,46 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : March 2009
+# Version 0.8
+# Licence GPL v3
+
+
+setGeneric("median", function(x, ..., na.rm=FALSE)
+	standardGeneric("median"))
+
+
+setMethod('median', signature(x='ANY'), 
+	function(x, na.rm=FALSE){
+		return(stats::median(x, na.rm=na.rm))
+	}
+)
+
+
+setMethod("median", signature(x='Raster'),
+	function(x, ..., na.rm=FALSE){
+
+		rasters <- list(...)
+
+		if (class(x) == 'RasterLayer') {
+			if (length(rasters)==0) { 
+				return(x) 
+			}
+		}
+
+		rasters <- c(x, rasters)
+		rm(x)
+
+		for (i in 1:length(rasters)) {
+			if (class(rasters[[i]]) == 'RasterStack') {
+				r <- rasters[[i]]
+				rasters <- rasters[-i]
+				rasters <- c(rasters, unstack(r))
+				rm(r)
+			}
+		}
+
+		return( .summaryRasters(rasters, stats::median, 'median', na.rm=na.rm) )
+	}
+)
+
+

Modified: pkg/raster/R/plot.R
===================================================================
--- pkg/raster/R/plot.R	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/R/plot.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -1,9 +1,10 @@
 # Author: Robert J. Hijmans, r.hijmans at gmail.com
 # International Rice Research Institute
 # Date :  June 2008
-# Version 0,8
+# Version 0.8
 # Licence GPL v3
 
+
 .bboxmatrix <- function(x) {
 	xy <- matrix(NA, nrow=5, ncol=2)
 	xy[1,1] <- x at xmin
@@ -30,20 +31,6 @@
 )	
 
 
-if (!isGeneric("lines")) {
-	setGeneric("lines", function(x, ...)
-		standardGeneric("lines"))
-}
-
-setMethod("lines", signature(x='BoundingBox'), 
-	function(x, ...)  {
-		xy <- .bboxmatrix(x)
-		xy[5,] <- xy[1,]
-		lines(xy, ...)
-	}
-)	
-
-
 setMethod("plot", signature(x='Raster', y='missing'), 
 	function(x, y, ...)  {
 		map(x, ...)

Modified: pkg/raster/R/setBbox.R
===================================================================
--- pkg/raster/R/setBbox.R	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/R/setBbox.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -24,7 +24,7 @@
 		nc <- as.integer(round( (xmax(newobj) - xmin(newobj)) / xrs ))
 		if (nc < 1) { stop( "xmin and xmax are less than one cell apart" ) 
 		} else { newobj at ncols <- nc }
-		nr <- as.integer(round( (ymax(newobj) - ymin(newobj)) / xrs ) )
+		nr <- as.integer(round( (ymax(newobj) - ymin(newobj)) / yrs ) )
 		if (nr < 1) { stop( "ymin and ymax are less than one cell apart" )
 		} else { newobj at nrows <- nr }
 		newobj at bbox@xmax <- newobj at bbox@xmin + ncol(newobj) * xrs

Modified: pkg/raster/R/summary.R
===================================================================
--- pkg/raster/R/summary.R	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/R/summary.R	2009-03-04 04:46:29 UTC (rev 307)
@@ -51,12 +51,18 @@
 
 
 
-setMethod("Summary", signature(x='RasterLayer'),
+setMethod("Summary", signature(x='Raster'),
 	function(x, ..., na.rm=FALSE){
 
 		rasters <- list(...)
-		if (length(rasters)==0) { return(x) }
-
+		if (class(x) == 'RasterLayer') {
+			if (length(rasters)==0) { 
+				return(x) 
+			}
+		}
+		rasters <- c(x, rasters)
+		rm(x)
+		
 		for (i in 1:length(rasters)) {
 			if (class(rasters[[i]]) == 'RasterStack') {
 				r <- rasters[[i]]
@@ -65,8 +71,6 @@
 				rm(r)
 			}
 		}
-		rasters <- c(x, rasters)
-		rm(x)
 
 		fun <- sys.call(sys.parent())[[1]]
 		funname <- as.character(sys.call(sys.parent())[[1]])
@@ -74,18 +78,5 @@
 		return( .summaryRasters(rasters, fun, funname, na.rm) )
 	}
 )
-	
 
 
-setMethod("Summary", signature(x='RasterStack'),
-	function(x, ..., na.rm=FALSE){
-		
-		x1 <- asRasterLayer(x, 1)
-		x <- dropLayer(x, 1)
-		
-		return( callGeneric(x1, x, ..., na.rm=na.rm))
-	}
-)
-
-
-

Modified: pkg/raster/man/Summary-methods.Rd
===================================================================
--- pkg/raster/man/Summary-methods.Rd	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/man/Summary-methods.Rd	2009-03-04 04:46:29 UTC (rev 307)
@@ -1,25 +1,30 @@
 \name{Summary}
 \docType{methods}
-\alias{Summary-methods}
-\alias{Summary,RasterLayer-method}
-\alias{Summary,RasterStack-method}
+
+\alias{Summary,Raster-method}
 \alias{mean,Raster-method}
-\alias{mean,RasterStack-method}
+\alias{median}
+\alias{median,ANY-method}
+\alias{median,Raster-method}
 
 \title{ Summary methods }
 
 \description{
  The following summary methods are available for Raster* objects:
- \code{mean, max, min, range, prod, sum, any, all}
+ 
+ \code{mean, median, max, min, range, prod, sum, any, all}
 }
 
-
-
 \note{
  These methods compare layers and the result of these methods is always a single RasterLayer. 
- The generic functin \code{range} returns 2 values (the minimum and maximum value of a vector). The Raster* implementations returns a single values (the range)
  
- For the extreme values within in a layer use maxValue() and minValue()
+ You can mix RasterLayer, RasterStack objects and single numeric or logical values. 
+ However, because generic functions are used, the appropriate method is chosen based on the first argument: '\code{x}'. 
+ This means that if \code{r} is a RasterLayer object, \code{mean(r, 5)} will work, but \code{mean(5, r)} will not work.
+ 
+ The generic function \code{range} returns 2 values (the minimum and maximum value of a vector). The Raster* implementations returns a single values (the range)
+ 
+ For the extreme values within in a layer use \code{maxValue} and \code{minValue}
 }
 
 \value{a RasterLayer}
@@ -40,3 +45,4 @@
 
 \keyword{methods}
 \keyword{spatial}
+

Modified: pkg/raster/man/click.Rd
===================================================================
--- pkg/raster/man/click.Rd	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/man/click.Rd	2009-03-04 04:46:29 UTC (rev 307)
@@ -1,29 +1,30 @@
 \name{click}
 \alias{click}
-\alias{clickBbox}
 
-\title{ Click on map }
+\title{ Click }
 \description{
-  Click on a map to get values, coordinates or a bounding box
+  Click on a plot (map) to get values of a Raster* object at a location; and optionally the coordinates for the location. 
+  Multiple locations can be clicked on by specifying \code{n=}. 
 }
 \usage{
 click(object, n=1, xy=FALSE, type = "n", ...)
-clickBbox(show = TRUE, col = "red") 
 }
 
+\note{
+  The plot only provides the coordinates (xy pair), the values are read from the Raster* object that is passed as an argument.
+  Thus you can extract values for a Raster* object that is not plotted, as long as it shares the coordinate system (CRS) with the layer that is plotted.
+}
+
 \arguments{
   \item{object}{RasterLayer or RasterStack object}
   \item{n}{number of clicks on the map}
   \item{xy}{show xy coordinates}
   \item{type}{One of "n", "p", "l" or "o". If "p" or "o" the points are plotted; if "l" or "o" they are joined by lines. See ?locator}
   \item{...}{additional graphics parameters used if type != "n" for plotting the locations. See ?locator}   
-  \item{show}{logical. If \code{TRUE}, the bounding box will be drawn on the map}  
-  \item{col}{the color of the bounding box lines}    
  }
  
 \value{
-click: the value of \code{object} at the point clicked on; and the coordinates if \code{xy==TRUE}.
-clickBbox: a BoundingBox object
+The value(s) of \code{object} at the point(s) clicked on; and the coordinates if \code{xy==TRUE}.
 } 
 
 \author{ Robert J. Hijmans }

Modified: pkg/raster/man/coerce.Rd
===================================================================
--- pkg/raster/man/coerce.Rd	2009-03-04 03:32:46 UTC (rev 306)
+++ pkg/raster/man/coerce.Rd	2009-03-04 04:46:29 UTC (rev 307)
@@ -1,24 +1,26 @@
 \name{Coercion}
+
 \alias{asRasterLayer,RasterStack-method}
 \alias{asRasterLayer,SpatialPixelsDataFrame-method}
 \alias{asRasterLayer,SpatialGridDataFrame-method}
 \alias{asRasterLayer}
 
-\title{ Coercion of SpatialGridDataFrame and SpatialPixelsDataFrame objects to a RasterLayer. }
+\title{ Coercion to RasterLayer }
 
 \description{  
 Functions to coerce a SpatialGridDataFrame, SpatialPixelsDataFrame, and RasterStack objects to a RasterLayer object. 
-You can use as( , ) for these coercions (see examples), and for many other coercions between sp and raster objects, but asRasterLayer allows for indicating which variable should be passed to the RasterLayer object.
+You can use \code{as( , )} for this type of coercion (see examples), and for many other coercions between sp and raster objects, 
+but asRasterLayer allows for indicating which variable should be passed to the RasterLayer object.
 RasterLayer objects only have a single variable, whereas a RasterStack and the Spatial* objects can have multiple variables.
 }
 
 \usage{
-asRasterLayer(object, index) 
+asRasterLayer(x, index) 
 }
 
 \arguments{
-  \item{object}{ a Raster* type object (SpatialPixel, SpatialPixelDataFrame , SpatialGrid, or SpatialGridDataFrame }
-  \item{index}{integer (between 1 and nlayers(object) indicating the layer in the RasterStack, or the column in the sp object dataframe to take the values from}
+  \item{x}{ a Raster* type object (SpatialPixel, SpatialPixelDataFrame , SpatialGrid, or SpatialGridDataFrame }
+  \item{index}{integer (between 1 and \code{nlayers(x)} indicating the layer in the RasterStack, or the column in the sp object dataframe to take the values from}
 }
 
 \details{

Added: pkg/raster/man/drawBbox.Rd
===================================================================
--- pkg/raster/man/drawBbox.Rd	                        (rev 0)
+++ pkg/raster/man/drawBbox.Rd	2009-03-04 04:46:29 UTC (rev 307)
@@ -0,0 +1,36 @@
+\name{drawBbox}
+\alias{drawBbox}
+
+\title{ Draw Bounding Box }
+\description{
+  Click on two points of a plot (map) to obtain a BoundingBox object  
+}
+\usage{
+drawBbox(show = TRUE, col = "red") 
+}
+
+\arguments{
+  \item{show}{logical. If \code{TRUE}, the bounding box will be drawn on the map}  
+  \item{col}{the color of the bounding box lines}    
+ }
+ 
+\value{
+ a BoundingBox object
+} 
+
+\author{ Robert J. Hijmans }
+
+\examples{
+
+r1 <- raster(nrow=10, ncol=10)
+r1[] <- runif(ncell(r1))
+#plot(r1)
+#bb <- drawBbox()
+#mean(values(crop(r1, drawBbox())))
+
+
+
+}
+
+
+\keyword{ spatial }



More information about the Raster-commits mailing list