A New Kind of Science: The NKS Forum > Pure NKS > vba code for 256 CAs
Author
Dan Ellwein
offline
Ridgeland, MS

Registered: May 2004
Posts: 32

vba code for 256 CAs

I wrote vba (Excel) code that reproduces pages 55-56 of the NKS book...

Each rule starts with 7 different initial conditions, initial condition 2 is what is in the NKS book...

For those who are interested here is the code:

I plan (probably when I retire) on learning Mathematica so I can start writing code and transition away from vba...

Attached is the output...

c = 0
For x = 1 To 256
Range(Cells(3 + c, 2), Cells(8 + c, 7)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
Range(Cells(3 + c, 2), Cells(8 + c, 7)).Select
With Selection.Font
.Name = "Arial"
.Size = 24
End With
Range(Cells(3 + c, 2), Cells(8 + c, 7)) = x - 1
c = c + 18
Next
g9 = 0
For g7 = 0 To 1
For g6 = 0 To 1
For g5 = 0 To 1
For g4 = 0 To 1
For g3 = 0 To 1
For g2 = 0 To 1
For g1 = 0 To 1
For g0 = 0 To 1
g5c = 0
For cc = 1 To 7
Cells(1 + g9, 3 + g5c) = g7
Cells(1 + g9, 4 + g5c) = g6
Cells(1 + g9, 5 + g5c) = g5
Cells(1 + g9, 6 + g5c) = g4
Cells(1 + g9, 7 + g5c) = g3
Cells(1 + g9, 8 + g5c) = g2
Cells(1 + g9, 9 + g5c) = g1
Cells(1 + g9, 10 + g5c) = g0
If cc > 3 Then a1 = 1 Else a1 = 0
If cc = 2 Or cc = 3 Or cc = 6 Or cc = 7 Then b1 = 1 Else b1 = 0
If cc = 1 Or cc = 3 Or cc = 5 Or cc = 7 Then c1 = 1 Else c1 = 0
Cells(1 + g9, 10 + g5c + 2) = a1
Cells(1 + g9, 10 + g5c + 3) = b1
Cells(1 + g9, 10 + g5c + 4) = c1
g5c = g5c + 35
Next
g9 = g9 + 18
Next
Next
Next
Next
Next
Next
Next
Next

s = 0
For n = 1 To 256
sp = 18
sp2 = 0
For ics = 1 To 7
If ics = 1 Or ics = 3 Or ics = 5 Or ics = 7 Then Cells(1 + s, sp + 1 + sp2).Interior.ColorIndex = 48
If ics = 2 Or ics = 3 Or ics = 6 Or ics = 7 Then Cells(1 + s, sp + sp2).Interior.ColorIndex = 48
If ics > 3 Then Cells(1 + s, sp - 1 + sp2).Interior.ColorIndex = 48
a = -1
b = 1
c = 0
p1 = 1
For x = 2 + s To sp + s - 1
p1 = p1 + 1
ctr = ""
If Cells(1 + s, 10 + sp2) = 1 Then ctr = c
If Cells(1 + s, 10 + sp2) = 1 And Cells(1 + s, 3 + sp2) = 1 Then ctr = 1
For y = a To b
With Cells(x, sp + sp2 + y)
.Borders(xlEdgeLeft).LineStyle = 1
.Borders(xlEdgeTop).LineStyle = 1
.Borders(xlEdgeBottom).LineStyle = 1
.Borders(xlEdgeRight).LineStyle = 1
If ctr = 1 And y = a And p1 <> 2 Then
Cells(x - 1, sp + sp2 + y - 1).Interior.ColorIndex = 48
Cells(x - 1, sp + sp2 + y).Interior.ColorIndex = 48
End If
If Cells(x - 1, sp + sp2 + y - 1) = "" Then v1 = 0 Else v1 = 32
If Cells(x - 1, sp + sp2 + y) = "" Then v3 = 0 Else v3 = 16
If Cells(x - 1, sp + sp2 + y + 1) = "" Then v5 = 0 Else v5 = 8
If Cells(x - 1, sp + sp2 + y - 1).Interior.ColorIndex <> 48 Then v2 = 0 Else v2 = 4
If Cells(x - 1, sp + sp2 + y).Interior.ColorIndex <> 48 Then v4 = 0 Else v4 = 2
If ctr = 1 And y + 1 = b And p1 <> 2 Then
Cells(x - 1, sp + sp2 + y + 1).Interior.ColorIndex = 48
Cells(x - 1, sp + sp2 + y + 2).Interior.ColorIndex = 48
End If
If Cells(x - 1, sp + sp2 + y + 1).Interior.ColorIndex <> 48 Then v6 = 0 Else v6 = 1
T = v1 + v2 + v3 + v4 + v5 + v6
If T = 0 Or T = 8 Or T = 16 Or T = 24 Or T = 32 Or T = 40 Or T = 48 Or T = 56 Then
Cells(x, sp + sp2 + y) = 0
If Cells(1 + s, 10 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
If T = 1 Or T = 9 Or T = 17 Or T = 25 Or T = 33 Or T = 41 Or T = 49 Or T = 57 Then
If Cells(21, 19) = 9 Then MsgBox 9
Cells(x, sp + sp2 + y) = 1
If Cells(1 + s, 9 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
If T = 2 Or T = 10 Or T = 18 Or T = 26 Or T = 34 Or T = 42 Or T = 50 Or T = 58 Then
Cells(x, sp + sp2 + y) = 2
If Cells(1 + s, 8 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
If T = 3 Or T = 11 Or T = 19 Or T = 27 Or T = 35 Or T = 43 Or T = 51 Or T = 59 Then
Cells(x, sp + sp2 + y) = 3
If Cells(1 + s, 7 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
If T = 4 Or T = 12 Or T = 20 Or T = 28 Or T = 36 Or T = 44 Or T = 52 Or T = 60 Then
Cells(x, sp + sp2 + y) = 4
If Cells(1 + s, 6 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
If T = 5 Or T = 13 Or T = 21 Or T = 29 Or T = 37 Or T = 45 Or T = 53 Or T = 61 Then
Cells(x, sp + sp2 + y) = 5
If Cells(1 + s, 5 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
If T = 6 Or T = 14 Or T = 22 Or T = 30 Or T = 38 Or T = 46 Or T = 54 Or T = 62 Then
Cells(x, sp + sp2 + y) = 6
If Cells(1 + s, 4 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
If T = 7 Or T = 15 Or T = 23 Or T = 31 Or T = 39 Or T = 47 Or T = 55 Or T = 63 Then
Cells(x, sp + sp2 + y) = 7
If Cells(1 + s, 3 + sp2) = 1 Then
Cells(x, sp + sp2 + y).Interior.ColorIndex = 48
End If
End If
End With
Next
a = a - 1
b = b + 1
If ctr <> "" Then
If c = 0 Then c = 1 Else c = 0
End If
Next
sp2 = sp2 + 35
Next
s = s + 18
Next
MsgBox "the end"
Cells(6, 12).Select

Attachment: cell_clr.zip