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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jan 12 15:51:26 CET 2009


Author: rhijmans
Date: 2009-01-12 15:51:25 +0100 (Mon, 12 Jan 2009)
New Revision: 123

Added:
   pkg/raster/R/generic.read.R
   pkg/raster/R/plot.R
   pkg/raster/R/show.R
Removed:
   pkg/raster/R/raster.generic.functions.R
Modified:
   pkg/raster/DESCRIPTION
   pkg/raster/NAMESPACE
   pkg/raster/R/all.classes.R
   pkg/raster/R/bounding.box.R
   pkg/raster/R/conversion.R
   pkg/raster/R/group.generic.functions.R
   pkg/raster/R/standard.generic.functions.R
   pkg/raster/man/Compare-methods.Rd
   pkg/raster/man/Logic-methods.Rd
   pkg/raster/man/bbox.Rd
   pkg/raster/man/classes.Rd
   pkg/raster/man/export.Rd
   pkg/raster/man/properties.Rd
Log:
improved generic functions

Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/DESCRIPTION	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,7 +1,7 @@
 Package: raster
 Type: Package
 Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.4
+Version: 0.8.5
 Date: 12-Jan-2009
 Depends: methods, sp, rgdal (>= 0.5-33), R (>= 2.8.0)
 Author: Robert J. Hijmans & Jacob van Etten

Modified: pkg/raster/NAMESPACE
===================================================================
--- pkg/raster/NAMESPACE	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/NAMESPACE	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,5 +1,6 @@
 importFrom("methods", Arith, Compare, Logic, Math)
 importFrom("graphics", hist, plot)
-exportClasses(Raster, RasterLayer, RasterBrick, RasterStack)
-exportMethods(show, summary, plot, hist, ncol, nrow)
+importFrom("sp", Spatial, SpatialPixels, SpatialPixelsDataFrame, SpatialGrid, SpatialGridDataFrame)
+exportClasses(BoundingBox, BasicRaster, Raster, RasterLayer, RasterBrick, RasterStack)
+exportMethods(show, summary, plot, hist, ncol, nrow, dim)
 exportPattern("^[^\\.]")
\ No newline at end of file

Modified: pkg/raster/R/all.classes.R
===================================================================
--- pkg/raster/R/all.classes.R	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/R/all.classes.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -29,8 +29,7 @@
 )
 
 
-setClass ('Raster',
-	contains = 'VIRTUAL',
+setClass ('BasicRaster',
 	representation (
 		bbox = 'BoundingBox',
 		ncols ='integer',
@@ -50,6 +49,7 @@
 	}
 )
 
+setClass ('Raster', contains = c('BasicRaster', 'VIRTUAL') )
 
 	
 setClass('RasterFile', 
@@ -193,3 +193,8 @@
 	}
 )
 
+
+
+setClassUnion("RasterStackBrick", c("RasterStack", "RasterBrick"))
+
+#setClassUnion("SpatialPixelsGrid", c("SpatialPixels", "SpatialGrid"))

Modified: pkg/raster/R/bounding.box.R
===================================================================
--- pkg/raster/R/bounding.box.R	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/R/bounding.box.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,11 +1,14 @@
+# 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
 
-changeBbox <- function(object, xmn=xmin(object), xmx=xmax(object), ymn=ymin(object), ymx = ymax(object), keepres=FALSE) {
-	bb <- newBbox(xmn, xmx, ymn, ymx) 
-	object <- setBbox(object, bb, keepres=keepres) 
-	return(object)
-}
 
 
+
 newBbox <- function(xmn, xmx, ymn, ymx) {
 	bb <- new('BoundingBox')
 	bb at xmin <- xmn
@@ -15,33 +18,58 @@
 	return(bb)
 }
 
-getBbox <- function(object) {
-	if ( class(object) == 'BoundingBox' ) { 
-		bb <- object 
-	} else if ( class(object) == 'RasterLayer' | class(object) == 'RasterStack' | class(object) == 'RasterBrick' ) {
-		bb <- object at bbox
-	} else if (class(object) == "matrix") {
+
+if (!isGeneric("getBbox")) {
+	setGeneric("getBbox", function(object)
+		standardGeneric("getBbox"))
+}	
+
+setMethod('getBbox', signature(object='BoundingBox'), 
+	function(object){ return(object) }
+)
+
+setMethod('getBbox', signature(object='BasicRaster'), 
+	function(object){ return(object at bbox) }
+)
+
+setMethod('getBbox', signature(object='Spatial'), 
+	function(object){ 
+		bndbox <- bbox(object)
 		bb <- new('BoundingBox')
+		bb at xmin <- bndbox[1,1]
+		bb at xmax <- bndbox[1,2]
+		bb at ymin <- bndbox[2,1]
+		bb at ymax <- bndbox[2,2]
+		return(bb) 
+	}
+)
+
+setMethod('getBbox', signature(object='matrix'), 
+	function(object){ 
+		bb <- new('BoundingBox')
 		bb at xmin <- object[1,1]
 		bb at xmax <- object[1,2]
 		bb at ymin <- object[2,1]
 		bb at ymax <- object[2,2]
-	} else if (class(object) == "vector") {
+	}
+)
+	
+setMethod('getBbox', signature(object='vector'), 
+	function(object){ 
+		if (length(object) < 4) {
+			stop('vector supplied is too short')
+		}
+		if (length(object) > 4) {
+			warning('vector supplied is longer then expected (should be 4)')
+		}
 		bb <- new('BoundingBox')
 		bb at xmin <- object[1]
 		bb at xmax <- object[2]
 		bb at ymin <- object[3]
 		bb at ymax <- object[4]
-	} else {
-		bndbox <- bbox(object)
-		bb <- new('BoundingBox')
-		bb at xmin <- bndbox[1,1]
-		bb at xmax <- bndbox[1,2]
-		bb at ymin <- bndbox[2,1]
-		bb at ymax <- bndbox[2,2]
-	}
-	return(bb)
-}
+		return(bb)
+	}	
+)
 
 
 setBbox <- function(object, bndbox, keepres=FALSE) {
@@ -62,3 +90,10 @@
 }
 
 
+
+changeBbox <- function(object, xmn=xmin(object), xmx=xmax(object), ymn=ymin(object), ymx = ymax(object), keepres=FALSE) {
+	bb <- newBbox(xmn, xmx, ymn, ymx) 
+	object <- setBbox(object, bb, keepres=keepres) 
+	return(object)
+}
+

Modified: pkg/raster/R/conversion.R
===================================================================
--- pkg/raster/R/conversion.R	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/R/conversion.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -20,51 +20,84 @@
 )
 
 
-asRasterLayer <- function(object, dataindex=1) {
-	if (class(object) == 'RasterLayer') {
+
+
+if (!isGeneric("asRasterLayer")) {
+	setGeneric("asRasterLayer", function(object,index)
+		standardGeneric("asRasterLayer"))
+}	
+setMethod('asRasterLayer', signature(object='Raster',index='missing'), 
+	function(object){
+		return(asRasterLayer(object, 1))
+	}
+)
+setMethod('asRasterLayer', signature(object='SpatialPixels',index='missing'), 
+	function(object){
+		return(asRasterLayer(object, 1))
+	}
+)
+
+
+setMethod('asRasterLayer', signature(object='RasterLayer', index='numeric'), 
+	function(object, index){
 		return(object)
-	} else if (class(object) == 'RasterBrick' | class(object) == 'RasterStack') {
+	}
+)
+
+setMethod('asRasterLayer', signature(object='RasterStackBrick', index='numeric'), 
+	function(object, index){
 		rs <- newRaster(xmn = xmin(object), xmx = xmax(object), ymn = ymin(object), ymx = ymax(object), nrows=nrow(object), ncols=ncol(object), projstring=projection(object))
 		if (dataContent(object) == 'all') {
-			dindex <- max(1, min(nlayers(object), dataindex))
-			if (dindex != dataindex) { warning(paste("dataindex was changed to", dindex))}
+			dindex <- max(1, min(nlayers(object), index))
+			if (dindex != index) { warning(paste("index was changed to", dindex))}
 			rs <- setValues(rs, as.matrix(values(object))[,dindex])
 		}
 		return(rs)
-	} else { # assuming an SP raster
+	}
+)
+
+
+
+setMethod('asRasterLayer', signature(object='SpatialPixels', index='numeric'), 
+	function(object, index){
 		raster <- newRaster()
-		raster at bbox <- getBbox(object)
-		raster at crs <- object at proj4string
-		raster at ncols <- object at grid@cells.dim[1]
-		raster at nrows <- object at grid@cells.dim[2]
-		if (class(object)=='SpatialPixels') {
-			# do noting, there is no data
-			# we could store the indices, but then we would have a sparse raster with no data (or with NAs). That goes against our definition of sparse (all NAs have been removed)
-		} else if (class(object)=='SpatialPixelsDataFrame') {
-			cells <- object at grid.index
-			if (length(cells)==0) {
-				cells <- cellFromXY(raster, object at coords)
-			}
-#			if (dindex != dataindex) { warning(paste("dataindex was changed to", dindex))}
-			vals <- object at data[[dataindex]]
-			raster <- setValuesSparse(raster, cells, vals)
-		} else if ( class(object)=='SpatialGrid' ) {
-			# do nothing, there is no data
-		} else if (class(object)=='SpatialGridDataFrame' ) {
-#			if (dindex != dataindex) { warning(paste("dataindex was changed to", dindex))}
-			raster <- setValues(raster, object at data[[dataindex]])
+		raster <- setBbox(raster, getBbox(object))
+		raster <- setProjection(raster, object at proj4string)
+		raster <- setRowCol(raster, object at grid@cells.dim[2], object at grid@cells.dim[1])
+		return(raster)
+	}
+)
+
+setMethod('asRasterLayer', signature(object='SpatialPixelsDataFrame', index='numeric'), 
+	function(object, index){
+		raster <- asRasterLayer(as(object, "SpatialPixels"))
+		cells <- object at grid.index
+		if (length(cells)==0) {
+			cells <- cellFromXY(raster, object at coords)
 		}
+		dindex <- max(1, min(dim(object at data)[2], index))
+		if (dindex != index) { warning(paste("index was changed to", dindex))}
+		raster <- setValuesSparse(raster, cells, object at data[[dindex]])
+	}
+)	
+
+setMethod('asRasterLayer', signature(object='SpatialGridDataFrame', index='numeric'), 
+	function(object, index){
+		raster <- asRasterLayer(as(object, "SpatialPixels"))
+		dindex <- max(1, min(dim(object at data)[2], index))
+		if (dindex != index) { warning(paste("index was changed to", dindex))}
+		raster <- setValues(raster, object at data[[dindex]])
 		return(raster)
 	}	
-}
+)
 
 
 asRasterBrick <- function(spgrid) {
 	brick <- newBrick()
-	brick at bbox <- spgrid at bbox
-	brick at crs <- spgrid at proj4string
-	brick at ncols <- spgrid at grid@cells.dim[1]
-	brick at nrows <- spgrid at grid@cells.dim[2]
+	brick <- setBbox(brick, getBbox(spgrid))
+	brick <- setProjection(brick, spgrid at proj4string)
+	brick <- setRowCol(brick, spgrid at grid@cells.dim[2], spgrid at grid@cells.dim[1])
+
 	if (class(spgrid)=='SpatialPixels') {
 		# do noting, there is no data
 		# we could store the indices, but then we would have a sparse raster with no data (or with NAs). That goes against our definition of sparse (all NAs have been removed)

Added: pkg/raster/R/generic.read.R
===================================================================
--- pkg/raster/R/generic.read.R	                        (rev 0)
+++ pkg/raster/R/generic.read.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -0,0 +1,104 @@
+# R function for the raster package
+# Author: Robert J. Hijmans
+# International Rice Research Institute. Philippines
+# contact: r.hijmans at gmail.com
+# Date : November 2008
+# Version 0.8
+# Licence GPL v3
+
+
+if (!isGeneric("readAll")) {
+	setGeneric("readAll", function(object)
+		standardGeneric("readAll"))
+}	
+setMethod('readAll', signature(object='RasterLayer'), 
+	function(object){ return(.rasterRead(object, -1))}
+)
+setMethod('readAll', signature(object='RasterStack'), 
+	function(object){ return(.stackRead(object, -1))}
+)
+
+
+if (!isGeneric("readRow")) {
+	setGeneric("readRow", function(object, rownr)
+		standardGeneric("readRow"))
+}
+setMethod('readRow', signature(object='RasterLayer'), 
+	function(object, rownr){ return(.rasterRead(object, rownr))}
+)
+setMethod('readRow', signature(object='RasterStack'), 
+	function(object, rownr){ return(.stackRead(object, rownr))}
+)
+
+	
+if (!isGeneric("readRows")) {
+	setGeneric("readRows", function(object, startrow, nrows=3)
+		standardGeneric("readRows"))
+}	
+
+setMethod('readRows', signature(object='RasterLayer'), 
+	function(object, startrow, nrows=3) { 
+		#read multiple rows
+		return(.rasterReadBlock(object, startrow, nrows))
+	}	
+)
+
+		
+
+if (!isGeneric("readBlock")) {
+	setGeneric("readBlock", function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1))
+		standardGeneric("readBlock"))
+}	
+
+setMethod('readBlock', signature(object='RasterLayer'), 
+	function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1)) { 
+		return(.rasterReadBlock(object, startrow, nrows, ncolumns))}
+)
+
+if (!isGeneric("readPartOfRow")) {
+	setGeneric("readPartOfRow", function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1))
+		standardGeneric("readPartOfRow"))
+}	
+
+setMethod('readPartOfRow', signature(object='RasterLayer'), 
+	function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) { 
+		return(.rasterRead(object, rownr, startcol, ncolumns))}
+)
+
+setMethod('readPartOfRow', signature(object='RasterStack'), 
+	function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) { 
+		return( .stackRead(object, rownr, startcol, ncolumns) ) }
+)
+
+if (!isGeneric("cellValues")) {
+	setGeneric("cellValues", function(object, cells)
+		standardGeneric("cellValues"))
+}	
+	
+setMethod("cellValues", signature(object='RasterLayer'), 
+	function(object, cells) { 
+		return(.rasterReadCells(object, cells))}
+)
+
+
+setMethod("cellValues", signature(object='RasterStack'), 
+	function(object, cells) { 
+		return(.stackReadCells(object, cells))}
+)
+
+if (!isGeneric("xyValues")) {
+	setGeneric("xyValues", function(object, xy)
+		standardGeneric("xyValues"))
+}	
+	
+setMethod("xyValues", signature(object='RasterLayer'), 
+	function(object, xy) { 
+		return(.rasterReadXY(object, xy))
+	}
+)
+
+setMethod("xyValues", signature(object='RasterStack'), 
+	function(object, xy) { 
+		return(.stackReadXY(object, xy))}
+)
+

Modified: pkg/raster/R/group.generic.functions.R
===================================================================
--- pkg/raster/R/group.generic.functions.R	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/R/group.generic.functions.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -5,14 +5,15 @@
 # Licence GPL v3
 
 
-setMethod('==', signature(e1='Raster', e2='Raster'),
+setMethod('==', signature(e1='BasicRaster', e2='BasicRaster'),
 	function(e1,e2){
 		cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.0001, stopiffalse=FALSE) 
 		return(cond)
 	}
 )	
 
-setMethod('!=', signature(e1='Raster', e2='Raster'),
+
+setMethod('!=', signature(e1='BasicRaster', e2='BasicRaster'),
 	function(e1,e2){
 		cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.0001, stopiffalse=FALSE) 
 		return(!cond)
@@ -20,6 +21,19 @@
 )	
 
 
+setMethod("Compare", signature(e1='RasterLayer', e2='RasterLayer'),
+	function(e1,e2){
+		cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.0001, stopiffalse=FALSE) 
+		if (!cond) {
+			stop("Cannot compare RasterLayers that have different BasicRaster attributes. See 'as(e1, 'BasicRaster')==as(e2, 'BasicRaster')")
+		}	
+		return(setRaster(e1, values=callGeneric(.getRasterValues(e1), .getRasterValues(e2) ) ) )
+	}
+)	
+
+
+
+
 .getRasterValues <- function(x) {
 # need to take care of 'spase'
 	if (dataContent(x) != 'all') {
@@ -78,6 +92,8 @@
 		}
 	}
 )
+
+
 	
 setMethod("Arith", signature(e1='RasterLayer', e2='RasterLayer'),
     function(e1, e2){ 

Added: pkg/raster/R/plot.R
===================================================================
--- pkg/raster/R/plot.R	                        (rev 0)
+++ pkg/raster/R/plot.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -0,0 +1,61 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date :  June 2008
+# Version 0,8
+# Licence GPL v3
+
+
+setMethod("plot", signature(x='Raster', y='missing'), 
+	function(x, y, ...)  {
+		map(x, ...)
+	}
+)	
+
+setMethod("plot", signature(x='Raster', y='numeric'), 
+	function(x, y, ...)  {
+		map(x, y, ...)
+	}
+)		
+
+
+setMethod("plot", signature(x='RasterLayer', y='RasterLayer'), 
+	function(x, y, maxdim=1000, cex=0.1, ...)  {
+		comp <- compare(c(x, y), bb=TRUE, rowcol=TRUE, prj=FALSE, tolerance=0.0001, stopiffalse=TRUE) 
+		nc <- ncells(x)
+		x <- readSkip(x, maxdim=maxdim)
+		y <- readSkip(y, maxdim=maxdim)
+		if (length(x) < nc) {
+			warning(paste('plot used a sample of ', round(100*length(x)/nc), "% of the cells", sep=""))
+		}
+		cex <- .getcex(...)
+		plot(x, y, cex, ...)			
+	}
+)
+	
+
+setMethod('hist', signature(x='Raster'), 
+	function(x, layer=1, maxsamp=10000, ...){
+		if (dataContent(x) != 'all') {
+			if (dataSource(x) == 'disk') {
+		# TO DO: make a function that does this by block and combines  all data into a single histogram
+
+				x <- asRasterLayer(x, layer)
+				if (ncells(x) <= maxsamp) {
+					values <- na.omit(values(readAll(x)))
+				} else {
+					values <- readRandom(x, maxsamp)
+					msg <- paste(round(100 * maxsamp / ncells(x)), "% of the raster cells were used", sep="")
+					if (maxsamp > length(values)) {
+						msg <- paste(msg, " (of which ", 100 - round(100 * length(values) / maxsamp ), "% were NA)", sep="")
+					}
+					msg <- paste(msg, ". ",length(values)," values used.", sep="")
+					warning(msg)
+				}	
+			} else { stop('cannot make a histogram; need data on disk or in memory')}
+		} else {
+			values <- values(x)
+		}			
+		hist(values, ...)
+	}	
+)
+

Deleted: pkg/raster/R/raster.generic.functions.R
===================================================================
--- pkg/raster/R/raster.generic.functions.R	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/R/raster.generic.functions.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,96 +0,0 @@
-
-if (!isGeneric("readAll")) {
-	setGeneric("readAll", function(object)
-		standardGeneric("readAll"))
-}	
-setMethod('readAll', signature(object='RasterLayer'), 
-	function(object){ return(.rasterRead(object, -1))}
-)
-setMethod('readAll', signature(object='RasterStack'), 
-	function(object){ return(.stackRead(object, -1))}
-)
-
-
-if (!isGeneric("readRow")) {
-	setGeneric("readRow", function(object, rownr)
-		standardGeneric("readRow"))
-}
-setMethod('readRow', signature(object='RasterLayer'), 
-	function(object, rownr){ return(.rasterRead(object, rownr))}
-)
-setMethod('readRow', signature(object='RasterStack'), 
-	function(object, rownr){ return(.stackRead(object, rownr))}
-)
-
-	
-if (!isGeneric("readRows")) {
-	setGeneric("readRows", function(object, startrow, nrows=3)
-		standardGeneric("readRows"))
-}	
-
-setMethod('readRows', signature(object='RasterLayer'), 
-	function(object, startrow, nrows=3) { 
-		#read multiple rows
-		return(.rasterReadBlock(object, startrow, nrows))
-	}	
-)
-
-		
-
-if (!isGeneric("readBlock")) {
-	setGeneric("readBlock", function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1))
-		standardGeneric("readBlock"))
-}	
-
-setMethod('readBlock', signature(object='RasterLayer'), 
-	function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1)) { 
-		return(.rasterReadBlock(object, startrow, nrows, ncolumns))}
-)
-
-if (!isGeneric("readPartOfRow")) {
-	setGeneric("readPartOfRow", function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1))
-		standardGeneric("readPartOfRow"))
-}	
-
-setMethod('readPartOfRow', signature(object='RasterLayer'), 
-	function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) { 
-		return(.rasterRead(object, rownr, startcol, ncolumns))}
-)
-
-setMethod('readPartOfRow', signature(object='RasterStack'), 
-	function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) { 
-		return( .stackRead(object, rownr, startcol, ncolumns) ) }
-)
-
-if (!isGeneric("cellValues")) {
-	setGeneric("cellValues", function(object, cells)
-		standardGeneric("cellValues"))
-}	
-	
-setMethod("cellValues", signature(object='RasterLayer'), 
-	function(object, cells) { 
-		return(.rasterReadCells(object, cells))}
-)
-
-
-setMethod("cellValues", signature(object='RasterStack'), 
-	function(object, cells) { 
-		return(.stackReadCells(object, cells))}
-)
-
-if (!isGeneric("xyValues")) {
-	setGeneric("xyValues", function(object, xy)
-		standardGeneric("xyValues"))
-}	
-	
-setMethod("xyValues", signature(object='RasterLayer'), 
-	function(object, xy) { 
-		return(.rasterReadXY(object, xy))
-	}
-)
-
-setMethod("xyValues", signature(object='RasterStack'), 
-	function(object, xy) { 
-		return(.stackReadXY(object, xy))}
-)
-

Added: pkg/raster/R/show.R
===================================================================
--- pkg/raster/R/show.R	                        (rev 0)
+++ pkg/raster/R/show.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -0,0 +1,105 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date :  June 2008
+# Version 0,8
+# Licence GPL v3
+
+
+
+setMethod ('show' , 'BoundingBox', 
+	function(object) {
+		cat('class       :' , class(object), '\n')
+		cat('xmin        :' , xmin(object), '\n')
+		cat('xmax        :' , xmax(object), '\n')
+		cat('ymin        :' , ymin(object), '\n')
+		cat('ymax        :' , ymax(object), '\n')
+	}
+)	
+	
+
+setMethod ('show' , 'BasicRaster', 
+	function(object) {
+		cat('class       :' , class(object), '\n')
+		cat('nrow        :' , nrow(object), '\n')
+		cat('ncol        :' , ncol(object), '\n')
+		cat('ncells      :' , ncells(object), '\n')
+		cat('projection  :' , projection(object, TRUE), '\n')
+		cat('xmin        :' , xmin(object), '\n')
+		cat('xmax        :' , xmax(object), '\n')
+		cat('ymin        :' , ymin(object), '\n')
+		cat('ymax        :' , ymax(object), '\n')
+		cat('xres        :' , xres(object), '\n')
+		cat('yres        :' , yres(object), '\n')
+	}
+)	
+	
+setMethod ('show' , 'RasterLayer', 
+	function(object) {
+		cat('class       :' , class(object), '\n')
+		cat('filename    :' , filename(object), '\n')
+		if (nbands(object) > 1) {
+			cat('band        :' , band(object), '\n')
+		}	
+		cat('nrow        :' , nrow(object), '\n')
+		cat('ncol        :' , ncol(object), '\n')
+		cat('ncells      :' , ncells(object), '\n')
+		cat('data type   :' , object at file@datanotation, '\n')
+		cat('data content:' ,  dataContent(object), '\n')
+		if (object at data@haveminmax) {
+			cat('min value   :' , minValue(object), '\n')
+			cat('max value   :' , maxValue(object), '\n')
+		} else { #if (object at data@source == 'disk')  {
+			cat('min value   : NA \n')
+			cat('max value   : NA \n')
+		}
+		cat('projection  :' , projection(object, TRUE), '\n')
+		cat('xmin        :' , xmin(object), '\n')
+		cat('xmax        :' , xmax(object), '\n')
+		cat('ymin        :' , ymin(object), '\n')
+		cat('ymax        :' , ymax(object), '\n')
+		cat('xres        :' , xres(object), '\n')
+		cat('yres        :' , yres(object), '\n')
+		cat ('\n')
+	}
+)
+
+
+setMethod ('show' , 'RasterBrick',
+	function ( object ){
+		cat ('class     :' , class ( object ) , '\n')
+		cat ('filename  :' , filename(object), '\n')
+		cat ('nlayers   :' , nlayers(object), '\n')
+		cat ('nrow      :' , nrow(object), '\n')
+		cat ('ncol      :' , ncol(object), '\n')
+		cat ('ncells    :' , ncells(object), '\n')
+		cat ('projection:' , projection(object, TRUE), '\n')
+		cat ('xmin      :' , xmin(object), '\n')
+		cat ('xmax      :' , xmax(object), '\n')
+		cat ('ymin      :' , ymin(object), '\n')
+		cat ('ymax      :' , ymax(object), '\n')
+		cat ('xres      :' , xres(object) , '\n')
+		cat ('yres      :' , yres(object) , '\n')
+		cat ('\n')
+	}
+)
+
+
+setMethod ('show' , 'RasterStack',
+	function ( object ){
+		cat ('class     :' , class ( object ) , '\n')
+		cat ('filename  :' , filename(object), '\n')
+		cat ('nlayers   :' , nlayers(object), '\n')
+		cat ('nrow      :' , nrow(object), '\n')
+		cat ('ncol      :' , ncol(object), '\n')
+		cat ('ncells    :' , ncells(object), '\n')
+		cat ('projection:' , projection(object, TRUE), '\n')
+		cat ('xmin      :' , xmin(object), '\n')
+		cat ('xmax      :' , xmax(object), '\n')
+		cat ('ymin      :' , ymin(object), '\n')
+		cat ('ymax      :' , ymax(object), '\n')
+		cat ('xres      :' , xres(object) , '\n')
+		cat ('yres      :' , yres(object) , '\n')
+		cat ('\n')
+	}
+)
+

Modified: pkg/raster/R/standard.generic.functions.R
===================================================================
--- pkg/raster/R/standard.generic.functions.R	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/R/standard.generic.functions.R	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,194 +1,47 @@
-# Authors: Robert J. Hijmans, r.hijmans at gmail.com and Jacob van Etten
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
 # International Rice Research Institute
 # Date :  June 2008
 # Version 0,8
 # Licence GPL v3
 
 
-setMethod('dim', signature(x='Raster'), 
+setMethod('dim', signature(x='BasicRaster'), 
 	function(x){ return(c(nrow(x), ncol(x), nlayers(x)))}
 )
 
-setMethod('nrow', signature(x='Raster'), 
+setMethod('nrow', signature(x='BasicRaster'), 
 	function(x){ return(x at nrows)}
 )
 
-setMethod('ncol', signature(x='Raster'), 
+setMethod('ncol', signature(x='BasicRaster'), 
 	function(x){ return(x at ncols) }
 )
 
 
 
-setMethod ('show' , 'BoundingBox', 
-	function(object) {
-		cat('class       :' , class(object), '\n')
-		cat('xmin        :' , xmin(object), '\n')
-		cat('xmax        :' , xmax(object), '\n')
-		cat('ymin        :' , ymin(object), '\n')
-		cat('ymax        :' , ymax(object), '\n')
-	}
-)	
-	
-	
-setMethod ('show' , 'RasterLayer', 
-	function(object) {
-		cat('class       :' , class(object), '\n')
-		cat('filename    :' , filename(object), '\n')
-		if (nbands(object) > 1) {
-			cat('band        :' , band(object), '\n')
-		}	
-		cat('nrow        :' , nrow(object), '\n')
-		cat('ncol        :' , ncol(object), '\n')
-		cat('ncells      :' , ncells(object), '\n')
-		cat('data type   :' , object at file@datanotation, '\n')
-		cat('data content:' ,  dataContent(object), '\n')
-		if (object at data@haveminmax) {
-			cat('min value   :' , minValue(object), '\n')
-			cat('max value   :' , maxValue(object), '\n')
-		} else { #if (object at data@source == 'disk')  {
-			cat('min value   : NA \n')
-			cat('max value   : NA \n')
-		}
-		cat('projection  :' , projection(object, TRUE), '\n')
-		cat('xmin        :' , xmin(object), '\n')
-		cat('xmax        :' , xmax(object), '\n')
-		cat('ymin        :' , ymin(object), '\n')
-		cat('ymax        :' , ymax(object), '\n')
-		cat('xres        :' , xres(object), '\n')
-		cat('yres        :' , yres(object), '\n')
-		cat ('\n')
-	}
-)
-
-
-setMethod ('show' , 'RasterBrick',
-	function ( object ){
-		cat ('class     :' , class ( object ) , '\n')
-		cat ('filename  :' , filename(object), '\n')
-		cat ('nlayers   :' , nlayers(object), '\n')
-		cat ('nrow      :' , nrow(object), '\n')
-		cat ('ncol      :' , ncol(object), '\n')
-		cat ('ncells    :' , ncells(object), '\n')
-		cat ('projection:' , projection(object, TRUE), '\n')
-		cat ('xmin      :' , xmin(object), '\n')
-		cat ('xmax      :' , xmax(object), '\n')
-		cat ('ymin      :' , ymin(object), '\n')
-		cat ('ymax      :' , ymax(object), '\n')
-		cat ('xres      :' , xres(object) , '\n')
-		cat ('yres      :' , yres(object) , '\n')
-		cat ('\n')
-	}
-)
-
-
-setMethod ('show' , 'RasterStack',
-	function ( object ){
-		cat ('class     :' , class ( object ) , '\n')
-		cat ('filename  :' , filename(object), '\n')
-		cat ('nlayers   :' , nlayers(object), '\n')
-		cat ('nrow      :' , nrow(object), '\n')
-		cat ('ncol      :' , ncol(object), '\n')
-		cat ('ncells    :' , ncells(object), '\n')
-		cat ('projection:' , projection(object, TRUE), '\n')
-		cat ('xmin      :' , xmin(object), '\n')
-		cat ('xmax      :' , xmax(object), '\n')
-		cat ('ymin      :' , ymin(object), '\n')
-		cat ('ymax      :' , ymax(object), '\n')
-		cat ('xres      :' , xres(object) , '\n')
-		cat ('yres      :' , yres(object) , '\n')
-		cat ('\n')
-	}
-)
-
-
-	
-
-setMethod('summary', signature(object='Raster'), 
+setMethod('summary', signature(object='RasterStackBrick'), 
 	function(object, ...) {
-	# to be replaces by something more typical for summary in R, i.e. a sumary of the raster values
-		cat ("Cells: " , ncells(object), '\n')
-		if ( class(object) == "RasterLayer" ) {
-			if ( dataContent(object) == "all") {
-				cat("NAs  : ", sum(is.na(values(object))), "\n")
-				summary(values(object))
-			} else {
-				cat("values not in memory\n")
+		if (dataContent(object) == 'all') {
+			for (n in 1:nlayers(object)) {
+				cat("layer ", n, "\n")
+				cat("NAs  : ", sum(is.na(values(object)[,n])), "\n")
+				summary(values(object)[,n])
 			}
-		} else if (class(object) == "RasterStack" | class(object) == "RasterBrick") {
-			if (dataContent(object) == 'all') {
-				for (n in 1:nlayers(object)) {
-					cat("layer ", n, "\n")
-					cat("NAs  : ", sum(is.na(values(object)[,n])), "\n")
-					summary(values(object)[,n])
-				}
-			} else {
-				cat("values not in memory\n")
-			}
-		} 
-	}	
-)
-
-
-setMethod("plot", signature(x='Raster', y='missing'), 
-	function(x, y, ...)  {
-		map(x, ...)
+		} else {
+			cat("values not in memory\n")
+		}
 	}
 )	
 
-setMethod("plot", signature(x='Raster', y='numeric'), 
-	function(x, y, ...)  {
-		map(x, y, ...)
-	}
-)		
-
-
-# helper function to set ... variables if they are not specified by the user. There probably exists a formal, and direct, mechanism to do this in R, but I have not discovered this yet...
-#.getmaxdim <- function(maxdim=1000, ...) {
-#	return(maxdim)
-#}
-
-.getcex <- function(cex = 0.1, ...) {
-	return(cex)
-}
-
-setMethod("plot", signature(x='RasterLayer', y='RasterLayer'), 
-	function(x, y, maxdim=1000, ...)  {
-		comp <- compare(c(x, y), bb=TRUE, rowcol=TRUE, prj=FALSE, tolerance=0.0001, stopiffalse=TRUE) 
-		nc <- ncells(x)
-		x <- readSkip(x, maxdim=maxdim)
-		y <- readSkip(y, maxdim=maxdim)
-		if (length(x) < nc) {
-			warning(paste('plot used a sample of ', round(100*length(x)/nc), "% of the cells", sep=""))
-		}
-		cex <- .getcex(...)
-		plot(x, y, ...)			
-	}
-)
-	
-
-setMethod('hist', signature(x='RasterLayer'), 
-	function(x, maxsamp=10000, ...){
-		if (dataContent(x) != 'all') {
-			if (dataSource(x) == 'disk') {
-		# TO DO: ake a function that does this by block and combines  all data into a single histogram
-				if (ncells(x) <= maxsamp) {
-					values <- na.omit(values(readAll(x)))
-				} else {
-					values <- readRandom(x, maxsamp)
-					msg <- paste(round(100 * maxsamp / ncells(x)), "% of the raster cells were used", sep="")
-					if (maxsamp > length(values)) {
-						msg <- paste(msg, " (of which ", 100 - round(100 * length(values) / maxsamp ), "% were NA)", sep="")
-					}
-					msg <- paste(msg, ". ",length(values)," values used.", sep="")
-					warning(msg)
-				}	
-			} else { stop('cannot make a histogram; need data on disk or in memory')}
+setMethod('summary', signature(object='RasterLayer'), 
+	function(object, ...) {
+		cat ("Cells: " , ncells(object), '\n')
+		if ( dataContent(object) == "all") {
+			cat("NAs  : ", sum(is.na(values(object))), "\n")
+			summary(values(object))
 		} else {
-			values <- values(x)
-		}			
-		hist(values, ...)
+			cat("values not in memory\n")
+		}
 	}	
 )
 
-
-

Modified: pkg/raster/man/Compare-methods.Rd
===================================================================
--- pkg/raster/man/Compare-methods.Rd	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/man/Compare-methods.Rd	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,13 +1,14 @@
 \name{Compare-methods}
 \docType{methods}
 \alias{Compare-methods}
-\alias{==,Raster,Raster-method}
-\alias{!=,Raster,Raster-method}
+\alias{==,BasicRaster,BasicRaster-method}
+\alias{!=,BasicRaster,BasicRaster-method}
 
 \title{ Methods to compare Raster* objects}
 \description{
  These methods compare the location and resolution of Raster*(i.e. their bounding boxes, projection, and rows and columns. They do not compare the values associated with the objects; nor if they are of the same class (but they must be decendants from Raster' 
- The following methods have been implemented: '==' and '!='
+ The following methods have been implemented: for BasicRaster returning a single logical value \code{TRUE} or \code{FALSE}
+ and the folliwing for RasterLayer: "==", "!=", ">", "<",  "<=", ">=", returning a logical (Boolean) RasterLayer
 }
 
 \author{Robert J. Hijmans \email{r.hijmans at gmail.com}}
@@ -15,11 +16,16 @@
 
 \examples{
 r1 <- newRaster()
-r2 <- r1
-r2 == r1
+r1 <- setValues(r1, round(10 * runif(ncells(r1))))
+r2 <- setValues(r1, round(10 * runif(ncells(r1))))
+as(r1, "BasicRaster") == as(r2, "BasicRaster")
+r3 <- r1 > r2
+
 b <- newBbox(0, 360, 0, 180)
-r3 <- setBbox(r2, b)
-r2 != r3
+r4 <- setBbox(r2, b)
+as(r2, "BasicRaster") != as(r4, "BasicRaster")
+# The following would give an error. You cannot compare RasterLayer object that do not have the same BasicRaster properties.
+#r3 <- r1 > r4
 }
 
 

Modified: pkg/raster/man/Logic-methods.Rd
===================================================================
--- pkg/raster/man/Logic-methods.Rd	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/man/Logic-methods.Rd	2009-01-12 14:51:25 UTC (rev 123)
@@ -9,10 +9,6 @@
 	The following boolean operators are available: '&', '|'
 	is.na(object) can also be called. 
 }
-\section{Methods}{
-}
-\describe{
-}
 
 \keyword{methods}
 \keyword{math}

Modified: pkg/raster/man/bbox.Rd
===================================================================
--- pkg/raster/man/bbox.Rd	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/man/bbox.Rd	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,5 +1,11 @@
 \name{box}
 \alias{getBbox}
+\alias{getBbox,BoundingBox-method}
+\alias{getBbox,BasicRaster-method}
+\alias{getBbox,Spatial-method}
+\alias{getBbox,matrix-method}
+\alias{getBbox,vector-method}
+
 \alias{newBbox}
 \alias{setBbox}
 \alias{changeBbox}
@@ -7,9 +13,10 @@
   
 \title{ Bounding box functions }
 \description{
-  newBbox creates a new bounding box (as in the "Spatial" object from the SP package)
-  setBbox sets the bounding box of a Raster* object
-  changeBbox changes the bounding box of a Raster* object
+	getBbox extracts a bounding box from a Raster* or Spatial* object (or from a BoundingBox object). It will also create a BoundingBox object from a matrix (2 x 2) or vector (length=4)
+	newBbox creates a new bounding box (as in the "Spatial" object from the SP package)
+	setBbox sets the bounding box of a Raster* object
+	changeBbox changes the bounding box of a Raster* object
 }
 
 \usage{

Modified: pkg/raster/man/classes.Rd
===================================================================
--- pkg/raster/man/classes.Rd	2009-01-12 10:52:24 UTC (rev 122)
+++ pkg/raster/man/classes.Rd	2009-01-12 14:51:25 UTC (rev 123)
@@ -1,19 +1,23 @@
 \name{RasterLayer-class}
 \docType{class}
 
+\alias{BoundingBox-class}
+\alias{BasicRaster-class}
 \alias{Raster-class}
 \alias{RasterLayer-class}
 \alias{RasterStack-class}
 \alias{RasterBrick-class}
 \alias{show,BoundingBox-method}
+\alias{show,BasicRaster-method}
 \alias{show,RasterLayer-method}
 \alias{show,RasterStack-method}
 \alias{show,RasterBrick-method}
-\alias{hist,RasterLayer-method}
+\alias{hist,Raster-method}
 \alias{plot,Raster,missing-method}
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/raster -r 123


More information about the Raster-commits mailing list