Last active
December 11, 2018 06:14
-
-
Save ezaki/06008894ceca1edfcf020d4a60e41e27 to your computer and use it in GitHub Desktop.
エクセル用セルオートマトンスクリプト
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| '----- 定数 ----- | |
| '計算回数 | |
| Const LOOP_TIMES As Integer = 50 | |
| '休止期状態時色 | |
| Const DEFAULT_COLOR As Integer = 2 | |
| '興奮期状態時色 | |
| Const ACTIVE_COLOR As Integer = 3 | |
| '不応期状態時色 | |
| Const REFRACTORY_COLOR As Integer = 16 | |
| '阻害物色 | |
| Const BLOCK_COLOR As Integer = 1 | |
| '開始行数 | |
| Const MIN_ROW As Integer = 5 | |
| '開始列数 | |
| Const MIN_COLUMN As Integer = 5 | |
| '終了行数数 | |
| Const MAX_ROW As Integer = 40 | |
| '終了列数 | |
| Const MAX_COLUMN As Integer = 40 | |
| 'ムーア近傍を使用するか（False の場合ノイマン近傍を使用） | |
| Const IS_MOORE = True | |
| '----- 関数 ----- | |
| '対象セルの色を取得 | |
| Function colorPick(ByVal row As Integer, ByVal column As Integer) As Integer | |
| colorPick = Cells(row, column).Interior.colorIndex | |
| End Function | |
| '対象セルに色を設定 | |
| Sub drawCell(ByVal row As Integer, ByVal column As Integer, ByVal color As Integer) | |
| Cells(row, column).Interior.colorIndex = color | |
| End Sub | |
| '現在のセルの色を二次元配列として取得 | |
| Function getCullentColorArray() As Integer() | |
| Dim arr(MIN_ROW To MAX_ROW, MIN_COLUMN To MAX_COLUMN) As Integer | |
| For i = MIN_ROW To MAX_ROW | |
| For j = MIN_COLUMN To MAX_COLUMN | |
| arr(i, j) = colorPick(i, j) | |
| Next j | |
| Next i | |
| getCullentColorArray = arr() | |
| End Function | |
| 'セルの色を次の時間へ進める | |
| Sub nextTick(ByRef curArr() As Integer) | |
| Dim colorIndex As Integer, nextArr(MIN_ROW To MAX_ROW, MIN_COLUMN To MAX_COLUMN) As Integer | |
| For i = MIN_ROW To MAX_ROW | |
| For j = MIN_COLUMN To MAX_COLUMN | |
| colorIndex = curArr(i, j) | |
| '興奮気なら次の時間は不応期へ | |
| If colorIndex = ACTIVE_COLOR Then | |
| nextArr(i, j) = REFRACTORY_COLOR | |
| '不応期なら次の時間は休止期へ | |
| ElseIf colorIndex = REFRACTORY_COLOR Then | |
| nextArr(i, j) = DEFAULT_COLOR | |
| '阻害物なら変化なし | |
| ElseIf colorIndex = BLOCK_COLOR Then | |
| nextArr(i, j) = BLOCK_COLOR | |
| '休止期の次の時間を設定する | |
| Else | |
| '一旦休止期として設定 | |
| nextArr(i, j) = DEFAULT_COLOR | |
| '左隣が興奮期なら興奮期へ | |
| If i > MIN_ROW Then | |
| If curArr(i - 1, j) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| '右隣が興奮期なら興奮期へ | |
| If i < MAX_ROW Then | |
| If curArr(i + 1, j) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| If j > MIN_COLUMN Then | |
| '上が興奮期なら興奮期へ | |
| If curArr(i, j - 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| 'ムーア近傍 | |
| If IS_MOORE Then | |
| '左上が興奮期なら興奮期へ | |
| If i > MIN_ROW Then | |
| If curArr(i - 1, j - 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| '右上が興奮期なら興奮期へ | |
| If i < MAX_ROW Then | |
| If curArr(i + 1, j - 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| End If | |
| End If | |
| If j < MAX_COLUMN Then | |
| '下が興奮期なら興奮期へ | |
| If curArr(i, j + 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| 'ムーア近傍 | |
| If IS_MOORE Then | |
| '左下が興奮期なら興奮期へ | |
| If i > MIN_ROW Then | |
| If curArr(i - 1, j + 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| '右下が興奮期なら興奮期へ | |
| If i < MAX_ROW Then | |
| If curArr(i + 1, j + 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| End If | |
| End If | |
| End If | |
| Next j | |
| Next i | |
| '計算した次の時間の状態をもとに色を塗る | |
| For i = MIN_ROW To MAX_ROW | |
| For j = MIN_COLUMN To MAX_COLUMN | |
| Call drawCell(i, j, nextArr(i, j)) | |
| Next j | |
| Next i | |
| End Sub | |
| 'メイン関数 | |
| Sub main() | |
| '開始時の設定 | |
| Application.Calculation = xlCalculationManual | |
| '実際にセルを更新する作業 | |
| For i = 1 To LOOP_TIMES | |
| DoEvents 'ハングアップしないように操作を受け付ける | |
| Application.ScreenUpdating = False '一度に色を更新させるために一旦画面更新を停止 | |
| Application.StatusBar = "シミュレーション中…" & i & "/" & LOOP_TIMES | |
| Dim l As Integer, curArr() As Integer | |
| curArr() = getCullentColorArray() | |
| Call nextTick(curArr()) | |
| Application.ScreenUpdating = True '色を更新させるために画面更新を実施 | |
| Next i | |
| '設定復帰処理 | |
| Application.Calculation = xlCalculationAutomatic | |
| Application.StatusBar = False | |
| End Sub |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| '----- 定数 ----- | |
| '計算回数 | |
| Const LOOP_TIMES As Integer = 50 | |
| '休止期状態時色 | |
| Const DEFAULT_COLOR As Integer = 2 | |
| '興奮期状態時色 | |
| Const ACTIVE_COLOR As Integer = 3 | |
| '不応期状態時色 | |
| Const REFRACTORY_COLOR As Integer = 16 | |
| '阻害物色 | |
| Const BLOCK_COLOR As Integer = 1 | |
| '開始行数 | |
| Const MIN_ROW As Integer = 5 | |
| '開始列数 | |
| Const MIN_COLUMN As Integer = 5 | |
| '終了行数数 | |
| Const MAX_ROW As Integer = 40 | |
| '終了列数 | |
| Const MAX_COLUMN As Integer = 40 | |
| 'ムーア近傍を使用するか（False の場合ノイマン近傍を使用） | |
| Const IS_MOORE = True | |
| '----- 関数 ----- | |
| '対象セルの色を取得 | |
| Function colorPick(ByVal row As Integer, ByVal column As Integer) As Integer | |
| colorPick = Cells(row, column).Interior.colorIndex | |
| End Function | |
| '対象セルに色を設定 | |
| Sub drawCell(ByVal row As Integer, ByVal column As Integer, ByVal color As Integer) | |
| Cells(row, column).Interior.colorIndex = color | |
| End Sub | |
| '現在のセルの色を二次元配列として取得 | |
| Function getCullentColorArray() As Integer() | |
| Dim arr(MIN_ROW To MAX_ROW, MIN_COLUMN To MAX_COLUMN) As Integer | |
| For i = MIN_ROW To MAX_ROW | |
| For j = MIN_COLUMN To MAX_COLUMN | |
| arr(i, j) = colorPick(i, j) | |
| Next j | |
| Next i | |
| getCullentColorArray = arr() | |
| End Function | |
| 'セルの色を次の時間へ進める | |
| Sub nextTick(ByRef curArr() As Integer) | |
| Dim colorIndex As Integer, nextArr(MIN_ROW To MAX_ROW, MIN_COLUMN To MAX_COLUMN) As Integer | |
| For i = MIN_ROW To MAX_ROW | |
| For j = MIN_COLUMN To MAX_COLUMN | |
| colorIndex = curArr(i, j) | |
| '興奮気なら次の時間は不応期へ | |
| If colorIndex = ACTIVE_COLOR Then | |
| nextArr(i, j) = REFRACTORY_COLOR | |
| '不応期なら次の時間は休止期へ | |
| ElseIf colorIndex = REFRACTORY_COLOR Then | |
| nextArr(i, j) = DEFAULT_COLOR | |
| '阻害物なら変化なし | |
| ElseIf colorIndex = BLOCK_COLOR Then | |
| nextArr(i, j) = BLOCK_COLOR | |
| '休止期の次の時間を設定する | |
| Else | |
| '一旦休止期として設定 | |
| nextArr(i, j) = DEFAULT_COLOR | |
| '左隣が興奮期なら興奮期へ | |
| If i > MIN_ROW Then | |
| If curArr(i - 1, j) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| '右隣が興奮期なら興奮期へ | |
| If i < MAX_ROW Then | |
| If curArr(i + 1, j) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| If j > MIN_COLUMN Then | |
| '上が興奮期なら興奮期へ | |
| If curArr(i, j - 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| 'ムーア近傍 | |
| If IS_MOORE Then | |
| '左上が興奮期なら興奮期へ | |
| If i > MIN_ROW Then | |
| If curArr(i - 1, j - 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| '右上が興奮期なら興奮期へ | |
| If i < MAX_ROW Then | |
| If curArr(i + 1, j - 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| End If | |
| End If | |
| If j < MAX_COLUMN Then | |
| '下が興奮期なら興奮期へ | |
| If curArr(i, j + 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| 'ムーア近傍 | |
| If IS_MOORE Then | |
| '左下が興奮期なら興奮期へ | |
| If i > MIN_ROW Then | |
| If curArr(i - 1, j + 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| '右下が興奮期なら興奮期へ | |
| If i < MAX_ROW Then | |
| If curArr(i + 1, j + 1) = ACTIVE_COLOR Then | |
| nextArr(i, j) = ACTIVE_COLOR | |
| End If | |
| End If | |
| End If | |
| End If | |
| End If | |
| Next j | |
| Next i | |
| '計算した次の時間の状態をもとに色を塗る | |
| For i = MIN_ROW To MAX_ROW | |
| For j = MIN_COLUMN To MAX_COLUMN | |
| Call drawCell(i, j, nextArr(i, j)) | |
| Next j | |
| Next i | |
| End Sub | |
| 'メイン関数 | |
| Sub main() | |
| '開始時の設定 | |
| Application.Calculation = xlCalculationManual | |
| '実際にセルを更新する作業 | |
| For i = 1 To LOOP_TIMES | |
| DoEvents 'ハングアップしないように操作を受け付ける | |
| Application.ScreenUpdating = False '一度に色を更新させるために一旦画面更新を停止 | |
| Application.StatusBar = "シミュレーション中…" & i & "/" & LOOP_TIMES | |
| '10 回に一度だけ一か所を興奮期にする | |
| If i Mod 10 = 1 Then | |
| Call drawCell(10, 10, ACTIVE_COLOR) | |
| End If | |
| Dim l As Integer, curArr() As Integer | |
| curArr() = getCullentColorArray() | |
| Call nextTick(curArr()) | |
| Application.ScreenUpdating = True '色を更新させるために画面更新を実施 | |
| Next i | |
| '設定復帰処理 | |
| Application.Calculation = xlCalculationAutomatic | |
| Application.StatusBar = False | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment