Last active
September 9, 2016 15:01
-
-
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
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' 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)) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
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!