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

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

Author: rhijmans
Date: 2009-05-08 16:04:24 +0200 (Fri, 08 May 2009)
New Revision: 445

Modified:
   pkg/raster/R/projectRaster.R
Log:


Modified: pkg/raster/R/projectRaster.R
===================================================================
--- pkg/raster/R/projectRaster.R	2009-05-08 10:19:42 UTC (rev 444)
+++ pkg/raster/R/projectRaster.R	2009-05-08 14:04:24 UTC (rev 445)
@@ -4,11 +4,11 @@
 # Version 0.8
 # Licence GPL v3
 
-	
-.xyTransform <- function(crds, from, to) {
-# May 2009. This function was extracted from "spTransform.SpatialPoints" in the rgdal package
+
+.xyTransform <- function(crds, projfrom, projto) {
+# May 2009. This function was extracted from function "spTransform.SpatialPoints" in the rgdal package
 # Copyright (c) 2003-8 by Barry Rowlingson, Roger Bivand, and Edzer Pebesma
-	res <- .Call("transform", from, to, nrow(crds), as.double(crds[,1]), as.double(crds[,2]), PACKAGE="rgdal")
+	res <- .Call("transform", projfrom, projto, nrow(crds), as.double(crds[,1]), as.double(crds[,2]), PACKAGE="rgdal")
 	if (any(!is.finite(res[[1]])) || any(!is.finite(res[[2]]))) {
 		k <- which(!is.finite(res[[1]]) || !is.finite(res[[2]]))
 		cat("non finite transformation detected:\n")
@@ -21,10 +21,10 @@
 
 
 projectBbox <- function(object, projs) {
-	projfrom <- projection(object)
-	projto <- projection(projs)
 	validObject(projection(object, asText=FALSE))
 	validObject(projection(projs, asText=FALSE))
+	projfrom <- projection(object)
+	projto <- projection(projs)
 	b <- extent(object)
 	xy <- rbind(c(b at xmin, b at ymax), c(b at xmax, b at ymax), c(b at xmin, b at ymin), c(b at xmax, b at ymin))
 	p <- .xyTransform(xy, projfrom, projto)	
@@ -47,8 +47,7 @@
 	bb <- intersectBbox(pbb, from)
 	validObject(bb)
 
-
-	if (!method %in% c('bilinear', 'ngb')) { stop('invalid method') 	}
+	if (!method %in% c('bilinear', 'ngb')) { stop('invalid method') }
 	filename <- trim(filename)
 	to <- raster(to)
 	filename(to) <- filename
@@ -62,22 +61,22 @@
 		if (getOption('verbose')) { cat('writing raster to:', filename(to))	}
 	}
 	inMemory <- to at file@name == ""
-	v <- vector(length=0)
-
+	v <- matrix(NA, nrow=ncol(to), ncol=nrow(to))
+	
+	if (method=='ngb') {
+		xymethod <- 'simple' 
+	} else {
+		xymethod <- 'bilinear' 	
+	}
+	
 	starttime <- proc.time()
 	for (r in 1:nrow(to)) {
 		cells <- rowCells + (r-1) * ncol(to)
 		xy <- xyFromCell(to, cells)
 		unProjXY <- .xyTransform(xy, projto, projfrom)
-		
-		if (method=='ngb') {
-			vals <- xyValues(from, unProjXY)
-		} else {
-			vals <- xyValues(from, unProjXY, method='bilinear')
-		}
-
+		vals <- xyValues(from, unProjXY, method=xymethod)
 		if (inMemory) {
-			v <- c(v, vals)
+			v[,r] <- vals
 		} else {
 			to <- setValues(to, vals, r)
 			to <- writeRaster(to, overwrite=overwrite)
@@ -85,7 +84,7 @@
 		if (r %in% track) { .showTrack(r, to at nrows, track, starttime) }
 	}
 	if (inMemory) {
-		to <- setValues(to, v) 
+		to <- setValues(to, as.vector(v))
 	}
 	return(to)
 }