Adjacent cell functions.R

# Code to create new matrix based on some function of neighbors of old matrix.
# Professor Bear Braumoeller, Department of Political Science, Ohio State

# This code sets up a 10x10 matrix and then demonstrates how to generate a second
# 10x10 matrix whose entries at (r,c) are a function of the adjacent cells of the 
# original matrix at (r,c). In this case, it's used to answer the question,
# "Which cells in this matrix have no adjacent cells with values equal to 5?"
# It can also be used for summing adjacent cells, etc., etc.
# In an agent-based model, this is one way that an agent can "look" for other
# cells that meet certain criteria.

library(compiler) # Use this to speed up clunky function at the end with nested for loops

mat.dim <- 10   # Set dimensions of (square) matrix

# Create matrix of values 1-5
foomat <- matrix(data=sample(1:5, (mat.dim*mat.dim), replace=TRUE), nrow=mat.dim, ncol=mat.dim)

# Set up lookup table of indeces; use this to wrap the matrix around.
# This avoids having to calculate new indices again and again.
look.vec <- NULL
for(i in 1:mat.dim){
	look.vec <- c(look.vec, c(mat.dim,1:mat.dim,1)[i:(i+2)])
}
look.mat <- matrix(data=look.vec, nrow=mat.dim, ncol=3, byrow=TRUE)

# So, for example, if obs is in row or column 3, relevant neighbors will be in rows or cols...
look.mat[3,]

# Sum of adjacent cells, with wraparound
# Achieved by summing values of all nine cells within a r-1:r+1, c-1:c+1 neighborhood
# and then subtracting value of cell r,c
sum.adj <- function(row,col){
	sum(foomat[look.mat[row,], look.mat[col,]])-foomat[row,col]
}
sum.adj(1,1)

# Function to flag cells that have no adjacent 5s
no.five.adj <- function(row,col){
	(sum(foomat[look.mat[row,], look.mat[col,]]==5)-(foomat[row,col]==5))==0
}

# Create a whole matrix that flags cells that have no adjacent 5s.
nofive.mat <- function(inmat){
	outmat <- matrix(data=NA, nrow=nrow(inmat), ncol=ncol(inmat))
	for(r in 1:nrow(inmat)){
		for(c in 1:ncol(inmat)){
			outmat[r,c] <- no.five.adj(r,c)
		}
	}
	outmat
}

nofive.mat.comp <- cmpfun(nofive.mat)  # Compile for better speed

nofive.mat.comp(foomat)