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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jan 28 06:59:42 CET 2009


Author: jacobvanetten
Date: 2009-01-28 06:59:38 +0100 (Wed, 28 Jan 2009)
New Revision: 199

Modified:
   pkg/raster/R/distance.R
Log:
distance error

Modified: pkg/raster/R/distance.R
===================================================================
--- pkg/raster/R/distance.R	2009-01-28 03:50:43 UTC (rev 198)
+++ pkg/raster/R/distance.R	2009-01-28 05:59:38 UTC (rev 199)
@@ -6,37 +6,39 @@
 
 setGeneric("distance", function(object, ...) standardGeneric("distance"))
 
-setMethod("distance", signature(object = "RasterLayer"), def = 
-	function(object) {
+setMethod("distance", signature(object = "RasterLayer"), def =	function(object) {
 		n <- ncell(object)
 		fromCells <- which(!is.na(values(object)))
 		toCells <- which(is.na(values(object)))
 		accDist <- rep(0,times=n)
+		accDist[toCells] <- Inf
 		if (isLatLon(object)) {
-			while(length(toCells)>0)
+			while(length(fromCells)>0)
 			{			
 				adj <- adjacency(object,fromCells=fromCells,toCells=toCells,directions=8)
 				coord <- cbind(xyFromCell(object,adj[,1]),xyFromCell(object,adj[,2]))
 				distance <- apply(coord,1,function(x){distanceGreatcircle(x[1:2],x[3:4])})
+				
 				transitionValues <- accDist[adj[,1]] + distance
 				transitionValues <- tapply(transitionValues,adj[,2],min)
 				transitionValues <- transitionValues[transitionValues < Inf]
-				fromCells <- as.integer(names(transitionValues))
-				accDist[fromCells] <- transitionValues 
-				toCells <- toCells[!(toCells %in% fromCells)]
+				index <- as.integer(names(transitionValues))
+				fromCells <- index[transitionValues < accDist[index]]
+				accDist[index] <- pmin(transitionValues,accDist[index])
 			}
 		} else {
-			while(length(toCells)>0) {			
+			while(length(fromCells)>0) {			
 				adj1 <- adjacency(object,fromCells=fromCells,toCells=toCells,directions=4)
 				adj2 <- adjacency(object,fromCells=fromCells,toCells=toCells,directions="Bishop")
-				distance <- c(rep(1,length=length(adj1[,1])),rep(sqrt(2),length=length(adj1[,1])))
+				distance <- c(rep(1,length=length(adj1[,1])),rep(sqrt(2),length=length(adj2[,1])))
 				adj <- rbind(adj1,adj2)
+				
 				transitionValues <- accDist[adj[,1]] + distance
 				transitionValues <- tapply(transitionValues,adj[,2],min)
 				transitionValues <- transitionValues[transitionValues < Inf]
-				fromCells <- as.integer(names(transitionValues))
-				accDist[fromCells] <- transitionValues 
-				toCells <- toCells[!(toCells %in% fromCells)]
+				index <- as.integer(names(transitionValues))
+				fromCells <- index[transitionValues < accDist[index]]
+				accDist[index] <- pmin(transitionValues,accDist[index])
 			}
 		}
 		result <- object



More information about the Raster-commits mailing list