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

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

Author: jacobvanetten
Date: 2009-01-27 14:10:16 +0100 (Tue, 27 Jan 2009)
New Revision: 194

Added:
   pkg/raster/man/distance2.Rd
Modified:
   pkg/raster/R/distance.R
Log:
distance signature = RasterLayer added

Modified: pkg/raster/R/distance.R
===================================================================
--- pkg/raster/R/distance.R	2009-01-27 09:33:01 UTC (rev 193)
+++ pkg/raster/R/distance.R	2009-01-27 13:10:16 UTC (rev 194)
@@ -4,6 +4,10 @@
 # Version 0,7
 # Licence GPL v3
 
+#should become methods of generic "distance"
+#... could become the method to distinguish between Euclidean and great circle distances. 
+#Methods should be defined for four column matrices, two column matrices (all combinations, resulting in a dist object) and SpatialPoints 
+
 distanceEuclidean <- function (point1, point2) {
 	if (length(point1) == 2) {
 		x1 <- point1[1]
@@ -53,3 +57,53 @@
 	return(distance)
 }
 
+# Author: Jacob van Etten jacobvanetten at yahoo.com
+# International Rice Research Institute
+# Date :  January 2009
+# Version 1.0
+# Licence GPL v3
+
+setGeneric("distance", function(object, ...) standardGeneric("distance"))
+
+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)
+		if (isLatLon(object))
+		{
+			while(length(toCells)>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)]
+			}
+		}
+		if (!(isLatLon(object)))
+		{
+			while(length(toCells)>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])))
+				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)]
+			}
+		}
+		result <- object
+		result <- setValues(result, accDist)	
+		return(result)
+	}
+)

Added: pkg/raster/man/distance2.Rd
===================================================================
--- pkg/raster/man/distance2.Rd	                        (rev 0)
+++ pkg/raster/man/distance2.Rd	2009-01-27 13:10:16 UTC (rev 194)
@@ -0,0 +1,23 @@
+\name{distance-methods}
+\docType{methods}
+\alias{distance-methods}
+\alias{distance,RasterLayer-method}
+\title{ Calculate distance}
+\description{
+ ~~ Methods for function \code{distance}  ~~
+}
+\section{Methods}{
+\describe{
+
+\item{raster = "RasterLayer"}{ ~~describe this method here }
+}}
+\examples{
+r1 <- newRaster(ncol=36,nrow=18)
+data <- rep(NA, times=ncell(r1))
+data[345:355] <- 1
+r1 <- setValues(r1,data)
+distmap <- distance(r1)
+map(distmap)
+}
+\keyword{methods}
+\keyword{spatial}