excel吧 关注：279,930贴子：1,533,493
- 9回复贴，共1页
塔克林
菠萝蜜 '生命游戏的规则
'在生命游戏中，每个网格单元可以有两种状态之一：死或活。生命游戏由四个简单的规则控制，这些规则应用于模拟域中的每个网格单元：
'人口过少，离群：如果一个活细胞少于两个活的邻居，它就会死亡。'
'正常: 一个有两个或三个活邻居的活细胞可以延续到下一代?
'人口过多，过度竞争：一个有超过三个活邻居的活细胞死亡。
'繁衍：如果一个死细胞正好有三个活着的邻居，它就会复活。
Option Explicit
Sub abc()
Dim a, b, i, j, k, n, t, pos, cnt, f
ReDim a(32, 32)
For i = 1 To 31
For j = 1 To 31
If Rnd < 0.5 Then a(i, j) = 1 '初始生命体
Next
Next
Call putdata(a)
pos = Array(-1, -1, -1, 0, -1, 1, 0, -1, 0, 1, 1, -1, 1, 0, 1, 1)
Do
b = a
For i = 1 To 31
For j = 1 To 31
n = 0
If a(i, j) = 1 Then '目前活着
For k = 0 To UBound(pos) Step 2
If a(i + pos(k), j + pos(k + 1)) = 1 Then n = n + 1
Next
If n < 2 Or n > 3 Then a(i, j) = -1 '人口过少或过多就不活了
ElseIf a(i, j) = -1 Then '曾经活过
For k = 0 To UBound(pos) Step 2
If a(i + pos(k), j + pos(k + 1)) = 1 Then n = n + 1
Next
If n = 3 Then a(i, j) = 1 '复活
End If
Next
Next
t = Timer
Do: DoEvents: Loop Until Timer - t >= 0.1
Call putdata(a)
For i = 1 To 31
For j = 1 To 31
If a(i, j) <> b(i, j) Then Exit For
Next
If j < 32 Then Exit For
Next
If i = 32 Then Exit Do
cnt = cnt + 1
Loop Until cnt >= 50
End Sub
Function putdata(a)
Dim i, j
ReDim b(UBound(a), UBound(a, 2))
For i = 1 To 31
For j = 1 To 31
If a(i, j) = 1 Then b(i, j) = "█"
Next
Next
[a1].Resize(UBound(b), UBound(b, 2)) = b
End Function
'在生命游戏中，每个网格单元可以有两种状态之一：死或活。生命游戏由四个简单的规则控制，这些规则应用于模拟域中的每个网格单元：
'人口过少，离群：如果一个活细胞少于两个活的邻居，它就会死亡。'
'正常: 一个有两个或三个活邻居的活细胞可以延续到下一代?
'人口过多，过度竞争：一个有超过三个活邻居的活细胞死亡。
'繁衍：如果一个死细胞正好有三个活着的邻居，它就会复活。
Option Explicit
Sub abc()
Dim a, b, i, j, k, n, t, pos, cnt, f
ReDim a(32, 32)
For i = 1 To 31
For j = 1 To 31
If Rnd < 0.5 Then a(i, j) = 1 '初始生命体
Next
Next
Call putdata(a)
pos = Array(-1, -1, -1, 0, -1, 1, 0, -1, 0, 1, 1, -1, 1, 0, 1, 1)
Do
b = a
For i = 1 To 31
For j = 1 To 31
n = 0
If a(i, j) = 1 Then '目前活着
For k = 0 To UBound(pos) Step 2
If a(i + pos(k), j + pos(k + 1)) = 1 Then n = n + 1
Next
If n < 2 Or n > 3 Then a(i, j) = -1 '人口过少或过多就不活了
ElseIf a(i, j) = -1 Then '曾经活过
For k = 0 To UBound(pos) Step 2
If a(i + pos(k), j + pos(k + 1)) = 1 Then n = n + 1
Next
If n = 3 Then a(i, j) = 1 '复活
End If
Next
Next
t = Timer
Do: DoEvents: Loop Until Timer - t >= 0.1
Call putdata(a)
For i = 1 To 31
For j = 1 To 31
If a(i, j) <> b(i, j) Then Exit For
Next
If j < 32 Then Exit For
Next
If i = 32 Then Exit Do
cnt = cnt + 1
Loop Until cnt >= 50
End Sub
Function putdata(a)
Dim i, j
ReDim b(UBound(a), UBound(a, 2))
For i = 1 To 31
For j = 1 To 31
If a(i, j) = 1 Then b(i, j) = "█"
Next
Next
[a1].Resize(UBound(b), UBound(b, 2)) = b
End Function
'
'生命游戏的规则
'在生命游戏中，每个网格单元可以有两种状态之一：死或活。生命游戏由四个简单的规则控制，这些规则应用于模拟域中的每个网格单元：
'人口过少，离群：如果一个活细胞少于两个活的邻居，它就会死亡。'
'正常: 一个有两个或三个活邻居的活细胞可以延续到下一代?
'人口过多，过度竞争：一个有超过三个活邻居的活细胞死亡。
'繁衍：如果一个死细胞正好有三个活着的邻居，它就会复活。
'
Option Explicit
'
Sub abc()
Dim a, b, i, j, k, n, t, pos, cnt, f
ReDim a(41, 41)
For i = 1 To UBound(a) - 1
For j = 1 To UBound(a, 2) - 1
' If Rnd < 0.3 Then a(i, j) = "█"
Next
Next
Call init(a)
b = a
[a1].Resize(UBound(a), UBound(a, 2)) = a
pos = Array(-1, -1, -1, 0, -1, 1, 0, -1, 0, 1, 1, -1, 1, 0, 1, 1)
Do
f = 0
For i = 1 To UBound(a) - 1
For j = 1 To UBound(a, 2) - 1
n = 0
For k = 0 To UBound(pos) Step 2
If a(i + pos(k), j + pos(k + 1)) = "█" Then n = n + 1
Next
If a(i, j) = "█" Then
If n < 2 Or n > 3 Then b(i, j) = Empty: f = 1
Else
If n = 3 Then b(i, j) = "█": f = 1
End If
Next
Next
t = Timer
Do: DoEvents: Loop Until Timer - t >= 0.1
[a1].Resize(UBound(a), UBound(a, 2)) = a
a = b: cnt = cnt + 1
Loop Until cnt >= 500 Or f = 0
End Sub
'
Function init(a)
Dim s, i, t, tt
' s = "9-10,10-8,10-10,11-9,11-10"
' s = "8-9,8-10,9-8,9-9,9-10,9-11,10-8,10-9,10-11,10-12,11-10,11-11"
s = "3-26,4-24,4-26,5-14,5-15,5-22,5-23,5-36,5-37,6-13,6-17,6-22,6-23,6-36,6-37,7-2,7-3,7-12,7-18,7-22,7-23,8-2,8-3,8-12,8-16,8-18,8-19,8-24,8-26,9-12,9-18,9-26,10-13,10-17,11-14,11-15"
t = Split(s, ",")
For i = 0 To UBound(t)
tt = Split(t(i), "-")
a(Val(tt(0)), Val(tt(1))) = "█"
Next
End Function
