けーすけ@北海道のブログ一覧

ハノイの塔という遊びをご存知と思います。
棒が３本あって、その間をルールに沿って円盤を移動させる遊びですね。

２０年近く前、ＰＣプログラムを独学中に、そこで公開されたものです。
大雪で大変なところもあるようですので、ヒマ潰しにどうぞ。
(作者不明ですが２０年近く前だから、もう時効だよね？？？)

ＭＳ－ＥＸＣＥＬで動きます。

ＭＳ－ＥＸＣＥＬを起動させ、Ａｌｔ＋Ｆ１１で、ＶＢＡ(ＶｉｓｕａｌＢａｓｉｃ ｆｏｒ Ａｐｐｌｉｃａｔｉｎ’ｓ)のエディタが開きます。標準モジュールを追加してください。そこに、下のソースコードを、コピペしてお使いください。難しそうに聞こえるけれど、マクロの延長って考えればそんなに拒絶反応をしなくてもよいかな？？？

なお、ハノイの塔は「再帰」の勉強によく使われます。
ネット上でも、ＶｉｓｕａｌＢａｓｉｃ、Ｃ/Ｃ＋＋などのソースコードが公開されています。


'変数宣言を強制
Option Explicit
'定数
Private Const total As Integer = 3
'変数
Private cnt As Integer 'カウンター
Private pole(1) As Integer '棒
Private bottom_cell(3) As Integer '各棒の円盤の位置

'--- ハノイの塔スタート --------------
Public Sub Hanoi_Run()

Call Set_Pole
Call Set_Discuss
Const n As Integer = 4 '円盤の数
cnt = 0
Call Hanoi(n, 0, 1)

End Sub

'--- ハノイの塔本体 ------------------
' 引数
' n:円盤の番号
' a:移動元作業棒
' b:移動先作業棒
'-------------------------------------
Private Sub Hanoi(ByRef n As Variant, ByRef a As Variant, ByRef b As Variant)

If n > 0 Then
Call Hanoi(n - 1, a, total - (a + b))
cnt = cnt + 1
pole(0) = Asc("a") + a
pole(1) = Asc("a") + b
'円盤の移動順序を1列目に書き出し
Cells(cnt, 1).Value = n & "番の円盤を" & Chr(pole(0)) & "から" & Chr(pole(1)) & "に移動"
'円盤を移動
Call Move_Discuss(n, pole(0), pole(1))
Call Hanoi(n - 1, total - (a + b), b)
End If

End Sub

'--- 作業棒の設定 --------------------
Private Sub Set_Pole()

Range(Cells(1, 4), Cells(41)).ColumnWidth = 1
'棒aの定義
Range(Cells(4, 12), Cells(8, 12)).ColumnWidth = 0.5
Cells(10, 12).Value = "a"
'棒bの定義
Range(Cells(4, 24), Cells(8, 24)).ColumnWidth = 0.5
Cells(10, 24).Value = "b"
'棒cの定義
Range(Cells(4, 36), Cells(8, 36)).ColumnWidth = 0.5
Cells(10, 36).Value = "c"

End Sub

'--- 最初の円盤を配置 ----------------
Private Sub Set_Discuss()

Range(Cells(5, 11), Cells(5, 13)).Interior.ColorIndex = 1 * 3 '1番目の円盤
Range(Cells(6, 10), Cells(6, 14)).Interior.ColorIndex = 2 * 3 '2番目の円盤
Range(Cells(7, 9), Cells(8, 15)).Interior.ColorIndex = 3 * 3 '3番目の円盤
Range(Cells(8, 8), Cells(8, 16)).Interior.ColorIndex = 4 * 3 '4番目の円盤
'最初の各円盤の位置の初期値を代入
bottom_cell(0) = 5
bottom_cell(1) = 6
bottom_cell(2) = 7
bottom_cell(3) = 8

End Sub

'--- 円盤を移動 ----------------------
' 引数
' n:円盤(1-4)
' a:移動元作業棒(97-99)
' b:移動先作業棒(97-99)
'-------------------------------------
Private Sub Move_Discuss(ByVal n As Integer, ByVal a As Integer, ByVal b As Integer)

Dim i As Long
Dim col(1) As Integer
col(0) = 12 * (a - 96)
col(1) = 12 * (b - 96)
'円盤を上に移動
For i = 1000000 To 6000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), col(0) - n), Cells(bottom_cell(n - 1), col(0) + n)) _
.Interior.ColorIndex = xlNone
bottom_cell(n - 1) = bottom_cell(n - 1) - 1
Range(Cells(bottom_cell(n - 1), col(0) - n), Cells(bottom_cell(n - 1), col(0) + n)) _
.Interior.ColorIndex = n * 3
If bottom_cell(n - 1) = 3 Then Exit For
End If
Next
'円盤を横に移動
If col(1) - col(0) > 0 Then
For i = col(0) * 1000000 To col(1) * 1000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), i / 1000000 - n + 1), _
Cells(bottom_cell(n - 1), i / 1000000 + n)) _
.Interior.ColorIndex = n * 3
Cells(bottom_cell(n - 1), i / 1000000 - n).Interior.ColorIndex = xlNone
End If
Next
Else
For i = col(0) * 1000000 To col(1) * 1000000 Step -1
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), i / 1000000 - n), _
Cells(bottom_cell(n - 1), i / 1000000 + n + 1)) _
.Interior.ColorIndex = n * 3
Cells(bottom_cell(n - 1), i / 1000000 + n + 1).Interior.ColorIndex = xlNone
End If
Next
End If
'円盤を下に移動
For i = 1000000 To 6000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), col(1) - n), Cells(bottom_cell(n - 1), col(1) + n)) _
.Interior.ColorIndex = xlNone
bottom_cell(n - 1) = bottom_cell(n - 1) + 1
Range(Cells(bottom_cell(n - 1), col(1) - n), Cells(bottom_cell(n - 1), col(1) + n)) _
.Interior.ColorIndex = n * 3
If Range(Cells(bottom_cell(n - 1) + 1, col(1) - n), Cells(bottom_cell(n - 1) + 1, col(1) + n)) _
.Interior.ColorIndex <> xlNone Or bottom_cell(n - 1) = 8 Then Exit For
End If
Next

End Sub