Skip to content

Instantly share code, notes, and snippets.

@bryangoodrich
Last active September 9, 2016 15:01
Show Gist options
  • Save bryangoodrich/8361321 to your computer and use it in GitHub Desktop.
Save bryangoodrich/8361321 to your computer and use it in GitHub Desktop.
I want to play a game ... Conway's Game of Life! For explanation, see http://en.wikipedia.org/wiki/Conway's_Game_of_Life
#' Execute a round of the Game of Life
#'
#' I want to play a game. Specifically, Conway's Game of Life.
#'
#' @param x a matrix populated with 0s and 1s.
#' @param birth a vector indicating the birthing rule. Defaults to 3.
#' @param stay a vector indicating the stay alive rule Defaults to c(2,3).
#' @return a matrix representing an updated input matrix according to the rules
#' @references \url{http://en.wikipedia.org/wiki/Conway's_Game_of_Life}
#' @author Bryan Goodrich
tick <- function(x, birth = 3, stay = c(2, 3)) {
stopifnot(all(x %in% c(0,1)) || !is.null(birth) || !is.null(stay))
LIVE <- 1
DEAD <- 0
ROWSIZE <- dim(x)[1]
COLSIZE <- dim(x)[2]
# For Corner Wrapping
fixer <- function(n) {
function(x) {
b <- (x-1):(x+1)
b <- ifelse (b == 0, n, b)
b <- ifelse (b > n, 1, b)
return(b)
}
}
rule <- function(r) {
function(x) ifelse (any(x %in% r), LIVE, DEAD)
}
Rband <- fixer(ROWSIZE)
Cband <- fixer(COLSIZE)
B <- rule(birth)
SA <- rule(stay)
newx <- x
for (i in seq(ROWSIZE)) {
for (j in seq(COLSIZE)) {
window <- sum(x[Rband(i), Cband(j)])
newx[i,j] <- ifelse (x[i,j] == LIVE, SA(window-1), B(window))
}
}
newx
}
# Print function.
# -- Probably more appropriate to have tick return a classed matrix with a print/plot version here.
display_tick <- function(m, xaxt = 'n', yaxt = 'n',
col = c("blanchedalmond", "darkgreen"), ...) {
image(t(m), xaxt = xaxt, yaxt = yaxt, col = col, ...)
}
# Gosper's Glider Gun Example
glider <- matrix(inverse.rle(structure(list(lengths = c(1526L, 2L, 69L, 2L, 637L, 3L, 67L,
1L, 3L, 1L, 65L, 1L, 5L, 1L, 64L, 1L, 5L, 1L, 67L, 1L, 68L, 1L,
3L, 1L, 67L, 3L, 69L, 1L, 209L, 3L, 68L, 3L, 67L, 1L, 3L, 1L,
136L, 2L, 3L, 2L, 705L, 2L, 69L, 2L, 1527L), values = c(0, 1,
0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
0)), .Names = c("lengths", "values"), class = "rle")), ncol = 78)
m <- glider
for (n in 1:500) {
display_tick(m)
m <- tick(m)
Sys.sleep(0.01) # May not be needed for you to see it.
}
# B36/S23 "High Life" Alternative
# Set your own seed and look for Replicators!
# http://www.youtube.com/watch?v=Mw-YPFlPv2U
set.seed(666)
N <- 100
p <- 0.3
m <- sample(c(0, 1), N*N, replace = TRUE, prob = c(1-p, p))
dim(m) <- c(N, N)
for (n in 1:500) {
display_tick(m)
m <- tick(m, birth = c(3, 6))
}
@bryangoodrich
Copy link
Author

I've used filter on univariate time series for smoothing, but this does make me appreciate it in a new fashion. So on a matrix, it just treats each column as a separate series to be filtered. I used image on each of the intermediary c1, c2, ..., to see how it changed the image of the provided matrix. Very cool! I'm still planning to work on a Coursera class that did a bit of signal processing (MATLAB). That should help. Still, without working out a small sample myself (on my todo list), I've no intuition with if that slight of hand is producing the same result for each of the neighborhoods. I guess I could run a check, of course! It is way faster, though. I like this!

As for filter returning a ts matrix, you can just unclass it and it'll strip the attributes and classes associated with it, returning a vector with the appropriate dimensions (i.e., a raw matrix).

I still plan to do my C++ implementation, because I want to do something more graph and object oriented that'll be more complex (and make room for more complex games!), but this is definitely a great improvement. Thank you so much!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment