Neighborhood functions.R

# Code to specify neighborhoods and apply functions to them.
# Professor Bear Braumoeller, Department of Political Science, Ohio State

# This code sets up a 100x100 grid, implemented as a matrix, 
# and creates functions to do three things:
# 1. return the values from a neighborhood of cells around cell (row,col)
# within a specified radius r
# 2. return the coordinates of the cells with the highest value in that 
# neighborhood
# 3. return the coordinates of the closest cell with the highest value in
# that neighborhood, randomizing in the event of a tie
# The world is assumed NOT to wrap around.
# These functions can be useful when an agent has to search nearby cells 
# and identify the one with the highest value (e.g. the search for more
# productive terrain in a sugarscape model).


# Set up a 100x100 sugarscape 
dim <- 100
foo <- matrix(rep(0, dim^2), nrow=dim, byrow=TRUE)

# Fill in higher sugar values using a couple of quickly hacked functions
foo[abs(row(foo)-col(foo)) < (50-(0.01*row(foo)*col(foo)))] <- 1
foo[abs((dim-row(foo)+1)-(dim-col(foo)+1)) < (50-(0.01*(dim-row(foo)+1)*(dim-col(foo)+1)))] <- 1
foo[((row(foo)-25)^2)+((col(foo)-25)^2) < 500] <- 2
foo[((row(foo)-25)^2)+((col(foo)-25)^2) < 250] <- 3
foo[((row(foo)-25)^2)+((col(foo)-25)^2) < 100] <- 4
foo[((row(foo)-75)^2)+((col(foo)-75)^2) < 500] <- 2
foo[((row(foo)-75)^2)+((col(foo)-75)^2) < 250] <- 3
foo[((row(foo)-75)^2)+((col(foo)-75)^2) < 100] <- 4
image(foo, useRaster=TRUE, axes=FALSE, col=four.col(5))


# Function to return values from a neighborhood of cells
neighbors <- function(mat,row,col,radius){
	rowmin <- max(row-radius, 1)
	rowmax <- min(row+radius, length(mat[,1]))
	colmin <- max(col-radius, 1)
	colmax <- min(col+radius, length(mat[1,]))
	mat[rowmin:rowmax, colmin:colmax]
}

# Function to find coordinates for cells with highest value in a neighborhood
neighbors.max <- function(mat,row,col,radius){
	rowmin <- max(row-radius, 1)
	rowmax <- min(row+radius, length(mat[,1]))
	colmin <- max(col-radius, 1)
	colmax <- min(col+radius, length(mat[1,]))
	(which(mat[rowmin:rowmax, colmin:colmax] == max(mat[rowmin:rowmax, colmin:colmax]), arr.ind = TRUE)) + c(rowmin-1, colmin-1)
}

# Function to find coordinates for nearest highest-valued cell in a
# neighborhood, randomizing in the event of ties
nearest.neighbor.loc <- function(mat, row, col, radius){
	nmaxmat <- neighbors.max(mat, row, col, radius)
	distmat <- t(abs(t(nmaxmat)-c(row,col)))
	shortest.mat <- matrix(nmaxmat[rowSums(distmat)==min(rowSums(distmat)),], ncol=2)
	shortest.mat[sample(nrow(shortest.mat), 1),]
}

# A few sample commands to show how this all works
foo[38:42,6:10]
neighbors.max(foo, 40, 8, 2)
nearest.neighbor.loc(foo, 40, 8, 2)


# ---------(experimental)

# Set up 50x50 two-dimensional list filled with random numbers ~ N(0,1)
dim <- 50
foo.list <- as.list(rnorm(dim^2))
dim(foo.list) <- c(dim,dim)

# The neighbors function above works with two-dimensional lists without modification.

# The neighbors.max function doesn't, so we need to rewrite it slightly.

# Function to find coordinates for cell with highest value in a neighborhood
neighbors.list.max <- function(lst,row,col,radius){
	rowmin <- max(row-radius, 1)
	rowmax <- min(row+radius, length(lst[,1]))
	colmin <- max(col-radius, 1)
	colmax <- min(col+radius, length(lst[1,]))
	(which(lst[rowmin:rowmax, colmin:colmax] == unlist(lst[rowmin:rowmax, colmin:colmax][which.max(lst[rowmin:rowmax, colmin:colmax])]), arr.ind = TRUE)) + c(rowmin-1, colmin-1)
}

# A few commands to show how the functions work
foo.list[1:6,1:6]
neighbors(foo.list, 4, 1, 2)
neighbors.list.max(foo.list, 4, 1, 2)
unlist(foo.list[neighbors.list.max(foo.list, 4, 1, 2)])