[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