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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Feb 4 06:14:30 CET 2009


Author: rhijmans
Date: 2009-02-04 06:14:29 +0100 (Wed, 04 Feb 2009)
New Revision: 243

Modified:
   pkg/raster/NAMESPACE
   pkg/raster/R/click.R
   pkg/raster/R/group.generic.functions.R
   pkg/raster/R/stack.R
   pkg/raster/man/coerce.Rd
   pkg/raster/man/create.stack.Rd
Log:


Modified: pkg/raster/NAMESPACE
===================================================================
--- pkg/raster/NAMESPACE	2009-02-03 16:37:45 UTC (rev 242)
+++ pkg/raster/NAMESPACE	2009-02-04 05:14:29 UTC (rev 243)
@@ -1,7 +1,8 @@
 importFrom("methods", Arith, Compare, Logic, Math)
 importFrom("graphics", hist, plot)
-importFrom("stats", aggregate)
+importFrom("stats", median, aggregate)
+importFrom("utils", stack)
 importFrom("sp", bbox, overlay, Spatial, SpatialPixels, SpatialPixelsDataFrame, SpatialGrid, SpatialGridDataFrame)
 exportClasses(BoundingBox, BasicRaster, Raster, RasterLayer, RasterStack)
-exportMethods(aggregate, show, summary, plot, hist, ncol, nrow, dim, overlay, bbox)
+exportMethods(aggregate, stack, median, show, summary, plot, hist, ncol, nrow, dim, overlay, bbox)
 exportPattern("^[^\\.]")
\ No newline at end of file

Modified: pkg/raster/R/click.R
===================================================================
--- pkg/raster/R/click.R	2009-02-03 16:37:45 UTC (rev 242)
+++ pkg/raster/R/click.R	2009-02-04 05:14:29 UTC (rev 243)
@@ -6,12 +6,26 @@
 # Version 0.8
 # Licence GPL v3
 
+clickBbox <- function(show=TRUE, border="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) )
+		pol <- SpatialPolygons(list(Polygons(list(Polygon(p)), 1)))
+		plot(pol, add=TRUE, border=border)
+	}
+	return(bb)
+}
 
+
 click <- function(object, n=1, xy=FALSE, type="n", ...) {
 	loc <- locator(n, type, ...)
 	x <- loc$x
 	y <- loc$y
 	xyCoords <- cbind(x, y)
+	if (missing(object)) {
+		return(cbind(xyCoords))
+	}
 	if (dataContent(object) != 'all') {
 		if (dataSource(object) != 'disk') {
 			stop('no data associated with this RasterLayer object')

Modified: pkg/raster/R/group.generic.functions.R
===================================================================
--- pkg/raster/R/group.generic.functions.R	2009-02-03 16:37:45 UTC (rev 242)
+++ pkg/raster/R/group.generic.functions.R	2009-02-04 05:14:29 UTC (rev 243)
@@ -128,7 +128,50 @@
 )
 
 
+if (!isGeneric("median")) {
+	setGeneric("median", function(x, na.rm=FALSE)
+		standardGeneric("median"))
+}
 
+
+setMethod('median', signature(x='Raster'), 
+	function(x, na.rm=FALSE){
+		if (dataContent(x) == 'all') {
+			return(median(values(x), na.rm=na.rm))
+		} else {
+# needs to be improved for large files. Make frequency table row by row.....
+			return(median(values(readAll(x)), na.rm=na.rm))
+		}
+	}
+)
+
+
+
+
+
+if (!isGeneric("rmedian")) {
+	setGeneric("rmedian", function(x, ..., na.rm=FALSE)
+		standardGeneric("rmedian"))
+}
+
+setMethod('rmedian', signature(x='Raster'), 
+	function(x, ..., na.rm=FALSE){
+		obs <- list(...)
+		if (length(obs) == 0) {
+			return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, median, na.rm=na.rm)))
+		} else {
+			stk <- stack(c(x,obs))
+			v <- vector()
+			for (r in 1:nrow(stk)) {
+				v <- c(v, apply(values(readRow(stk, r)), 1, median, na.rm=na.rm)) 
+			}
+			return(setRaster(x, values=v))
+		}
+	}
+)
+
+
+
 setMethod("max", signature(x='Raster'),
 	function(x, ..., na.rm=FALSE){
 		obs <- list(...)

Modified: pkg/raster/R/stack.R
===================================================================
--- pkg/raster/R/stack.R	2009-02-03 16:37:45 UTC (rev 242)
+++ pkg/raster/R/stack.R	2009-02-04 05:14:29 UTC (rev 243)
@@ -35,51 +35,43 @@
 }
 
 
-#if (!isGeneric("stack")) {
-#	setGeneric("stack", function(x, ...)
-#		standardGeneric("stack"))
-#}	
 
 
-#setMethod("stack", signature(x='RasterLayer'), 
-#function(x, ...) {
-#	rlist <- c(x, list(...))
-#	for (i in 1:length(rlist)) {
-#		if (is.character(rlist[[i]])) {
-#			rlist[i] <- rasterFromFile(rlist[[i]])
-#		} else {
-#			if (class(rlist[[i]]) != "RasterLayer") {
-#				stop("Arguments should be RasterLayer objects or filenames")
-#			}
-#		}	
-#	}
-#	return(addRasters(new("RasterStack"), rlist))
-#} )
-
-
-
-if (!isGeneric("makeStack")) {
-	setGeneric("makeStack", function(x, ...)
-		standardGeneric("makeStack"))
+if (!isGeneric("stack")) {
+	setGeneric("stack", function(x, ...)
+		standardGeneric("stack"))
 }	
 
+setMethod("stack", signature(x='RasterLayer'), 
+function(x, ...) {
+	rlist <- c(x, list(...))
+	return(stack(rlist))	
+} )
 
-setMethod("makeStack", signature(x='RasterLayer'), 
+
+setMethod("stack", signature(x='character'), 
 function(x, ...) {
 	rlist <- c(x, list(...))
-	for (i in 1:length(rlist)) {
-		if (is.character(rlist[[i]])) {
-			rlist[i] <- rasterFromFile(rlist[[i]])
+	return(stack(rlist))
+} )
+
+
+setMethod("stack", signature(x='list'), 
+function(x) {
+	for (i in 1:length(x)) {
+		if (is.character(x[[i]])) {
+			x[i] <- rasterFromFile(x[[i]])
 		} else {
-			if (class(rlist[[i]]) != "RasterLayer") {
+			if (class(x[[i]]) != "RasterLayer") {
 				stop("Arguments should be RasterLayer objects or filenames")
 			}
 		}	
 	}
-	return(addRasters(new("RasterStack"), rlist))
+	return(addRasters(new("RasterStack"), x))
 } )
 
 
+
 addFiles <- function(rstack, rasterfiles, bands=rep(1, length(rasterfiles))) {
 	if (length(bands) == 1) {
 		bands=rep(bands, length(rasterfiles))

Modified: pkg/raster/man/coerce.Rd
===================================================================
--- pkg/raster/man/coerce.Rd	2009-02-03 16:37:45 UTC (rev 242)
+++ pkg/raster/man/coerce.Rd	2009-02-04 05:14:29 UTC (rev 243)
@@ -41,11 +41,11 @@
 r1 <- raster(ncols=90, nrows=45)
 r1 <- setValues(r1, 1:ncell(r1))
 r2 <- setValues(r1, 1:ncell(r1))
-stk <- makeStack(r1, r2)
+stk <- stack(r1, r2)
 sp <- as(stk, 'SpatialGridDataFrame')
 r3 <- asRasterLayer(sp, 2) 
 as(r2, 'BasicRaster') == as(r3, 'BasicRaster')
-sum(values(r2) == values(r3)) == ncell(r2)
+all(values(r2) == values(r3))
 r4 <- asRasterLayer(stk, 1)
 sp <- as(r4, 'SpatialPixels')
 sp <- as(r4, 'SpatialGridDataFrame')

Modified: pkg/raster/man/create.stack.Rd
===================================================================
--- pkg/raster/man/create.stack.Rd	2009-02-03 16:37:45 UTC (rev 242)
+++ pkg/raster/man/create.stack.Rd	2009-02-04 05:14:29 UTC (rev 243)
@@ -1,6 +1,8 @@
 \name{rasterstack.create}
-\alias{makeStack}
-\alias{makeStack,RasterLayer-method}
+\alias{stack}
+\alias{stack,RasterLayer-method}
+\alias{stack,character-method}
+\alias{stack,list-method}
 \alias{stackFromFiles}
 \alias{stackFromRasters}
 \alias{addFiles}
@@ -14,7 +16,7 @@
 }
 
 \usage{
-makeStack(x, ...)
+stack(x, ...)
 stackFromFiles(rasterfiles, bands= rep(1, length(rasterfiles)))
 addFiles(rstack, rasterfiles, bands= rep(1, length(rasterfiles))) 
 addRasters(rstack, rasters) 
@@ -22,11 +24,11 @@
 }
 
 \arguments{
-   \item{rstack}{ a RasterStack object }
-  \item{x}{a RasterLayer object}
-  \item{...}{additional RasterLayer objects (or filenames) }
+  \item{x}{a RasterLayer, character (raster filename), or list (of RasterLayers and/or filenames) object}
   \item{rasterfiles}{ Filename(s) of (a) raster dataset(s) }
   \item{bands}{ A vector or list of bands of raster data files (default values = 1)}
+  \item{rstack}{ a RasterStack object }
+  \item{...}{additional RasterLayer objects (or filenames) }
   \item{rasters}{ RasterLayer object(s) }
   \item{indices}{ the indices of the raster(s) to remove from a RasterStack }
 }



More information about the Raster-commits mailing list