SNAP - Sociospatial Network Analysis Package

##' Berlaz's heuristic algorithm for graph vertex coloring.
##'
##' Berlaz's heuristic algorithm for graph vertex coloring.
##'
##' @title Berlaz.Coloring
##' @param ngbrObj an object returned by poly2nb function in spdep package
##' @param inCols a vector of base colors, at least four. It will be recycled if the number is not big enough. If NULL, a series of indices will be returned.
##' @param startNodeIndex the polygon ID used to start/initialize the iteration
##' @param withRandom how to break tie when multiple nodes/vertices are available for next step. If FALSE, the first ourance will be used.
##' @return A vector of colors or indicies for all objects in ngbrObj.
##' @export
##' @references \url{http://sunsp.net}
##' @examples
##' rsltShpData <- readShapePoly(shpFileName)
##' spatialNght <- poly2nb(rsltShpData)
##' polyCols <- Berlaz.Coloring(spatialNght, cols)
##' plot(rsltShpData,col=polyCols)
##' @author Shipeng Sun
Berlaz.Coloring <- function(ngbrObj, inCols = NULL, startNodeIndex = 1, withRandom = F) {

	numNode <- length(ngbrObj) # the number of nodes/vertices
	nodeIndex <- seq(1, numNode)
	colIndex <- rep(0,numNode) # the vector used to save the index of assigned colors
	nodeIndex <- seq(1, numNode)

	colIndex[startNodeIndex] = 1
	coloredNgbrNum <- rep(0,numNode)
	nodeDegree <- rep(0,numNode)

	for(d in 1:numNode) {
		if(ngbrObj[[d]][1] > 0) {
			nodeDegree[d] = length(ngbrObj[[d]])
		}
	}

	colIndex[nodeDegree == 0] <- 1

	while(min(colIndex) == 0) {
		# get the nodes/vertices with maximum colored neighbors
		for(i in 1:numNode) {
			if(ngbrObj[[i]][1] > 0) {
				coloredNgbrNum[i] = length(ngbrObj[[i]][colIndex[ngbrObj[[i]]] > 0])
			}
		}

		#coloredNgbrNum == max(coloredNgbrNum)
		maxColoredNghbrsIndex = nodeIndex[coloredNgbrNum == max(coloredNgbrNum[colIndex <= 0]) & colIndex <= 0]
		# get the one with the maximum degree
		chosenIndex = maxColoredNghbrsIndex[nodeDegree[maxColoredNghbrsIndex] == max(nodeDegree[maxColoredNghbrsIndex])]

		# use the first one or randomly choose one
		if(withRandom) {
			nextIndex = chosenIndex[which.max(runif(length(chosenIndex)))]
		} else
		{
			nextIndex = chosenIndex[1]
		}

		# Get a color for this "nextIndex"
		ngbrCols <- c(0)
		for(j in 1:nodeDegree[nextIndex]) {
			ngbrCols <- cbind(ngbrCols, colIndex[ngbrObj[[nextIndex]][j]])
		}

		usedCols <- sort(unique(ngbrCols[ngbrCols > 0]))

		colIndex[nextIndex] = 1
		if(length(usedCols) <= 0) next

		for(k in 1:length(usedCols)) {
			if(usedCols[k] == colIndex[nextIndex])
			{
				colIndex[nextIndex] = k + 1

			} else
			{
				break
			}
		}

	}

	if(is.null(inCols)) {
		return(colIndex)
	} else
	{
		numCols = length(unique(colIndex))
		inCols <- rep(inCols, ceiling(numCols/length(inCols)))
		return(inCols[colIndex])
	}
}

# This page is rendered by SyntaxHighlighter at http://alexgorbatchev.com/SyntaxHighlighter/