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

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

Author: jacobvanetten
Date: 2009-01-13 08:53:54 +0100 (Tue, 13 Jan 2009)
New Revision: 129

Modified:
   pkg/raster/R/adjacency.R
   pkg/raster/man/adjacency.Rd
Log:
added adjBishop

Modified: pkg/raster/R/adjacency.R
===================================================================
--- pkg/raster/R/adjacency.R	2009-01-13 07:07:05 UTC (rev 128)
+++ pkg/raster/R/adjacency.R	2009-01-13 07:53:54 UTC (rev 129)
@@ -231,4 +231,60 @@
 	else{}
 	colnames(fromto) <- c("from","to")
 	return(fromto)
-}
\ No newline at end of file
+}
+
+adjBishop <- function(raster, fromCells, toCells, outerMeridianConnect)
+{
+	nCols <- ncol(raster)
+	nCells <- ncells(raster)
+	
+	left <- seq(nCols+1,(nCells-2*nCols+1),by=nCols) 
+	right <- seq(2*nCols,nCells-nCols,by=nCols)
+	upper <- 2:(nCols-1)
+	lower <- seq((nCells-nCols+2),(nCells-1),by=1)
+	upperleft <- 1
+	upperright <- nCols
+	lowerleft <- nCells-nCols+1
+	lowerright <- nCells
+
+	fromCellsCore <- as.integer(setdiff(fromCells,(c(left,right,upper,lower,upperleft,upperright,lowerleft,lowerright))))
+	fromCellsUpper <- as.integer(intersect(fromCells,upper))
+	fromCellsLower <- as.integer(intersect(fromCells,lower))
+	fromCellsLeft <- as.integer(intersect(fromCells,left))
+	fromCellsRight <- as.integer(intersect(fromCells,right))
+	fromCellUpperleft <- as.integer(intersect(fromCells,upperleft))
+	fromCellUpperright <- as.integer(intersect(fromCells,upperright))
+	fromCellLowerleft <- as.integer(intersect(fromCells,lowerleft))
+	fromCellLowerright <- as.integer(intersect(fromCells,lowerright))
+	
+	bishop <- as.integer(c(-nCols-1, -nCols+1, nCols-1,+nCols+1))
+		
+	coreFromToBishop <- .cs(fromCellsCore,bishop)
+	upperFromToBishop <- .cs(fromCellsUpper,bishop[3:4])
+	lowerFromToBishop <- .cs(fromCellsLower,bishop[1:2])
+	leftFromToBishop <- .cs(fromCellsLeft,bishop[c(2,4)])
+	rightFromToBishop <- .cs(fromCellsRight,bishop[c(1,3)])
+	upperleftFromToBishop <- .cs(fromCellUpperleft,bishop[4])
+	upperrightFromToBishop <- .cs(fromCellUpperright,bishop[3])
+	lowerleftFromToBishop <- .cs(fromCellLowerleft,bishop[2])
+	lowerrightFromToBishop <- .cs(fromCellLowerright,bishop[1])
+
+	fromto <- rbind(coreFromToBishop,upperFromToBishop,lowerFromToBishop,leftFromToBishop,rightFromToBishop,upperleftFromToBishop,upperrightFromToBishop,lowerleftFromToBishop,lowerrightFromToBishop)
+	
+	if (outerMeridianConnect) 
+	{
+		meridianFromLeft <- rbind(
+			.cs(fromCellsLeft,c(2*nCols-1,-1)),
+			cbind(fromCellUpperleft,as.integer(fromCellUpperleft+2*nCols-1)),
+			cbind(fromCellLowerleft,as.integer(fromCellLowerleft-1))
+			) 
+		meridianFromRight <- rbind(
+			cbind(rep(fromCellsRight,times=2),as.integer(c(fromCellsRight-2*nCols+1,fromCellsRight+1))),
+			cbind(fromCellUpperright,as.integer(fromCellUpperright+1)),
+			cbind(fromCellLowerright,as.integer(fromCellLowerright-2*nCols+1))
+			)
+		fromto <- rbind(fromto,meridianFromLeft,meridianFromRight)
+	}
+	else{}
+	fromto <- subset(fromto,fromto[,2] %in% toCells)
+}

Modified: pkg/raster/man/adjacency.Rd
===================================================================
--- pkg/raster/man/adjacency.Rd	2009-01-13 07:07:05 UTC (rev 128)
+++ pkg/raster/man/adjacency.Rd	2009-01-13 07:53:54 UTC (rev 129)
@@ -1,5 +1,6 @@
 \name{adjacency}
 \alias{adjacency}
+\alias{adjBishop}
 
 \title{ adjacency }
 \description{
@@ -7,6 +8,7 @@
 }
 \usage{
 adjacency(raster, fromCells, toCells, directions, outerMeridianConnect) 
+adjBishop(raster, fromCells, toCells, outerMeridianConnect)
 }
 
 \arguments{
@@ -20,6 +22,7 @@
 \details{
 Cell numbers start with 1 in the upperleft corner and increase from left to right and from top to bottom.
 Number of directions: 4 connects cells with one-cell rook moves, 8 with one-cell queen moves, and 16 with knight and one-cell queen moves.
+For one-cell bishop moves use adjBishop (special cases).
 }
 
 \value{
@@ -30,6 +33,7 @@
 \examples{
 	rs <- newRaster(nrows=10, ncols=10)
 	adjacency(raster = rs, fromCells = c(1,30,55,72,100), toCells = c(1:ncells(rs)), directions=16, outerMeridianConnect = TRUE) 
+	adjBishop(raster = rs, fromCells = c(1,30,55,72,100), toCells = c(1:ncells(rs)), outerMeridianConnect = TRUE) 
 }
 
 \keyword{ spatial }
\ No newline at end of file