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

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

Author: rhijmans
Date: 2009-03-07 10:20:02 +0100 (Sat, 07 Mar 2009)
New Revision: 320

Modified:
   pkg/raster/R/bilinearValue.R
   pkg/raster/man/resample.Rd
Log:


Modified: pkg/raster/R/bilinearValue.R
===================================================================
--- pkg/raster/R/bilinearValue.R	2009-03-07 08:24:49 UTC (rev 319)
+++ pkg/raster/R/bilinearValue.R	2009-03-07 09:20:02 UTC (rev 320)
@@ -1,4 +1,10 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date :  March  2009
+# Version 0.8
+# Licence GPL v3
 
+
 .fourCellsFromXY <- function(raster, xy) {
 	cells <- cellFromXY(raster, xy)
 	row <- rowFromCell(raster, cells)
@@ -8,23 +14,32 @@
 	pos <- matrix(-1, ncol=ncol(xy), nrow=nrow(xy))
 	pos[xy[,1] > cellsXY[,1]] <- 1
 	pos[xy[,2] < cellsXY[,2]] <- 1
+
+	poscol <- col + pos[,1]
+	poscol[poscol==0] <- 2
+	poscol[poscol==nrow(raster)+1] <- nrow(raster) - 1
+	posrow <- row + pos[,2]
+	posrow[posrow==0] <- 2
+	posrow[posrow==ncol(raster)+1] <- ncol(raster) - 1
 	
+	
 	four <- matrix(ncol=4, nrow=nrow(xy))
 	four[,1] <- cells
-	four[,2] <- cellFromRowCol(raster, row + pos[,2], col)
-	four[,3] <- cellFromRowCol(raster, row + pos[,2], col + pos[,1])
-	four[,4] <- cellFromRowCol(raster, row, col + pos[,1])
+	four[,2] <- cellFromRowCol(raster, posrow, col)
+	four[,3] <- cellFromRowCol(raster, posrow, poscol)
+	four[,4] <- cellFromRowCol(raster, row, poscol)
 		
-	four[is.na(four)] <- rep(four[,1], 4)[is.na(four)]
+	#four[is.na(four)] <- rep(four[,1], 4)[is.na(four)]
 	return(four)
 }
 
 
 .bilinear <- function(x,y, x1,x2,y1,y2, q11,q12,q21,q22) {
 	div <- (x2-x1)*(y2-y1)
-	if (all(div>0)) {
+	if (all(div > 0)) {
 		return( (q11/div)*(x2-x)*(y2-y) + (q21/div)*(x-x1)*(y2-y) + (q12/div)*(x2-x)*(y-y1) + (q22/div)*(x-x1)*(y-y1) )
 	} else {
+		print('it happend')
 		bil <- vector(length=length(div))
 		bil[div>0] <- (q11/div)*(x2-x)*(y2-y) + (q21/div)*(x-x1)*(y2-y) + (q12/div)*(x2-x)*(y-y1) + (q22/div)*(x-x1)*(y-y1) 
 		bil[(x1==x2 && y1==y2)] <- q11

Modified: pkg/raster/man/resample.Rd
===================================================================
--- pkg/raster/man/resample.Rd	2009-03-07 08:24:49 UTC (rev 319)
+++ pkg/raster/man/resample.Rd	2009-03-07 09:20:02 UTC (rev 320)
@@ -39,10 +39,14 @@
 
 
 \examples{
-r1 <- raster()
-r1[] <- 1:ncell(r1)
-r2 <- raster(xmn=-60.5, xmx=59.5, ymn=-30.5, ymx=29.5, nrow=15, ncol=30)
-s <- resample(r1, r2)
+r <- raster(4, 4)
+r[] <- 1:ncell(r)
+r2 <- raster(40, 40)
+s <- resample(r, r2, method='bilinear')
+#plot(r)
+#x11()
+#plot(s)
+
 }
 
 \keyword{spatial}