Model Thinking- Aggregation- Game of Life- Complementary Functions and Formations.

GOLextras.r

# this syntax includes 3 functions:

# GOLborderwrap(), which is a repeat from earlier GOL posts. Just give it a matrix and it'll iterate once
# for you

# Illustrate() uses GOLborderwrap() inside. Just give Illustrate() a matrix and it'll do 20 iterations
# by default. You can change that number using the 'iter' argument. Also you can change the speed using
# the 'frame.pause' argument.

# finally theres the GOLdraw() function, which is interactive. If you see a GOL pattern online or in a 
# book that you want to copy and save as a matrix, call GOLdraw() specifying 'ncol' and 'nrow' (transpose 
# them actually, sorry). Simply click cells to highlight or unhighlight them. White = dead, black alive.
# It both makes the matrix (so asign the output) and returns the syntax that it would take to make the 
# matrix directly, so you can save it in-line.

# There are also many common patterns already made (and Illustrated) for you: Blinker, Toad, Beacon, 
# Pulsar, Glider, Lightweight spaceship (LWSS), Fpentomino, Diehard, Acorn. 

# If you make a particularly complex and interesting one using e.g. GOLdraw(), please share!

# at the end there's an example of how to have some 3d fun with this


GOLborderwrap <- function(M){
	nc <- ncol(M)
	nr <- nrow(M)
	# augmented M wraps around edges to form a taurus shape-
	# i.e. a continuous world rather than dead borders.
	M.aug <- cbind(c(M[nr,nc],M[,nc],M[1,nc]),
			rbind(M[nr,],M,M[1,]),
			c(M[nr,1],M[,1],M[1,1]))
	
	# how many neighbors?:
	# left side
	M.out <-	M.aug[1:nr, 1:nc] +
			M.aug[2:(nr+1), 1:nc] +
			M.aug[3:(nr+2), 1:nc] +
			
			# middle:
			M.aug[1:nr,2:(nc+1)] +
			M.aug[3:(nr+2),2:(nc+1)] +
			
			# right:
			M.aug[1:nr,3:(nc+2)] +
			M.aug[2:(nr+1),3:(nc+2)] +
			M.aug[3:(nr+2),3:(nc+2)] 
	
	# birth and death rules:
	M[M.out > 3 | M.out < 2] <- 0
	M[M.out == 3] <- 1
	return(M)
}

Illustrate <- function(M,iter=20,frame.pause=.5){
	for (i in 1:iter){
		image(M,col=c("white","black"),useRaster=TRUE)
		M <- GOLborderwrap(M)
		Sys.sleep(frame.pause)
	}
}
# Here are some oscillating formations (ideas from wikipedia)
Blinker <- matrix(0,ncol=5,nrow=5)
Blinker[2:4,3] <- 1
Illustrate(Blinker)

Toad <- matrix(0,ncol=6,nrow=6)
Toad[3,2:4] <- 1
Toad[4,3:5] <- 1
Illustrate(Toad)

Beacon <- matrix(0,ncol=6,nrow=6)
Beacon[2:3,2:3] <- 1
Beacon[4:5,4:5] <- 1
Illustrate(Beacon)

Pulsar <- matrix(0,ncol=8,nrow=8)
Pulsar[1,2:4] <- 1
Pulsar[2:4,1] <- 1
Pulsar[6,2:4] <- 1
Pulsar[2:4,6] <- 1
Pulsar <- cbind(rbind(Pulsar[8:1,8:1],0,Pulsar[,8:1]),0,rbind(Pulsar[8:1,],0,Pulsar))
Illustrate(Pulsar)

# spaceships:
# Glider:
Glider <- matrix(0,nrow=10,ncol=10)
Glider[5,2:4] <- 1
Glider[4,4] <- 1
Glider[3,3] <- 1
Illustrate(Glider,50,.2)

# lightweight spaceship, LWSS:
LWSS <- matrix(0,15,15)
LWSS[3:5,7] <- 1
LWSS[3,4:6] <- 1
LWSS[6,6] <- 1
LWSS[4,3] <- 1
LWSS[6,3] <- 1
Illustrate(LWSS,50,.2)

# F-pentomino (mentioned in Page's video)
Fpentomino <- structure(c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 
				1, 1, 0, 0, 0, 0, 0, 0), .Dim = c(5L, 5L))
Fpentomino <- cbind(matrix(0,nrow=nrow(Fpentomino),ncol=50),Fpentomino,matrix(0,nrow=nrow(Fpentomino),ncol=50))
Fpentomino <- rbind(matrix(0,ncol=ncol(Fpentomino),nrow=50),Fpentomino,matrix(0,ncol=ncol(Fpentomino),nrow=50))
Illustrate(Fpentomino,300,.2)

# Diehard (dies after 130+1)
Diehard <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 
				1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), .Dim = c(10L, 5L))
Diehard <- cbind(matrix(0,nrow=nrow(Diehard),ncol=50),Diehard,matrix(0,nrow=nrow(Diehard),ncol=50))
Diehard <- rbind(matrix(0,ncol=ncol(Diehard),nrow=50),Diehard,matrix(0,ncol=ncol(Diehard),nrow=50))
Illustrate(Diehard,131,.2)

# Acorn
# If you want to see the entire evolution of Acorn, it'd take 5206 + 1 itartions, and you'd have to increase the size of the
# board- as it is, when it expands, things just enter from the opposite side, and when they finally collide
Acorn <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 
				0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0), .Dim = c(9L, 5L))
Acorn <- cbind(matrix(0,nrow=nrow(Acorn),ncol=50),Acorn,matrix(0,nrow=nrow(Acorn),ncol=50))
Acorn <- rbind(matrix(0,ncol=ncol(Acorn),nrow=50),Acorn,matrix(0,ncol=ncol(Acorn),nrow=50))
Illustrate(Acorn,500,.2)
# some more complex ones:
# Gosper Glider Gun
GosperGliderGun <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 
				0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 
				0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 
				0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0), .Dim = c(38L, 11L))
GosperGliderGun <- cbind(matrix(0,nrow=nrow(GosperGliderGun),ncol=150),GosperGliderGun,matrix(0,nrow=nrow(GosperGliderGun),ncol=20))
GosperGliderGun <- rbind(matrix(0,ncol=ncol(GosperGliderGun),nrow=20),GosperGliderGun,matrix(0,ncol=ncol(GosperGliderGun),nrow=150))
Illustrate(GosperGliderGun,500,.2)

# some more smaller patterns shown in wikipedia:

# BLSE10 block laying switch engine done in 10 live cells:
BLSE10 <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 
				0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0), .Dim = c(11L, 8L))
BLSE10 <- cbind(matrix(0,nrow=nrow(BLSE10),ncol=50),BLSE10,matrix(0,nrow=nrow(BLSE10),ncol=50))
BLSE10 <- rbind(matrix(0,ncol=ncol(BLSE10),nrow=50),BLSE10,matrix(0,ncol=ncol(BLSE10),nrow=50))
Illustrate(BLSE10,500,.2)

# BLSE5x5 block laying switch engine 5x5 pattern:
BLSE5x5 <- structure(c(1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 0, 
				0, 0, 0, 1, 1, 1, 0, 1), .Dim = c(5L, 5L))
BLSE5x5 <- cbind(matrix(0,nrow=nrow(BLSE5x5),ncol=50),BLSE5x5,matrix(0,nrow=nrow(BLSE5x5),ncol=50))
BLSE5x5 <- rbind(matrix(0,ncol=ncol(BLSE5x5),nrow=50),BLSE5x5,matrix(0,ncol=ncol(BLSE5x5),nrow=50))
Illustrate(BLSE5x5,500,.2)

# BLSE_2 makes 2 block laying switch engines... This one is pretty symmetric and awesome
BLSE_2 <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 
				0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 
				1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
				0, 0, 0, 0, 0, 0, 0), .Dim = c(43L, 3L))
BLSE_2 <- cbind(matrix(0,nrow=nrow(BLSE_2),ncol=50),BLSE_2,matrix(0,nrow=nrow(BLSE_2),ncol=50))
BLSE_2 <- rbind(matrix(0,ncol=ncol(BLSE_2),nrow=50),BLSE_2,matrix(0,ncol=ncol(BLSE_2),nrow=50))
Illustrate(BLSE_2,500,.2)

# ---------------------------------
# design your own, or copy patterns found elsewhere:
# function to hand-design starting formation for GOL matrices:
# sorry, but columns and rows are transposed, so bear that in mind!
# this function will return the syntax that it takes to simply create the matrix directly
# so that you can save it in-line for next time. That's how I did Fpentomino, Diehard and Acorn
# If someone does the 'Breeder', please share the syntax!
GOLdraw <- function(ncol=4,nrow=10,syntax=TRUE){
	M <- matrix(0,ncol=ncol,nrow=nrow)
	image(x=0:(nrow-1)+.5,y=0:(ncol-1)+.5,M,col=c("white"),ylim=c(0,ncol),xlim=c(0,nrow+1),asp=1,axes=F,xlab="",ylab="",
			main="Click a cell to switch it on or off\nclick outside matrix when done")
	segments(0,0:ncol,nrow,0:ncol)
	segments(0:nrow,0,0:nrow,ncol)
	
	Dot <- locator(1)
	while(Dot$x > 0 & Dot$x < nrow & Dot$y > 0 & Dot$y < ncol){
		M[ceiling(Dot$x),ceiling(Dot$y)] <- abs(M[ceiling(Dot$x),ceiling(Dot$y)]-1)
		image(x=0:(nrow-1)+.5,y=0:(ncol-1)+.5,M,col=c("white","black"),ylim=c(0,ncol),xlim=c(0,nrow+1),asp=1,axes=F,xlab="",ylab="",
				main="Click a cell to switch it on or off\nclick outside matrix when done", useRaster=TRUE)
		segments(0,0:ncol,nrow,0:ncol)
		segments(0:nrow,0,0:nrow,ncol)
		Dot <- locator(1)
	}
	dev.off()
	if (syntax) dput(M)
	return(M)
}

M <- GOLdraw()
Illustrate(M)

# made using GOLdraw:
TimsRandomClicking <- structure(c(0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 
				1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 
				0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 
				0, 0, 0, 0, 0), .Dim = c(8L, 8L))
TimsRandomClicking <- cbind(matrix(0,nrow=nrow(TimsRandomClicking),ncol=50),TimsRandomClicking,matrix(0,nrow=nrow(TimsRandomClicking),ncol=50))
TimsRandomClicking <- rbind(matrix(0,ncol=ncol(TimsRandomClicking),nrow=50),TimsRandomClicking,matrix(0,ncol=ncol(TimsRandomClicking),nrow=50))
# yay for randomness. This thing makes a bunch of gliders!
Illustrate(TimsRandomClicking,300,.2)


# and for some final fun:
# this generates a 3d array, which then plots into an rgl device as a 3d object. it lets you see the whole
# trajectory of the starting formation. replace M with any of the above, or your own starting matrix, increase
# number of iterations at will. Pretty cool:
install.packages("misc3d")
library(misc3d)
set.seed(9)
MyGolArray <- array(dim=c(100,100,100))
M <- matrix(sample(c(0,1),100,prob=c(.7,.3),replace=TRUE),ncol=10)
M <- cbind(matrix(0,nrow=nrow(M),ncol=45),M,matrix(0,nrow=nrow(M),ncol=45))
M <- rbind(matrix(0,ncol=ncol(M),nrow=45),M,matrix(0,ncol=ncol(M),nrow=45))
MyGolArray[,,1] <- M

for (i in 2:100){
	MyGolArray[,,i] <- GOLborderwrap(MyGolArray[,,(i-1)])
}
# will open special graphical device that you can rotate by clicking and dragging.
image3d(MyGolArray,col=c("white","black"),alpha=c(0,.8))