概要
前回は、ナンバーリンクパズルを解くためのVBAプログラムの基本的な考え方と、単純な幅優先探索（BFS）アルゴリズムの導入について解説しました。しかし、現実のナンバーリンクパズルは、盤面のサイズが大きくなったり、数字の配置が複雑になったりすると、単純なBFSだけでは探索空間が指数関数的に増大し、計算時間が著しく増加する、いわゆる「計算量問題」に直面します。
本稿では、この計算量問題を克服し、より大規模で複雑なナンバーリンクパズルも効率的に解くための、より高度な探索アルゴリズムに焦点を当てます。具体的には、バックトラッキング（深さ優先探索：DFS）と、それをさらに最適化するためのヒューリスティック探索（A*アルゴリズムの考え方）の導入について、詳細な解説と実践的なVBAサンプルコードを提供します。これにより、ナンバーリンクパズルを解くVBAプログラムの能力を飛躍的に向上させ、実用的なレベルへと引き上げます。
詳細解説：探索アルゴリズムの深化
1. バックトラッキング（深さ優先探索：DFS）による探索
幅優先探索（BFS）が、可能な経路を「浅い」ところから順に探索していくのに対し、深さ優先探索（DFS）は、一つの経路を可能な限り深く探索し、行き止まりになったら一つ前の分岐点に戻って別の経路を試す、という戦略をとります。ナンバーリンクパズルのような制約充足問題（CSP）においては、DFSがしばしばBFSよりも効率的な場合があります。その理由は、DFSは状態空間を「深さ」で管理するため、メモリ使用量がBFSよりも少なく、また、早期に解を見つける可能性が高いからです。
ナンバーリンクパズルにおけるDFSの基本的な流れは以下のようになります。
1. **盤面の初期化:** パズルの盤面を初期状態（数字のみ配置され、線は引かれていない状態）で用意します。
2. **未配置の数字の選択:** まだ線で結ばれていない数字（または、線が一部しか引かれていない数字）を一つ選びます。
3. **接続可能な方向の探索:** 選んだ数字から、接続可能な隣接マス（まだ線が引かれておらず、かつ、そのマスもまだ線で結ばれていないマス）を探します。
4. **線（経路）の追加と再帰呼び出し:** 接続可能なマスが見つかった場合、そのマスに線を引きます（盤面状態を更新）。そして、この新しい盤面状態に対して、再度DFSの処理を再帰的に呼び出します。
5. **解の発見:** 全ての数字がペアで線で結ばれ、かつ、線が交差しない状態になれば、解発見です。
6. **バックトラック（戻る）:** 再帰呼び出しの結果、解が見つからなかった場合、最後に引いた線を元に戻し（盤面状態を元に戻す）、別の接続可能な方向を試します。もし、全ての方向を試しても解が見つからなければ、さらに前の分岐点に戻ります。
DFSの鍵となるのは、「状態」の管理と「バックトラック」の仕組みです。盤面の状態（どのマスに線が引かれているか、どの数字がどの数字と繋がっているか）を正確に保持し、解が見つからなかった場合にその状態を正確に元に戻すことが重要です。
2. A*アルゴリズムの考え方を取り入れたヒューリスティック探索
バックトラッキング（DFS）は、探索空間を削減する強力な手法ですが、それでも単純に全ての可能な経路を試すだけでは、非常に複雑なパズルでは時間がかかることがあります。そこで、探索の方向性をより賢く誘導するために、ヒューリスティック関数を用いた探索アルゴリズムの考え方を取り入れます。
A*アルゴリズムは、探索ノードの「コスト」を評価する際に、実際にそのノードまで到達するのにかかったコスト（g(n)）と、そのノードからゴールまでの推定コスト（h(n)）、すなわちヒューリスティック関数を合計したもの（f(n) = g(n) + h(n)）を最小化するように探索を進めます。
ナンバーリンクパズルにA*アルゴリズムを直接適用するのは、状態空間の定義が難しいため複雑になりますが、その「ヒューリスティック」という考え方を取り入れることは非常に有効です。具体的には、以下の様なヒューリスティック関数を定義し、探索の優先順位付けに利用することを考えます。
* **未接続の数字の数:** 未接続の数字が多いほど、探索の難易度が高いとみなす。
* **孤立したマス:** 孤立している（周囲が既に線で塞がっている）マスが多いほど、解くのが難しいとみなす。
* **閉路の可能性:** 特定の数字の配置が、将来的に閉路（線が交差してしまう）を引き起こす可能性が高いと判断する。
これらのヒューリスティック関数を、バックトラッキングの際に「次にどの数字から探索を開始するか」「どの方向への接続を優先するか」といった意思決定に利用します。例えば、未接続の数字が少なく、かつ、閉路になりにくい経路を優先して探索することで、無駄な探索を削減し、より早く解に到達できる可能性が高まります。
ただし、ナンバーリンクパズルにおけるヒューリスティック関数は、その設計が難しく、また、不適切なヒューリスティック関数はかえって探索効率を低下させる可能性もあります。そのため、まずはバックトラッキング（DFS）をしっかりと実装し、その上で、必要に応じてヒューリスティックな要素を段階的に導入していくのが現実的です。
サンプルコード：バックトラッキング（DFS）によるナンバーリンクソルバー
ここでは、バックトラッキング（DFS）を用いたナンバーリンクソルバーのVBAサンプルコードを示します。このコードは、再帰処理を用いて探索を行います。
‘==============================================================================
‘ ナンバーリンクパズルソルバー (バックトラッキング/DFS)
‘==============================================================================
‘ グローバル変数（盤面、数字のペア情報、盤面のサイズなど）
Public Const MAX_SIZE As Integer = 10 ‘ 最大盤面サイズ（例: 10×10）
Public board(1 To MAX_SIZE, 1 To MAX_SIZE) As Integer ‘ 盤面 (0: 空白, -1: 線, 1以上: 数字)
Public numbers(1 To MAX_SIZE * MAX_SIZE / 2) As Integer ‘ 数字のリスト (ペアとなる数字)
Public num_count As Integer ‘ 数字のペアの数
Public rows As Integer, cols As Integer ‘ 盤面の実際の行数・列数
‘ 数字のペア情報 (どの数字がどの数字とペアになるか)
Public number_pairs(1 To MAX_SIZE * MAX_SIZE / 2, 1 To 2) As Integer
‘==============================================================================
‘ 初期化処理
‘==============================================================================
Sub InitializeBoard()
Dim r As Integer, c As Integer
‘ 盤面をクリア (全て空白)
For r = 1 To rows
For c = 1 To cols
board(r, c) = 0
Next c
Next r
‘ 数字のペア情報をクリア
num_count = 0
Erase number_pairs
End Sub
‘==============================================================================
‘ 盤面に数字を配置する（テスト用）
‘==============================================================================
Sub SetUpPuzzle(ByRef puzzle_data As Variant)
Dim r As Integer, c As Integer
Dim num As Integer
Dim found_pairs As Object ‘ Dictionaryオブジェクトでペアを管理
Set found_pairs = CreateObject(“Scripting.Dictionary”)
rows = UBound(puzzle_data, 1)
cols = UBound(puzzle_data, 2)
InitializeBoard
For r = 1 To rows
For c = 1 To cols
num = puzzle_data(r, c)
If num > 0 Then
board(r, c) = num
If Not found_pairs.Exists(num) Then
found_pairs.Add num, Array(r, c) ‘ 最初の出現位置を記録
Else
‘ 2つ目の出現位置を記録
num_count = num_count + 1
number_pairs(num_count, 1) = num
number_pairs(num_count, 2) = num
‘ TODO: 実際には、ペアとなる数字の座標を別途管理する必要がある
‘ ここでは単純化のため、同じ数字が2つあればペアとみなす
End If
End If
Next c
Next r
‘ 数字のリストを生成 (デバッグ用)
ReDim numbers(1 To num_count)
Dim k As Integer
For k = 1 To num_count
numbers(k) = number_pairs(k, 1)
Next k
End Sub
‘==============================================================================
‘ 指定した数字のペアの、もう一方の端点の座標を取得
‘==============================================================================
Function GetOtherEndPoint(ByVal target_num As Integer, ByRef start_r As Integer, ByRef start_c As Integer) As Boolean
Dim r As Integer, c As Integer
Dim found As Boolean
found = False
For r = 1 To rows
For c = 1 To cols
If board(r, c) = target_num Then
‘ 数字が見つかったが、それが開始点でない場合
If Not (r = start_r And c = start_c) Then
GetOtherEndPoint = True
Exit Function
End If
End If
Next c
Next r
GetOtherEndPoint = False ‘ 見つからなかった場合
End Function
‘==============================================================================
‘ 盤面を表示する（デバッグ用）
‘==============================================================================
Sub PrintBoard()
Dim r As Integer, c As Integer
Dim line_char As String
Debug.Print “——————–”
For r = 1 To rows
For c = 1 To cols
Select Case board(r, c)
Case 0: line_char = “.” ‘ 空白
Case -1: line_char = “*” ‘ 線
Case Is > 0: line_char = CStr(board(r, c)) ‘ 数字
Case Else: line_char = “?” ‘ 未定義
End Select
Debug.Print line_char & ” “,
Next c
Debug.Print
Next r
Debug.Print “——————–”
End Sub
‘==============================================================================
‘ バックトラッキング（DFS）による探索実行
‘==============================================================================
‘ 未接続の数字のペアを管理するための補助変数
Public pair_status() As Integer ‘ 0: 未接続, 1: 部分接続, 2: 完全接続
Sub SolveNumberLink()
Dim r As Integer, c As Integer
Dim num_idx As Integer
Dim start_r As Integer, start_c As Integer
‘ ペアステータスを初期化
ReDim pair_status(1 To num_count)
For num_idx = 1 To num_count
pair_status(num_idx) = 0 ‘ 全て未接続
Next num_idx
‘ 盤面上の全ての数字を探索し、未接続のペアから探索を開始する
For num_idx = 1 To num_count
Dim current_num As Integer
current_num = number_pairs(num_idx, 1) ‘ ペアとなる数字
‘ この数字のペアがまだ完全に接続されていない場合
If pair_status(num_idx) = 0 Then
‘ 盤面からこの数字の最初の出現位置を探す
For r = 1 To rows
For c = 1 To cols
If board(r, c) = current_num Then
start_r = r
start_c = c
‘ DFS探索を開始
If DFS(start_r, start_c, current_num, num_idx) Then
Debug.Print “Solution found!”
PrintBoard
Exit Sub ‘ 解が見つかったら終了
End If
‘ 解が見つからなかった場合、バックトラックはDFS内部で行われる
‘ ここで盤面をリセットする必要はない (DFSが元に戻す)
GoTo NextNumberSearch ‘ 次の未接続ペアを探す
End If
Next c
Next r
End If
NextNumberSearch:
Next num_idx
Debug.Print “No solution found with current configuration.”
End Sub
‘==============================================================================
‘ 深さ優先探索（DFS）関数
‘==============================================================================
‘ r, c: 現在のマス座標
‘ current_num: 現在探索中の数字
‘ pair_idx: 現在探索中の数字ペアのインデックス (number_pairs 配列用)
‘ returns: True (解が見つかった), False (見つからなかった)
Function DFS(ByVal r As Integer, ByVal c As Integer, ByVal current_num As Integer, ByVal pair_idx As Integer) As Boolean
Dim dr() As Integer: dr = Array(-1, 1, 0, 0) ‘ 上, 下, 左, 右
Dim dc() As Integer: dc = Array(0, 0, -1, 1)
Dim i As Integer
Dim next_r As Integer, next_c As Integer
Dim next_num As Integer
‘ 盤面状態を記録 (バックトラック用)
Dim original_board_value As Integer
original_board_value = board(r, c)
‘ 現在のマスに線を引く (または数字をマークする)
‘ 数字が既に配置されているマスは、その数字をマークする
‘ 空白マスに線を引く場合は -1 を使う
If original_board_value > 0 Then ‘ 数字のあるマスならそのまま
‘ 何もしない、この数字は既に配置されている
Else
board(r, c) = -1 ‘ 線を引く
End If
‘ ペアのもう一方の端点を探す
Dim end_point_r As Integer, end_point_c As Integer
Dim found_end_point As Boolean
‘ 現在の数字ペアのもう一方の端点を探す
found_end_point = False
Dim search_num As Integer
search_num = current_num ‘ 探している数字は current_num
Dim temp_r As Integer, temp_c As Integer
For temp_r = 1 To rows
For temp_c = 1 To cols
If board(temp_r, temp_c) = search_num Then
‘ 既に開始点としてマークされているマス以外を探す
If Not (temp_r = r And temp_c = c) Then
end_point_r = temp_r
end_point_c = temp_c
found_end_point = True
Exit For
End If
End If
Next temp_c
If found_end_point Then Exit For
Next temp_r
‘ もし、この数字 (current_num) のもう一方の端点が見つかった場合
If found_end_point Then
‘ その端点までの経路を線で埋める
‘ この部分は、実際には経路探索アルゴリズム（例: BFSで最短経路を見つける）が必要
‘ ここでは単純化のため、端点が見つかったら「接続完了」とみなす
‘ TODO: 実際には、(r, c) から (end_point_r, end_point_c) までの経路を引く処理が必要
‘ 簡易的な経路引き込み: 直線的な経路と仮定し、線を引いていく
Dim current_path_r As Integer, current_path_c As Integer
current_path_r = r
current_path_c = c
‘ 端点まで移動
While Not (current_path_r = end_point_r And current_path_c = end_point_c)
Dim moved As Boolean
moved = False
‘ 端点に近づく方向を探す
If Abs(current_path_r – end_point_r) > Abs(current_path_c – end_point_c) Then ‘ 縦方向移動優先
If current_path_r < end_point_r Then
current_path_r = current_path_r + 1
ElseIf current_path_r > end_point_r Then
current_path_r = current_path_r – 1
Else ‘ 縦方向は一致したので横方向移動
If current_path_c < end_point_c Then
current_path_c = current_path_c + 1
ElseIf current_path_c > end_point_c Then
current_path_c = current_path_c – 1
End If
End If
Else ‘ 横方向移動優先
If current_path_c < end_point_c Then
current_path_c = current_path_c + 1
ElseIf current_path_c > end_point_c Then
current_path_c = current_path_c – 1
Else ‘ 横方向は一致したので縦方向移動
If current_path_r < end_point_r Then
current_path_r = current_path_r + 1
ElseIf current_path_r > end_point_r Then
current_path_r = current_path_r – 1
End If
End If
End If
‘ 移動先のマスが有効かチェック (盤面内、空白、または既に引かれている線)
If current_path_r >= 1 And current_path_r <= rows And current_path_c >= 1 And current_path_c <= cols Then
If board(current_path_r, current_path_c) = 0 Or board(current_path_r, current_path_c) = -1 Then
board(current_path_r, current_path_c) = -1 ' 線を引く
moved = True
Else ' 既に他の数字や線が引かれている場合は、この経路は無効
' TODO: ここでバックトラック処理を呼び出すべきだが、DFSの再帰構造でhandledされる
' 実際には、ここで失敗と判断し、前の状態に戻す必要がある
DFS = False ' ここで失敗と判断
' 盤面を元に戻す
board(r, c) = original_board_value ' 開始点の状態を元に戻す
' 引いた線も元に戻す（この簡易版では複雑なので省略、本来は必要）
Exit Function
End If
Else ' 盤面外に出た場合は無効
DFS = False
board(r, c) = original_board_value
Exit Function
End If
Wend
' 端点まで到達したら、このペアは接続完了
pair_status(pair_idx) = 2
' 全てのペアが接続完了したかチェック
Dim all_connected As Boolean
all_connected = True
For i = 1 To num_count
If pair_status(i) <> 2 Then
all_connected = False
Exit For
End If
Next i
If all_connected Then
DFS = True ‘ 解発見！
Exit Function
Else
‘ まだ接続されていないペアがある場合、次のペアの探索を試みる
‘ TODO: ここで、未接続のペアのうち、次に探索すべきペアを選択するロジックが必要
‘ （例: 未接続の数字が最も少ないペアから開始するなど）
‘ ここでは単純に、次の未接続ペアを探してDFSを呼び出す
Dim next_pair_idx As Integer
Dim next_start_r As Integer, next_start_c As Integer
Dim next_num_to_find As Integer
For next_pair_idx = 1 To num_count
If pair_status(next_pair_idx) = 0 Then ‘ 未接続のペアを見つけたら
next_num_to_find = number_pairs(next_pair_idx, 1)
‘ その数字の開始点を探す
For next_start_r = 1 To rows
For next_start_c = 1 To cols
If board(next_start_r, next_start_c) = next_num_to_find Then
If DFS(next_start_r, next_start_c, next_num_to_find, next_pair_idx) Then
DFS = True ‘ 解が見つかった
Exit Function
End If
‘ DFSで解が見つからなかった場合、バックトラックはDFS内部で行われる
GoTo ContinueNextPairSearch
End If
Next next_start_c
Next next_start_r
End If
ContinueNextPairSearch:
Next next_pair_idx
‘ 全ての未接続ペアを試しても解が見つからなければ、このパスは失敗
DFS = False
‘ 盤面を元に戻す
board(r, c) = original_board_value ‘ 開始点の状態を元に戻す
‘ 引いた線も元に戻す（この簡易版では複雑なので省略、本来は必要）
Exit Function
End If
Else
‘ この数字 (current_num) のもう一方の端点が見つからなかった場合 (まだ配置されていないか、既に線で塞がれている)
‘ 次のマスへ移動して探索を続ける
For i = 0 To 3 ‘
