various R implementations of Conway's Game of Life

Conway-Game-of-Life-R.R

#------- inspiration: https://www.nytimes.com/2020/12/28/science/math-conway-game-of-life.html
#------- see also https://medium.com/tebs-lab/optimizing-conways-game-of-life-12f1b7f2f54c

#---- implementation 1
install.packages("fun")
library(fun)
demo("GameOfLife")

#---- implementation 2 (https://www.r-bloggers.com/2012/11/fast-conways-game-of-life-in-r/)

# library that allows the animated .gif export
install.packages("caTools")
library(caTools)

# The game.of.life() function ------------------
# Arguments:
# side - side of the game of life arena (matrix)
# steps - number of animation steps
# filename - name of the animated gif file

game.of.life <- function(side, steps, filename){
  
  # the sideXside matrix, filled up with binomially
  # distributed individuals
  X <- matrix(nrow=side, ncol=side)
  X[] <- rbinom(side^2,1,0.4)
  
  # array that stores all of the simulation steps
  # (so that it can be exported as a gif)
  storage <- array(0, c(side, side, steps))
  
  # the simulation                                             
  for (i in 1:steps)
  {
    # make the shifted copies of the original array
    allW = cbind( rep(0,side) , X[,-side] )
    allNW = rbind(rep(0,side),cbind(rep(0,side-1),X[-side,-side]))
    allN = rbind(rep(0,side),X[-side,])
    allNE = rbind(rep(0,side),cbind(X[-side,-1],rep(0,side-1)))
    allE = cbind(X[,-1],rep(0,side))
    allSE = rbind(cbind(X[-1,-1],rep(0,side-1)),rep(0,side))
    allS = rbind(X[-1,],rep(0,side))
    allSW = rbind(cbind(rep(0,side-1),X[-1,-side]),rep(0,side))
    
    # summation of the matrices
    X2 <- allW + allNW + allN + allNE + allE + allSE + allS + allSW
    
    # the rules of GoL are applied using logical subscripting
    X3 <- X
    X3[X==0 & X2==3] <- 1
    X3[X==1 & X2<2] <- 0
    X3[X==1 & X2>3] <- 0
    X <- X3
    
    # each simulation step is stored
    storage[,,i] <- X2
    # note that I am storing the array of Ni values -
    # - this is in order to make the animation prettier
  }
  
  storage <- storage/max(storage) # scaling the results
  # to a 0-1 scale
  
  # writing the results into an animated gif
  write.gif(storage, filename, col="jet", delay=5)
}

game.of.life(side = 150, steps = 300, file = "conway.gif")


#---- implementation 3 (https://win-vector.com/2018/10/28/conways-game-of-life-in-r-or-on-the-importance-of-vectorizing-your-r-code/)

#' Forward step a matrix one iteration of Conway's come of life.
#'
#' Assumes zero-padded on all sides.
#'
#' @param d a matrix of logical values
#' @return next step matrix
#'
#' @seealso \code{\link{read_cells}}, \code{\link{write_mat_region}}
#'
#'
#' @examples
#'
#' d <- matrix(data = FALSE, nrow = 10, ncol = 10)
#' glider_txt <- "
#' .O
#' ..O
#' OOO
#' "
#' glider <- read_cells(glider_txt)
#' d <- write_mat_region(d, 5, 5, glider)
#' life_step(d)
#'
#'
#' @export
#'
life_step <- function(d) {
  # form the neighboring sums
  nrow <- dim(d)[[1]]
  ncol <- dim(d)[[2]]
  d_eu <- rbind(d[-1, , drop = FALSE], 0)
  d_ed <- rbind(0, d[-nrow, , drop = FALSE])
  d_le <- cbind(d[ , -1, drop = FALSE], 0)
  d_re <- cbind(0, d[ , -ncol, drop = FALSE])
  d_lu <- cbind(d_eu[ , -1, drop = FALSE], 0)
  d_ru <- cbind(0, d_eu[ , -ncol, drop = FALSE])
  d_ld <- cbind(d_ed[ , -1, drop = FALSE], 0)
  d_rd <- cbind(0, d_ed[ , -ncol, drop = FALSE])
  pop <- d_eu + d_ed + d_le + d_re + d_lu + d_ru + d_ld + d_rd
  d <- (pop==3) | (d & (pop>=2) & (pop<=3))
  d
}


#' Read life text file format.
#'
#' Format is: rows of non-empty lines of . and O with ! headers
#'
#' @param txt incoming text as a single string
#' @return matrix
#'
#' @seealso \code{\link{life_step}}, \code{\link{write_mat_region}}
#'
#' @examples
#'
#' glider <- "
#' .O
#' ..O
#' OOO
#' "
#' read_cells(glider)
#'
#' @export
#'
read_cells <- function(txt) {
  lines <- strsplit(txt, "[\r\n]+")[[1]]
  lines <- trimws(lines, which = "both")
  lines <- lines[nchar(lines)>0]
  lines <- lines[!grepl("^!", lines)]
  nrow <- length(lines)
  ncol <- max(nchar(lines))
  d <- matrix(FALSE, nrow = nrow, ncol = ncol)
  for(i in seq_len(nrow)) {
    li <- lines[[i]]
    for(j in seq_len(nchar(li))) {
      cij <- substr(li, j, j)
      if(cij=="O") {
        d[i,j] <- TRUE
      }
    }
  }
  d
}

#' Write a region of a life board.
#'
#' @param d life board matrix
#' @param i row to start writing
#' @param j column to start writing
#' @param p pattern matrix
#'
#' @seealso \code{\link{life_step}}, \code{\link{read_cells}}
#'
#' @export
#'
write_mat_region <- function(d, i, j, p) {
  nrow <- dim(p)[[1]]
  ncol <- dim(p)[[2]]
  for(pi in seq_len(nrow)) {
    for(pj in seq_len(ncol)) {
      d[i + pi - 1, j + pj -1] <- p[pi, pj]
    }
  }
  d
}

# example 1

d <- matrix(data = FALSE, nrow = 10, ncol = 10)
glider_txt <- "
.O
..O
OOO
"
glider <- read_cells(glider_txt)
d <- write_mat_region(d, 5, 5, glider)
life_step(d)

# example 2
#library(FastBaseR)

grid_size = 200
d <- matrix(data = FALSE, nrow = grid_size, ncol = grid_size)
plt_size = 5*grid_size


glider_gun_txt <- "
! http://www.conwaylife.com/patterns/gosperglidergun.cells
!Name: Gosper glider gun
!Author: Bill Gosper
!The first known gun and the first known finite pattern with unbounded growth.
!www.conwaylife.com/wiki/index.php?title=Gosper_glider_gun
........................O
......................O.O
............OO......OO............OO
...........O...O....OO............OO
OO........O.....O...OO
OO........O...O.OO....O.O
..........O.....O.......O
...........O...O
............OO"
glider_gun <- read_cells(glider_gun_txt)

mwss_txt <- "
! http://www.conwaylife.com/patterns/mwss.cells
!Name: MWSS
!Author: John Conway
!The third most common spaceship (after the glider and lightweight spaceship).
!www.conwaylife.com/wiki/index.php?title=Middleweight_spaceship
...O
.O...O
O
O....O
OOOOO
"
mwss <- read_cells(mwss_txt)

reflector_txt <- "
! http://www.conwaylife.com/patterns/pentadecathlon.cells
!Name: Pentadecathlon
!Author: John Conway
!10 cells placed in a row evolve into this object, which is the most natural oscillator of period greater than 3. In fact, it is the fifth or sixth most common oscillator overall, being about as frequent as the clock, but much less frequent than the blinker, toad, beacon or pulsar.
!www.conwaylife.com/wiki/index.php?title=Pentadecathlon
..O....O
OO.OOOO.OO
..O....O
"
reflector <- read_cells(reflector_txt)

set.seed(3225)
for(rep in 1:10) {
  for(pat in list(glider_gun, mwss, reflector)) {
    width = max(dim(pat))
    i <- sample.int(grid_size - width, size = 1)
    j <- sample.int(grid_size - width, size = 1)
    if(runif(1)>=0.75) {
      pat <- pat[dim(pat)[[1]]:1, , drop = FALSE]
    }
    if(runif(1)>=0.75) {
      pat <- pat[, dim(pat)[[2]]:1, drop = FALSE]
    }
    if(runif(1)>=0.75) {
      pat <- t(pat)
    }
    d <- write_mat_region(d, i, j, pat)
  }
}


# https://stackoverflow.com/questions/28035831/how-to-build-a-crossword-like-plot-for-a-boolean-matrix

par(mar=rep(0, 4))
o <- cbind(c(row(d)), c(col(d))) - 1
o1 <- o[, 1]
o2 <- o[, 2]
o3 <- o[, 1] + 1
o4 <- o[, 2] + 1

dir.create("plts", showWarnings = FALSE)
for(i in seq_len(2000)) {
  fname <- paste0("plts/plt_", sprintf("%05.0f", i), ".png")
  png(fname, width = plt_size, height = plt_size, antialias = "none")
  plot.new()
  plot.window(xlim=c(0, ncol(d)), ylim=c(0, nrow(d)), asp=1)
  rect(o1, o2, o3, o4, col=t(d)[, ncol(d):1], border = FALSE)
  d <- life_step(d)
  dev.off()
}
setwd("plts")
plts <- sort(list.files(".", "^.*\\.png$"))
system2("convert", args = c(plts, c("-loop", "0", "../glider_gun2.gif")))
setwd("..")

# very slow, check out result
# https://github.com/WinVector/FastBaseR/blob/master/extras/ConwayLife/glider_gun2.gif


#---------- implementation 4 (https://www.r-bloggers.com/2011/06/conway%E2%80%99s-game-of-life-in-r-with-ggplot2-and-animation/)


library('foreach')
library('ggplot2')
library('animation')

# 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
}

# 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
      }
  }
  grid
}

# Converts the current grid (matrix) to a ggplot2 image
grid_to_ggplot <- function(grid) {
  # Permutes the matrix so that melt labels this correctly.
  grid <- grid[seq.int(nrow(grid), 1), ]
  grid <- reshape::melt(grid)
  grid$value <- factor(ifelse(grid$value, "Alive", "Dead"))
  p <- ggplot(grid, aes(x=X1, y=X2, z = value, color = value))
  p <- p + geom_tile(aes(fill = value))
  p  + scale_fill_manual(values = c("Dead" = "white", "Alive" = "black"))
}

game_grids <- game_of_life(size = 20, num_reps = 250, prob = c(0.1, 0.9))
grid_ggplot <- lapply(game_grids, grid_to_ggplot)
grid_ggplot
saveGIF(lapply(grid_ggplot, print), clean = TRUE)