Skip to content

Instantly share code, notes, and snippets.

@mrecos
Last active April 12, 2020 02:23
Show Gist options
  • Save mrecos/f1dd8bec653601d8f32e to your computer and use it in GitHub Desktop.
Save mrecos/f1dd8bec653601d8f32e to your computer and use it in GitHub Desktop.
John Ramey's (@ramhiser) implementation for Conway's Game of Life, but updated for gganimate package and adding the undead cells
library('foreach')
library('ggplot2')
library('gganimate')
# library('animation') # require for original code
library('reshape2')
library('doParallel') # for multicore support
## Guts and working concept from post below.
## http://johnramey.net/blog/2011/06/05/conways-game-of-life-in-r-with-ggplot2-and-animation/#comments
## I updated ggplot, melt, varnames, gganimate, and faded cells
# original function from John Ramey
# Determines how many neighboring cells around the (j,k)th cell have living organisms.
# The conditionals are used to check if we are at a boundary of the grid.
how_many_neighbors <- function(grid, j, k) {
size <- nrow(grid)
count <- 0
if(j > 1) {
count <- count + grid[j-1, k]
if (k > 1) count <- count + grid[j-1, k-1]
if (k < size) count <- count + grid[j-1, k+1]
}
if(j < size) {
count <- count + grid[j+1,k]
if (k > 1) count <- count + grid[j+1, k-1]
if (k < size) count <- count + grid[j+1, k+1]
}
if(k > 1) count <- count + grid[j, k-1]
if(k < size) count <- count + grid[j, k+1]
count
}
# original function from John Ramey
# Creates a list of matrices, each of which is an iteration of the Game of Life.
# Arguments
# size: the edge length of the square
# prob: a vector (of length 2) that gives probability of death and life respectively for initial config
# returns a list of grids (matrices)
game_of_life <- function(size = 10, num_reps = 50, prob = c(0.5, 0.5)) {
grid <- list()
grid[[1]] <- replicate(size, sample(c(0,1), size, replace = TRUE, prob = prob))
dev_null <- foreach(i = seq_len(num_reps) + 1) %do% {
grid[[i]] <- grid[[i-1]]
foreach(j = seq_len(size)) %:%
foreach(k = seq_len(size)) %do% {
# Apply game rules.
num_neighbors <- how_many_neighbors(grid[[i]], j, k)
alive <- grid[[i]][j,k] == 1
if(alive && num_neighbors <= 1) grid[[i]][j,k] <- 0
if(alive && num_neighbors >= 4) grid[[i]][j,k] <- 0
if(!alive && num_neighbors == 3) grid[[i]][j,k] <- 1
}
}
names(grid) <- seq_along(1:(num_reps+1))
grid
}
######## Format for gganimate #################
# Permute matrix from John Ramey
# I added generation so that gganimiate can make frames
# moved plot & animate code out for more flexibility
grid_to_ggplot_df <- function(gen_grid, generation) {
# Permutes the matrix so that melt labels this correctly.
# flips grid vertically [10,1] becomes [1,1] on a 10x10 grid
grid <- gen_grid[seq.int(nrow(gen_grid), 1), ]
grid <- reshape2::melt(grid)
grid$generation <- as.numeric(generation)
grid$value <- factor(ifelse(grid$value, "Alive", "Dead"))
return(grid)
}
############# GOL ZOMBIES!!! ###################
# new function
# takes dataframe from grid_to_ggplot_df
# if cell lived in previous generation, but is now "dead",
# it's "life" is decreased by the zombie_rate
zombie_life <- function(gol, zombie_rate = 0.1){
gol$value <- ifelse(gol$value == "Alive", 1, 0)
generations <- max(gol$generation)
gen_1 <- gol[which(gol$generation == 1),"value"]
value_zombie <- NULL
gen_i <- gen_1
for(i in seq_along(1:generations)){
gen_ii <- gol[which(gol$generation == i+1),"value"]
gen_ii_z <- ifelse(gen_i > gen_ii, gen_i - zombie_rate, gen_ii)
gen_ii_z <- ifelse(gen_ii_z < 0, 0, gen_ii_z)
value_zombie <- c(value_zombie, gen_ii_z)
gen_i <- gen_ii_z
}
walkers <- c(gen_1, value_zombie)
gol$value <- walkers
return(gol)
}
#######################################################
### For multicore support ####
registerDoParallel(4) # number of cores to use for creating GOL grids
##############################
# make GOL grids from John's code
# adjust grid size, number of animation frames, and probability of life and death
# prob does not have to equal one
game_grids <- game_of_life(size = 10, num_reps = 100, prob = c(0.1, 0.1))
# I use MAP to iterate through the grids and prep for gglot
gol_melt <- Map(grid_to_ggplot_df, game_grids, names(game_grids))
# rbind list of grids for plotting
gol_melt <- do.call(rbind, gol_melt)
# ggplot2 code with frame used from gganimate package
# adjust colors and animate interval
p <- ggplot(gol_melt, aes(x=Var1, y=Var2, z = value, color = value)) +
geom_tile(aes(fill = value), colour = "white") +
scale_fill_manual(values = c("Dead" = "gray95", "Alive" = "gray5")) +
theme_void() +
coord_equal() +
theme(legend.position = "none")
anim_p <- p +
transition_states(generation,
transition_length = 2,
state_length = 1)
# render as mp4
animate(anim_p, renderer = av_renderer())
# for Game of Zombies, use this to pass a melted grid to add the undead
# adjust zombie_rate
gol_melting_face <- zombie_life(gol_melt, zombie_rate = 0.5)
# similar plot as above, but color options changes and tile fill is a factor
p <- ggplot(gol_melting_face, aes(x=Var1, y=Var2, z = value, color = value, frame = generation)) +
geom_tile(aes(fill = as.factor(value)), colour = "white") +
scale_fill_brewer(palette = "PuBu") +
theme_void() +
coord_equal() +
theme(legend.position = "none")
anim_p <- p +
transition_states(generation,
transition_length = 2,
state_length = 1)
# render as mp4
animate(anim_p, renderer = av_renderer())
# other original function form John Ramey, not used here
# Converts the current grid (matrix) to a ggplot2 image
# grid_to_ggplot <- function(grid, col_alive = "black", col_dead = "white") {
# # Permutes the matrix so that melt labels this correctly.
# grid <- grid[seq.int(nrow(grid), 1), ]
# grid <- reshape2::melt(grid)
# grid$value <- factor(ifelse(grid$value, "Alive", "Dead"))
# p <- ggplot(grid, aes(x=Var1, y=Var2, z = value, color = value))
# p <- p + geom_tile(aes(fill = value), colour = "white")
# p <- p + scale_fill_manual(values = c("Dead" = col_dead, "Alive" = col_alive))
# p <- p + theme_void()
# p <- p + theme(legend.position = "none")
# }
# original calls for form John Ramey, not used here
# game_grids <- game_of_life(size = 10, num_reps = 5, prob = c(1, 1))
# grid_ggplot <- lapply(game_grids, grid_to_ggplot)
# saveGIF(lapply(grid_ggplot, print), clean = TRUE)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment