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

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

Author: rhijmans
Date: 2009-01-26 11:52:15 +0100 (Mon, 26 Jan 2009)
New Revision: 182

Added:
   pkg/raster/R/project.R
   pkg/raster/R/resample.R
Modified:
   pkg/raster/R/properties.R
   pkg/raster/R/set.R
   pkg/raster/man/set.Rd
Log:


Added: pkg/raster/R/project.R
===================================================================
--- pkg/raster/R/project.R	                        (rev 0)
+++ pkg/raster/R/project.R	2009-01-26 10:52:15 UTC (rev 182)
@@ -0,0 +1,41 @@
+
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date :  June 2008
+# Version 0,1
+# Licence GPL v3
+
+.xyProj <- function(xy, inProj, outProj) {
+	if (!isLatLon(inProj)) {
+		xy <- project(xy, inProj, inv=TRUE)
+	}
+	xyproj <- project(xy, outProj, inv=FALSE)		
+	return(xyproj)
+}
+
+projectRaster <- function(fromRaster, toRaster, method="nngb", overwrite=FALSE) {
+# do the bounding boxes overlap at all? 
+# get .innerbox first?
+# are the projs not NA and valid and not the same?
+warning("this function has not been tested yet. Not at all")
+	rowCells <- 1:ncol(toRaster)
+	inMemory <- filename(toRaster) == ""
+	v <- vector(length=0)
+	for (r in 1:nrow(toRaster)) {
+		cells <- rowCells + (r-1) * ncol(toRaster)
+		xy <- xyFromCell(toRaster, cells)
+		projxy <- .xyProj(xy, projection(toRaster), projection(fromRaster))
+		vals <- xyValues(fromRaster, projxy)
+		if (inMemory) {
+			v <- c(v, vals)
+		} else {
+			toRaster <- setValues(toRaster, vals, r)
+			toRaster <- writeRaster(toRaster, overwrite=overwrite)
+		}
+	}
+	if (inMemory) {
+		toRaster <- setValues(toRaster, v) 
+	}
+	return(toRaster)
+}
+

Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R	2009-01-25 15:45:07 UTC (rev 181)
+++ pkg/raster/R/properties.R	2009-01-26 10:52:15 UTC (rev 182)
@@ -28,10 +28,45 @@
     }
 )
 
+setMethod('isLatLon', signature(object='character'), 
+# copied from the SP package (slightly adapted)
+#author:
+# ...
+	function(object){
+		res <- grep("longlat", object, fixed = TRUE)
+		if (length(res) == 0) {
+			return(FALSE)
+		} else {
+			return(TRUE)
+		}
+    }
+)
 
 
+setMethod('isLatLon', signature(object='CRS'), 
+# copied from the SP package (slightly adapted)
+#author:
+# ...
+	function(object){
+		if (is.na(object at projargs)) { 
+			p4str <- "NA"
+		} else {
+			p4str <- trim(object at projargs)
+		}	
+		if (is.na(p4str) || nchar(p4str) == 0) {
+			return(as.logical(NA))
+		} 
+		res <- grep("longlat", p4str, fixed = TRUE)
+		if (length(res) == 0) {
+			return(FALSE)
+		} else {
+			return(TRUE)
+		}
+    }
+)
 
 
+
 filename <- function(object) {
 	if (class(object) == 'RasterStack') { 
 		return(object at filename) 
@@ -143,7 +178,7 @@
 		if (is.na(object at crs@projargs)) { 
 			return("NA") 
 		} else {
-			return(object at crs@projargs)
+			return(trim(object at crs@projargs))
 		}	
 	} else {
 		return(object at crs)

Added: pkg/raster/R/resample.R
===================================================================
--- pkg/raster/R/resample.R	                        (rev 0)
+++ pkg/raster/R/resample.R	2009-01-26 10:52:15 UTC (rev 182)
@@ -0,0 +1,33 @@
+
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date :  June 2008
+# Version 0,1
+# Licence GPL v3
+
+resample <- function(fromRaster, toRaster, method="nngb", overwrite=FALSE) {
+# do the bounding boxes overlap at all? 
+# get .innerbox first?
+warning("this function has not been tested yet. Not at all")
+	rowCells <- 1:ncol(toRaster)
+	inMemory <- filename(toRaster) == ""
+	v <- vector(length=0)
+	for (r in 1:nrow(toRaster)) {
+		cells <- rowCells + (r-1) * ncol(toRaster)
+		xy <- xyFromCell(toRaster, cells)
+		vals <- xyValues(fromRaster, xy)
+		if (inMemory) {
+			v <- c(v, vals)
+		} else {
+			toRaster <- setValues(toRaster, vals, r)
+			toRaster <- writeRaster(toRaster, overwrite=overwrite)
+		}
+	}
+	if (inMemory) {
+		toRaster <- setValues(toRaster, v) 
+	}
+	return(toRaster)
+}
+
+
+

Modified: pkg/raster/R/set.R
===================================================================
--- pkg/raster/R/set.R	2009-01-25 15:45:07 UTC (rev 181)
+++ pkg/raster/R/set.R	2009-01-26 10:52:15 UTC (rev 182)
@@ -68,7 +68,39 @@
 }
 
 
-setProjection <- function(object, projstring) {
+
+.xyBbox <- function(object) {
+	b <- getBbox(object)
+	xy <- c(b at xmin, b at ymax)
+	xy <- rbind(xy, c(b at xmax, b at ymax))
+	xy <- rbind(xy, c(b at xmin, b at ymin))
+	xy <- rbind(xy, c(b at xmax, b at ymin))
+	colnames(xy) <- c("x", "y")
+	rownames(xy)[1] <- ""
+	return(xy)
+}
+
+
+setProjection <- function(object, projstring, adjustBbox=FALSE) {
+	if (adjustBbox) {
+		b <- .xyBbox(object)
+		if (isLatLon(object)) {
+			p <- project(b, projstring, inv=FALSE)
+		} else {
+			b <- project(b, projection(object), inv=TRUE)
+			if (isLatLon(projstring)) {
+				p <- b
+			} else {
+				p <- project(b, projstring, inv=FALSE)
+			}
+		}
+		xmin <- min(p[,1])
+		xmax <- max(p[,1])
+		ymin <- min(p[,2])
+		ymax <- max(p[,2])	
+		bb <- newBbox(xmin, xmax, ymin, ymax)
+		object <- setBbox(object, bb)
+	}
 	if (class(projstring)=="CRS") {
 		object at crs <- projstring
 	} else {	

Modified: pkg/raster/man/set.Rd
===================================================================
--- pkg/raster/man/set.Rd	2009-01-25 15:45:07 UTC (rev 181)
+++ pkg/raster/man/set.Rd	2009-01-26 10:52:15 UTC (rev 182)
@@ -14,7 +14,7 @@
 }
 
 \usage{
-setProjection(object, projstring)
+setProjection(object, projstring, adjustBbox=FALSE)
 setFilename(object, filename)
 setRaster(object, filename="", values=NA)
 setDatatype(raster, datatype, datasize)
@@ -36,6 +36,7 @@
   \item{yres}{ the new y resolution}  
   \item{projstring}{a character string describing a projection and datum in PROJ4 format }
   \item{readfromdisk}{Logical. If \code{TRUE} then data are read from disk (if available) to determine the min and max value}
+  \item{adjustBbox}{}
 }
 
 \details{