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

[noreply at r-forge.r-project.org]

Author: rhijmans
Date: 2009-01-29 16:11:08 +0100 (Thu, 29 Jan 2009)
New Revision: 216

Modified:
   pkg/raster/R/set.values.R
   pkg/raster/man/setValues.Rd
Log:


Modified: pkg/raster/R/set.values.R
===================================================================
--- pkg/raster/R/set.values.R	2009-01-29 13:28:24 UTC (rev 215)
+++ pkg/raster/R/set.values.R	2009-01-29 15:11:08 UTC (rev 216)
@@ -6,54 +6,123 @@
 
 
 
-#if (!isGeneric("setValues")) {
-#	setGeneric("setValues", function(object, values, rownr)
-#		standardGeneric("setValues"))   }	
+if (!isGeneric('setValues')) {
+	setGeneric('setValues', function(object, values, rownr=-1, layer=-1)
+		standardGeneric('setValues')) 
+	}	
 
-	
-setValues <- function(raster, values, rownr=-1) {
+
+		
+setMethod('setValues', signature(object='RasterLayer'), 
+  
+  function(object, values, rownr=-1,  layer=-1) {
+  
 	if (!is.vector(values)) {stop('values must be a vector')}
-	if (!(is.numeric(values) | is.integer(values) | is.logical(values))) {stop('data must be values')}
+	if (!(is.numeric(values) | is.integer(values) | is.logical(values))) {
+		stop('values must be numeric, integer or logical.')	}
 	
-	rownr <- round(rownr)
 
-	if (length(values) == 0) {	
-		return(clearValues(raster)) 
-	}
 	if (length(values) == 1) {	
 		if (rownr > 0) { 
-			values <- rep(values, ncol(raster))
+			values <- rep(values, ncol(object))
 		} else {
-			values <- rep(values, ncell(raster))
+			values <- rep(values, ncell(object))
 		}
 	}
-	if (length(values) == ncell(raster)) { 
+
+	if (length(values) == ncell(object)) { 
 		if (rownr > 0) {
 			stop("if setting all values, rownr must be < 1")
 		}
-		raster at data@values <- values
-		raster at data@content <- 'all'
-		raster at data@source <- 'ram'
-		raster at data@indices <- c(1, ncell(raster))
-		raster <- setMinMax(raster)
-		return(raster)	
-	} else if (length(values) == ncol(raster)) {
-		if (rownr < 1 | rownr > nrow(raster)) {
+		object at data@values <- values
+		object at data@content <- 'all'
+		object at data@source <- 'ram'
+		object at data@indices <- c(1, ncell(object))
+		object <- setMinMax(object)
+		return(object)	
+	} else if (length(values) == ncol(object)) {
+		rownr <- round(rownr)
+		if (rownr < 1 | rownr > nrow(object)) {
 			stop(paste("rownumber out of bounds:", rownr))
 		}
-		raster at data@values <- values
-		raster at data@content <- 'row' 
-		firstcell <- cellFromRowCol(raster, rownr=rownr, colnr=1)
-		lastcell <- cellFromRowCol(raster, rownr=rownr, colnr=ncol(raster))
-		raster at data@indices <- c(firstcell, lastcell)
-		return(raster)
+		object at data@values <- values
+		object at data@content <- 'row' 
+		firstcell <- cellFromRowCol(object, rownr=rownr, colnr=1)
+		lastcell <- cellFromRowCol(object, rownr=rownr, colnr=ncol(object))
+		object at data@indices <- c(firstcell, lastcell)
+		return(object)
 	} else {
-		stop("length(values) is not equal to ncell(raster) or ncol(raster)") 
+		stop("length(values) is not equal to ncell(object) or ncol(object)") 
 	}
-}	
+ }
+)
 	
 
 
+setMethod('setValues', signature(object='RasterStack'), 
+  function(object, values, rownr=-1, layer=-1) {
+	if (!(is.vector(values) | is.matrix(values))) {
+		stop('values must be a vector or a matrix')
+	}
+	if (!(is.numeric(values) | is.integer(values) | is.logical(values))) {
+		stop('values must be numeric, integer or logical.')	
+	}
+	rownr <- round(rownr)
+	
+	if (is.matrix(values)) {
+		if (ncol(values) == nlayers(object)) {
+			object at data@values <- values
+			if (nrow(values) == 1) {
+				object at data@content <= 'all'
+				object at data@indices <- c(1, ncell(object))
+			} else if (nrow(values) == nrow(object)) {
+				object at data@content <= 'row'
+				firstcell <- cellFromRowCol(object, rownr=rownr, colnr=1)
+				lastcell <- cellFromRowCol(object, rownr=rownr, colnr=ncol(object))
+				object at data@indices <- c(firstcell, lastcell)				
+			} else {
+				stop('either set all data or a single row')
+			}
+		} else if (ncol(values) == 1) {
+			values <- as.vector(values)
+		} else {
+			stop('either set values for all layers or for a single layer')
+		}
+	}
+	
+	if (is.vector(values)) {
+		layer <- round(layer)
+		if (layer < 1) { 
+			print(class(object))
+			stop('specify layer')	}
+		if (layer > nlayers(object)) {stop('layer number too high')}
+		
+		
+		if (length(values) == ncell(object)) { 
+			if (rownr > 0) {
+				stop("if setting all values, rownr must be < 1")
+			}
+			if (dataContent(object) != 'all') { 
+				stop(" you can only setValues with these values if the dataContent = 'all'") }
+			object at data@values[,layer] <- values
+	#		object <- setMinMax(object)
+		} else if (length(values) == ncol(object)) {
+			if (rownr < 1 | rownr > nrow(object)) {
+				stop(paste("rownumber out of bounds:", rownr))
+			}
+			object at data@values <- values
+			object at data@content <- 'row' 
+			firstcell <- cellFromRowCol(object, rownr=rownr, colnr=1)
+			lastcell <- cellFromRowCol(object, rownr=rownr, colnr=ncol(object))
+			object at data@indices <- c(firstcell, lastcell)
+		}
+	} else {
+		stop("length(values) is not equal to ncell(object) or ncol(object)") 
+	}
+ }
+)
+	
+
 clearValues <- function(object) {
 	if (class(object) == "BasicRaster") {
 		return(object)

Modified: pkg/raster/man/setValues.Rd
===================================================================
--- pkg/raster/man/setValues.Rd	2009-01-29 13:28:24 UTC (rev 215)
+++ pkg/raster/man/setValues.Rd	2009-01-29 15:11:08 UTC (rev 216)
@@ -1,5 +1,7 @@
 \name{setValues}
 \alias{setValues}
+\alias{setValues,RasterLayer-method}
+\alias{setValues,RasterStack-method}
 \alias{setValuesBlock}
 \alias{setValuesSparse}
 \alias{clearValues}
@@ -13,7 +15,7 @@
 }
 
 \usage{
-setValues(raster, values, rownr=-1) 
+setValues(object, values, rownr=-1, layer=-1) 
 setValuesBlock(raster, blockvalues, firstcell, lastcell) 
 setValuesSparse(raster, sparsevalues, cellnumbers) 
 clearValues(object)
@@ -23,8 +25,9 @@
 
 \arguments{
   \item{raster}{ A \code{RasterLayer} object }
-  \item{object}{ A \code{Raster*} object }
+  \item{object}{ A \code{RasterLayer} or \code{RasterStack} object }
   \item{values}{ Data values to associate with the RasterLayer object. There should be values for all cells or for a single row}
+  \item{layer}{ layer number (only relevant for RasterStack objects) }
   \item{rownr}{ row number, between 1 and nrow(raster) }
   \item{blockvalues}{ Data values to associate with the RasterLayer object for a block of data, i.e. a rectangular area within the entire raster }
   \item{firstcell}{ first cell (upper left corner) of the blockdata }