R help - Apr 2004 - Spatial Voter Model

Has anyone coded (in R) a spatial voter model with mutation (e.g., 
Kimura and Weiss 1964, Holley and Liggett 1975, Durrett and Levin 
1996)? In principle, it is quite straightforward, but useful 
simulations require many many iterations, making my "straightforward" 
version too time intensive. I am happy to share my version (without 
mutation, below), for what it is worth.

Thank you in advance,
Hank Stevens

# Voter model with no mutation in a square grid of size L^2
L = 50 #Dimension of square matrix (L=10^ or 10^4 would be nice...)
S = 2 # Number of species
loc=c(L,1:L,1) # possible neighbor locations
replacements = L^2 * 10 # iterations (hundreds * L^2  would be nice)
Lat <- matrix(sample(1:S,L^2, replace=TRUE),nrow=L) #Make an arena L X L
Lat0 <- Lat # Save original arena

   # select random rows where number of reps = number of cells in arena
   # and same for columns
ri <- sample(1:L, replacements, replace=TRUE)
rj <- sample(1:L, replacements, replace=TRUE)

#implement a voter model where each cell takes on the value of a 
randomly selected individual around it.

for(i in 1:replacements) Lat[ri[i],rj[i]] <- 
sample(c(Lat[loc[ri[i]],loc[rj[i]+1]],
                                                       
Lat[loc[ri[i]+1],loc[rj[i]+2]],
                                                       
Lat[loc[ri[i]+2],loc[rj[i]+1]],
                                                       
Lat[loc[ri[i]+1],loc[rj[i]]]), 1)

# Calculate Simpon's Diversity (Nei genetic heterozygozity)
1 - sum( (table(Lat0)/sum(table(Lat0)))^2)
1 - sum( (table(Lat)/sum(table(Lat)))^2)
layout(matrix(1:2, nrow=1)) # plot arenas
plot(rep(1:L,each=L),rep(1:L,L),col=c(Lat0),pch=20)
plot(rep(1:L,each=L),rep(1:L,L),col=c(Lat),pch=20)

Dr. Martin Henry H. Stevens, Assistant Professor
338 Pearson Hall
Botany Department
Miami University
Oxford, OH 45056

Office: (513) 529-4206
Lab: (513) 529-4262
FAX: (513) 529-4243
http://www.cas.muohio.edu/botany/bot/henry.html
http://www.muohio.edu/ecology/
http://www.muohio.edu/botany/

On Fri, Apr 16, 2004 at 04:35:15PM -0400, Martin Henry H. Stevens wrote:
>   # select random rows where number of reps = number of cells in arena
>   # and same for columns
> ri <- sample(1:L, replacements, replace=TRUE)
> rj <- sample(1:L, replacements, replace=TRUE)
> 
> #implement a voter model where each cell takes on the value of a 
> randomly selected individual around it.
> 
> for(i in 1:replacements) Lat[ri[i],rj[i]] <- 
> sample(c(Lat[loc[ri[i]],loc[rj[i]+1]],
>                                                       
> Lat[loc[ri[i]+1],loc[rj[i]+2]],
>                                                       
> Lat[loc[ri[i]+2],loc[rj[i]+1]],
>                                                       
> Lat[loc[ri[i]+1],loc[rj[i]]]), 1)
I don't think that you need a loop for this.  Look at the help page of
the [ operatot (type ?"[" at the prompt).  You need something like
this:

## this gives you a row & column index matrix (elements to replace)
r <- matrix(sample(1:L, 2*replacements, replact=TRUE), replacements, 2)

## offset matrix - you only need to create this once
roff <- matrix(c(0,1,
		 1,2,
		 2,1,
		 1,1), 4, 2, byrow=TRUE)

## make random neighbor offset selection
n <- sample(1:nrow(roff), replacements, replace=TRUE)

## row & column offsets
roffij <- t(sapply(n, function (i) { roff[i,1:2] }))

## replace elements
Lat[r] <- Lat[r + roffij]

I haven't tested this, please check everything, and look at the help
pages for further information.
> # Calculate Simpon's Diversity (Nei genetic heterozygozity)
> 1 - sum( (table(Lat0)/sum(table(Lat0)))^2)
> 1 - sum( (table(Lat)/sum(table(Lat)))^2)
You might be able to speed this up by writing some C code, and calling
it in R.  It is only worth it if you have large matrices, and use this
kind of thing really often (and you can program C).  Maybe somebody
has a better suggestion.

Best,

Tamas

-- 
Tam??s K. Papp
E-mail: tpapp at axelero.hu
Please try to send only (latin-2) plain text, not HTML or other garbage.