[Raster-commits] r389 - pkg/raster/R

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

Author: rhijmans
Date: 2009-04-03 05:44:57 +0200 (Fri, 03 Apr 2009)
New Revision: 389

Modified:
   pkg/raster/R/aggregate.R
   pkg/raster/R/dataProperties.R
   pkg/raster/R/hist.R
   pkg/raster/R/pointsToRaster.R
   pkg/raster/R/rasterToPoints.R
Log:


Modified: pkg/raster/R/aggregate.R
===================================================================
--- pkg/raster/R/aggregate.R	2009-04-02 10:49:05 UTC (rev 388)
+++ pkg/raster/R/aggregate.R	2009-04-03 03:44:57 UTC (rev 389)
@@ -44,13 +44,26 @@
 	outRaster <- setExtent(outRaster, bndbox, keepres=FALSE)
 	outRaster <- setRowCol(outRaster, nrows=rsteps, ncols=csteps) 
 	
+	
+	if (na.rm) {
+		# this avoid warning messages 
+		narmfun <- function(x) { 
+			x <- na.omit(x)
+			if (length(x) == 0) { 
+				return(NA)
+			} else { 
+				return( fun(x) )
+			}
+		}
+	}
+	
 	if (dataContent(x) == 'all') {	
 		cols <- rep(rep(1:csteps, each=xfact)[1:ncol(x)], times=nrow(x))
 		rows <- rep(1:rsteps, each=ncol(x) * yfact)[1:ncell(x)]
 		cells <- cellFromRowCol(x, rows, cols)
 		
 		if (na.rm) {
-			outRaster <- setValues(outRaster, as.vector( tapply(values(x), cells, function(x){fun(na.omit(x))}))) 
+			outRaster <- setValues(outRaster, as.vector( tapply(values(x), cells, narmfun ))) 
 		} else {
 			outRaster <- setValues(outRaster, as.vector(tapply(values(x), cells, fun))) 
 		}
@@ -84,7 +97,7 @@
 			cells <- cellFromRowCol(x, theserows, cols)
 			
 			if (na.rm) { 
-				vals <- tapply(values(x), cells, function(x){fun(na.omit(x))} ) 
+				vals <- tapply(values(x), cells, narmfun ) 
 			} else { 
 				vals <- tapply(values(x), cells, fun) 
 			}

Modified: pkg/raster/R/dataProperties.R
===================================================================
--- pkg/raster/R/dataProperties.R	2009-04-02 10:49:05 UTC (rev 388)
+++ pkg/raster/R/dataProperties.R	2009-04-03 03:44:57 UTC (rev 389)
@@ -18,7 +18,9 @@
 }
 
 .shortDataType <- function(object) {
-	if (class(object) != 'character'){object <- dataType(object)}
+	if (class(object) != 'character') {
+		object <- dataType(object)
+	}
 	return( substr(object, 1, 3)) 
 }
 

Modified: pkg/raster/R/hist.R
===================================================================
--- pkg/raster/R/hist.R	2009-04-02 10:49:05 UTC (rev 388)
+++ pkg/raster/R/hist.R	2009-04-03 03:44:57 UTC (rev 389)
@@ -31,7 +31,10 @@
 			} else { stop('cannot make a histogram; need data on disk or in memory')}
 		} else {
 			values <- values(x)
-		}			
+		}		
+		if (.shortDataType(x) == 'LOG') {
+			values <- values * 1
+		}
 		hist(values, ...)
 	}	
 )

Modified: pkg/raster/R/pointsToRaster.R
===================================================================
--- pkg/raster/R/pointsToRaster.R	2009-04-02 10:49:05 UTC (rev 388)
+++ pkg/raster/R/pointsToRaster.R	2009-04-03 03:44:57 UTC (rev 389)
@@ -6,8 +6,14 @@
 
 
 pointsToRaster <- function(raster, xy, values=rep(1, length(xy[,1])), fun=length, background=NA, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
-# make this an argument ?  so that you can use e.g.  background=0 
 	
+#	if (class(xy) == 'SpatialPointsDataFrame' & length(values)==1)  {
+#		values <- xy[[values]]
+#	}
+
+	if (!is.vector(values)) {
+		stop('values should be a vector')
+	}
 	xy <- .pointsToMatrix(xy)
 	
 	rs <- raster(raster, filename)

Modified: pkg/raster/R/rasterToPoints.R
===================================================================
--- pkg/raster/R/rasterToPoints.R	2009-04-02 10:49:05 UTC (rev 388)
+++ pkg/raster/R/rasterToPoints.R	2009-04-03 03:44:57 UTC (rev 389)
@@ -43,7 +43,10 @@
 	if (asSpatialPoints) {
 		coords <- xyv[,1:2]
 		row.names(coords) <- 1:nrow(coords)
-		return(SpatialPointsDataFrame(coords=coords, data=as.data.frame(xyv[,3]), proj4string=projection(raster, asText=FALSE)))
+		colnames(coords) <- c('x', 'y')
+		rastvals <- as.data.frame(xyv[,3])
+		colnames(rastvals) <- 'value'
+		return(SpatialPointsDataFrame(coords=coords, data=rastvals, proj4string=projection(raster, asText=FALSE)))
 	} else {
 		return(xyv)
 	}