巡回セールスマン問題を使って・・・

質問

以前、この場で巡回セールスマン問題の考え方を使って、ということで質問に答えていただきました。その節はありがとうございました。
建築の学生なのですが、卒論の対象地の一つの分析として次のようなことを行っております。

対象地に1４の交差点があって
「１４の交差点全てを一筆書きで、最短経路で通過したい。」
ということをやるようになってます。
これに関して数人の方の協力でプログラムを組んでもらいました。

現在のプログラムはスタートのみ固定して、１４それぞれ最短経路を探索し、ルートと最短距離を表示します。

今度はこれを、スタートとゴールともに固定して
「スタートが交差点１で、ゴールが交差点14のとき
　ルートは・・。最短距離は何ｍ。」

というふうに表示させたいのですが、プログラムに関して私はまったく素人でどのように変更すればよいかわかりません。
そこで、どのように改良すればよいか教えていただけないでしょうか。
よろしくお願いします。
文字数の関係で、プログラムをのせれないのでお答えになってくださったときにお礼の場でプログラムをお見せすることができます。

回答No.3

TAGOSAKU7

結構手間がかかりそうなので、今日は全くプログラムを見てませんでした。
それじゃなくてもオリジナルの関数が多くて、コードを追いずらいです。

ぼくもやっては見ますけど、、、ムズイ、、、

とりあえず、ここの内容を見た人がやりやすいように、コメント位置をずらして、インデントしておきました。

この書き込みには基本的にはレス不要です。
nintaiさんが「ここら辺だと思う」というところがあったら補足してください。

Option Explicit

Public nPoint　　　　　 As Integer　'交差点の数
Public dist(20, 20)　　 As Integer　'距離を入れておくテーブル
Public availRoad(20, 20) As Boolean '片道通過可能テーブル　既に通ったかどうかを記録
Public availPoint(20)　 As Boolean　'交差点通過可能配列　交差点を既に通ったかどうかを記録
Public checkPoint(20)　 As Integer　'交差点通過回数配列
Public move　　　　　　 As Integer　'現在作りかけの経路の通過する交差点の延べ数
Public route(50)　　　　As Integer　'現在作りかけの経路
Public distance　　　　 As Integer　'現在作りかけの経路の距離
Public minRoute(50)　　 As Integer　'これまでに見つかった最短経路
Public minMove　　　　　As Integer　'これまでに見つかった最短経路の通過する交差点の延べ数
Public minDistance　　　As Integer　'これまでに見つかった最短経路の距離
Public startPt　　　　　As Integer　'出発交差点

'一筆経路探索（一度通過した交差点は通らない）
Sub SearchMove()
　　Dim startStt As Integer '出発点の開始交差点番号
　　Dim StartEnd As Integer '出発点の終了交差点番号

　　'メッセージ表示
　　Call ShowMsg("一筆探索 実行中")

　　'結果削除
　　Call ClearResult

　　'道のデータを読み取る。
　　Call GetRoadTable

　　'通行可能交差点初期設定
　　Call ClearAvailablePoint

　　'検索
　　Call GetStartPoint(startStt, StartEnd)　'出発点の範囲取得
　　minDistance = 30000 '大きな数値を入れておく

　　For startPt = startStt To StartEnd
　　　　Call ShowMsg("一筆探索 実行中　出発点" + Str(startPt))
　　　　'出発点通過するので通過不可能にする
　　　　availPoint(startPt) = False
　　　　'ルートの履歴設定
　　　　route(1) = startPt
　　　　'出発点startPtから経路検索
　　　　Call SearchMoveRepeat(startPt, 0, 1)
　　　　'通過可能に戻す
　　　　availPoint(startPt) = True
　　Next startPt
　　'結果表示
　　Call ShowResult

　　'メッセージ表示
　　Call ShowMsg("一筆探索 終了")

End Sub

'一巡経路探索（出発点へ戻る。一度通過した方向の道は通らない）
Sub SearchReturn()
　　Dim startStt As Integer '出発点の開始交差点番号
　　Dim StartEnd As Integer '出発点の終了交差点番号

　　'メッセージ表示
　　Call ShowMsg("一巡探索 実行中")

　　'結果削除
　　Call ClearResult

　　'道のデータを読み取る。
　　Call GetRoadTable

　　'通行可能片道初期設定 & 通過交差点初期設定
　　ClearAvailableRoad

　　'検索
　　Call GetStartPoint(startStt, StartEnd)　'出発点の範囲取得
　　'大きな数値を入れておく
　　minDistance = 30000
　　For startPt = startStt To StartEnd
　　　　Call ShowMsg("一巡探索 実行中　出発点" + Str(startPt))
　　　　'ルートの履歴設定
　　　　route(1) = startPt
　　　　'出発点1回通過済み
　　　　checkPoint(startPt) = 1
　　　　'出発点startPtから経路検索
　　　　Call SearchReturnRepeat(startPt, 0, 1)
　　　　'出発点を未通過に戻す
　　　　checkPoint(startPt) = 0
　　Next startPt
　　'結果表示
　　Call ShowResult

　　'メッセージ表示
　　Call ShowMsg("一巡探索 終了")

End Sub

'一筆経路探索（一度通過した交差点は通らない）
'現在交差点curPtに居て、作りかけの経路の距離はdistance、既に交差点move個を通過した。
Private Sub SearchMoveRepeat(curPt As Integer, distance As Integer, move As Integer)
　　Dim branch　As Integer　'分岐
　　Dim nextPt　As Integer　'次交差点
　　Dim k　　　 As Integer

　　For branch = 1 To nPoint - 1
　　　　'次交差点番号
　　　　nextPt = (curPt + branch - 1) Mod nPoint + 1
　　　　'次交差点通過可能の場合
　　　　If availPoint(nextPt) Then
　　　　　　'現在の最短距離を越えたら、その先を調べる必要なし。
　　　　　　If minDistance > distance + dist(curPt, nextPt) Then
　　　　　　　　'次交差点を通過するので通過不可能にする
　　　　　　　　availPoint(nextPt) = False
　　　　　　　　'ルートの履歴設定
　　　　　　　　route(move + 1) = nextPt
　　　　　　　　'まだ全交差点を回っていない
　　　　　　　　If move + 1 < nPoint Then
　　　　　　　　　　'経路を延ばす。
　　　　　　　　　　Call SearchMoveRepeat(nextPt, distance + dist(curPt, nextPt), move + 1)
　　　　　　　　'全交差点を回っている場合最短記録更新。
　　　　　　　　Else
　　　　　　　　　　'全距離
　　　　　　　　　　minDistance = distance + dist(curPt, nextPt)
　　　　　　　　　　'全交差点数
　　　　　　　　　　minMove = move + 1
　　　　　　　　　　'全ルート履歴
　　　　　　　　　　For k = 1 To minMove
　　　　　　　　　　　　minRoute(k) = route(k)
　　　　　　　　　　Next k
　　　　　　　　　　'結果表示
　　　　　　　　　　Call ShowResult
　　　　　　　　End If
　　　　　　　　'前の交差点に戻るので，通過可能に戻す
　　　　　　　　availPoint(nextPt) = True
　　　　　　End If
　　　　End If
　　Next branch
End Sub

'一巡経路探索（出発点へ戻る。一度通過した方向の道は通らない）
'現在交差点curPtに居て、作りかけの経路の距離はdistance、既に交差点move個を通過した。
Private Sub SearchReturnRepeat(curPt As Integer, distance As Integer, move As Integer)
　　Dim branch　As Integer '分岐
　　Dim nextPt　As Integer '次交差点
　　Dim k　　　 As Integer

　　For branch = 1 To nPoint - 1
　　　　'次交差点番号
　　　　nextPt = (curPt + branch - 1) Mod nPoint + 1

　　　　'次交差点片道が通過可能の場合
　　　　If availRoad(curPt, nextPt) Then
　　　　　　'現在の最短距離を越えたら、その先を調べる必要なし。
　　　　　　If minDistance > distance + dist(curPt, nextPt) Then
　　　　　　　　'次交差点への片道を通過するので通過不可能にする
　　　　　　　　availRoad(curPt, nextPt) = False
　　　　　　　　'次交差点の通行回数を増加する
　　　　　　　　checkPoint(nextPt) = checkPoint(nextPt) + 1
　　　　　　　　'ルートの履歴設定
　　　　　　　　route(move + 1) = nextPt
　　　　　　　　'まだ全交差点を回っていない
　　　　　　　　If Not CheckAllPoint(move) Then
　　　　　　　　　　'次交差点が出発点でない（全交差点未周回で出発点にもどると打ち切り）
　　　　　　　　　　If nextPt <> startPt Then
　　　　　　　　　　　　'経路を延ばす。
　　　　　　　　　　　　Call SearchReturnRepeat(nextPt, distance + dist(curPt, nextPt), move + 1)
　　　　　　　　　　End If
　　　　　　　　'全交差点を回っている場合，出発点を加える
　　　　　　　　Else
　　　　　　　　　　'現在の最短距離を越えたら、その先を調べる必要なし。
　　　　　　　　　　If minDistance > distance + dist(curPt, nextPt) + dist(nextPt, startPt) Then
　　　　　　　　　　　　'最短記録更新。
　　　　　　　　　　　　route(move + 2) = startPt 'ルートの最後に出発点設定
　　　　　　　　　　　　minDistance = distance + dist(curPt, nextPt) + dist(nextPt, startPt)
　　　　　　　　　　　　minMove = move + 2
　　　　　　　　　　　　For k = 1 To minMove
　　　　　　　　　　　　　　minRoute(k) = route(k)
　　　　　　　　　　　　Next k
　　　　　　　　　　　　'結果表示
　　　　　　　　　　　　Call ShowResult
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　'前の交差点に戻るので，通過可能に戻す
　　　　　　　　availRoad(curPt, nextPt) = True
　　　　　　　　'前の交差点に戻るので，通過回数を戻す
　　　　　　　　checkPoint(nextPt) = checkPoint(nextPt) - 1
　　　　　　End If
　　　　End If
　　Next branch
End Sub

'全交差点を通過したかどうか。
Private Function CheckAllPoint(move As Integer)
　　Dim i As Integer
　　Dim pass As Integer '通過交差点数

　　CheckAllPoint = False
　　 '交差点の通過数が全交差点数以下なら絶対無理
　　If move + 1 < nPoint Then Exit Function

　　pass = 0
　　For i = 1 To nPoint
　　　　'通過済み交差点のカウント
　　　　If checkPoint(i) > 0 Then pass = pass + 1
　　Next i

　　'通過済み交差点数が全交差点数と等しい
　　CheckAllPoint = (pass = nPoint)
End Function

'道のデータを読み取る。
Private Sub GetStartPoint(startStt As Integer, StartEnd As Integer)
　　Dim stt As Integer '指定出発点番号

　　stt = Range("start")
　　If stt = 0 Then
　　　　startStt = 1
　　　　StartEnd = nPoint
　　Else
　　　　startStt = stt
　　　　StartEnd = stt
　　End If
End Sub

'道のデータを読み取る。
Private Sub GetRoadTable()
　　Dim i As Integer
　　Dim j As Integer

　　nPoint = Range("points").Value
　　With Range("road")
　　　　For i = 1 To nPoint
　　　　　　For j = 1 To nPoint
　　　　　　dist(i, j) = .Cells(i, j).Value
　　　　　　Next j
　　　　Next i
　　End With
End Sub

'通行可能交差点初期設定
Private Sub ClearAvailablePoint()
　　Dim i As Integer

　　For i = 1 To nPoint
　　　　availPoint(i) = True
　　Next i
End Sub

'通行可能片道初期設定 & 通過交差点初期設定
Private Sub ClearAvailableRoad()
　　Dim i As Integer
　　Dim j As Integer

　　For i = 1 To nPoint
　　　　checkPoint(i) = False '最初は全交差点未通過
　　　　For j = 1 To nPoint
　　　　　　availRoad(i, j) = dist(i, j) > 0 '片道に距離が設定されていたらTrue
　　　　Next j
　　Next i
End Sub

'結果を削除
Private Sub ClearResult()
　　Dim k As Integer

　　Range("minDistance").Clear
　　With Range("route")
　　　　For k = 1 To 20
　　　　　　.Cells(k, 1).Clear
　　　　Next k
　　End With
End Sub

'結果を表示
Private Sub ShowResult()
　　Dim k As Integer

　　Range("minDistance").Value = minDistance
　　With Range("route")
　　　　For k = 1 To minMove
　　　　　　.Cells(k, 1).Value = minRoute(k)
　　　　Next k
　　.Range(Cells(minMove + 1, 1), Cells(minMove * 2, 1)).Value = ""
　　End With
End Sub

'メッセージを表示
Private Sub ShowMsg(msg As String)
　　Range("message").Value = msg
End Sub

回答No.2

ykkw_2001

＞プログラムを組んでもらいました。
ということは、
スタートが交差点ｘで、ゴールが交差点1のとき
から
＞スタートが交差点ｘで、ゴールが交差点14のとき
まで、出てくるのがあるっていう風に読み取れるのですが、違いますか？

もしそうなら、スタート、ゴールを入力させて、合致する答えのみ表示させればいいのではないですか？

素人の人が、計算の部分を触らずに、入出力だけ細工して済むなら、最良の解決法です。（企業においては・・）

お礼

ご回答、ありがとうございます。
組んでもらったプログラムは、入力する部分はスタートのみだったものです。

以下が、組んでもらったプログラムです。
このうち、一筆経路探索の方です。

Option Explicit

Public nPoint As Integer '交差点の数
Public dist(20, 20) As Integer '距離を入れておくテーブル
Public availRoad(20, 20) As Boolean '片道通過可能テーブル　既に通ったかどうかを記録
Public availPoint(20) As Boolean '交差点通過可能配列　交差点を既に通ったかどうかを記録
Public checkPoint(20) As Integer '交差点通過回数配列
Public move As Integer '現在作りかけの経路の通過する交差点の延べ数
Public route(50) As Integer '現在作りかけの経路
Public distance As Integer '現在作りかけの経路の距離
Public minRoute(50) As Integer 'これまでに見つかった最短経路
Public minMove As Integer 'これまでに見つかった最短経路の通過する交差点の延べ数
Public minDistance As Integer 'これまでに見つかった最短経路の距離
Public startPt As Integer '出発交差点

'一筆経路探索（一度通過した交差点は通らない）
Sub SearchMove()
Dim startStt As Integer '出発点の開始交差点番号
Dim StartEnd As Integer '出発点の終了交差点番号

ShowMsg "一筆探索 実行中" 'メッセージ表示

ClearResult '結果削除

GetRoadTable '道のデータを読み取る。

ClearAvailablePoint '通行可能交差点初期設定

'検索
GetStartPoint startStt, StartEnd '出発点の範囲取得
minDistance = 30000 '大きな数値を入れておく

For startPt = startStt To StartEnd
ShowMsg "一筆探索 実行中　出発点" + str(startPt)
availPoint(startPt) = False '出発点通過するので通過不可能にする
route(1) = startPt 'ルートの履歴設定
SearchMoveRepeat startPt, 0, 1 '出発点startPtから経路検索
availPoint(startPt) = True '通過可能に戻す
Next
'結果表示
ShowResult

'メッセージ表示
ShowMsg "一筆探索 終了"

End Sub

'一巡経路探索（出発点へ戻る。一度通過した方向の道は通らない）
Sub SearchReturn()
Dim startStt As Integer '出発点の開始交差点番号
Dim StartEnd As Integer '出発点の終了交差点番号

ShowMsg "一巡探索 実行中" 'メッセージ表示

ClearResult '結果削除

GetRoadTable '道のデータを読み取る。

ClearAvailableRoad '通行可能片道初期設定 & 通過交差点初期設定

'検索
GetStartPoint startStt, StartEnd '出発点の範囲取得
minDistance = 30000 '大きな数値を入れておく
For startPt = startStt To StartEnd
ShowMsg "一巡探索 実行中　出発点" + str(startPt)
route(1) = startPt 'ルートの履歴設定
checkPoint(startPt) = 1 '出発点1回通過済み
SearchReturnRepeat startPt, 0, 1 '出発点startPtから経路検索
checkPoint(startPt) = 0 '出発点を未通過に戻す
Next
'結果表示
ShowResult

'メッセージ表示
ShowMsg "一巡探索 終了"

End Sub

'一筆経路探索（一度通過した交差点は通らない）
'現在交差点curPtに居て、作りかけの経路の距離はdistance、既に交差点move個を通過した。
Private Sub SearchMoveRepeat(curPt As Integer, distance As Integer, move As Integer)
Dim branch As Integer '分岐
Dim nextPt As Integer '次交差点
Dim k As Integer

For branch = 1 To nPoint - 1
nextPt = (curPt + branch - 1) Mod nPoint + 1 '次交差点番号
If availPoint(nextPt) Then '次交差点通過可能の場合
If minDistance > distance + dist(curPt, nextPt) Then '現在の最短距離を越えたら、その先を調べる必要なし。
availPoint(nextPt) = False '次交差点を通過するので通過不可能にする
route(move + 1) = nextPt 'ルートの履歴設定
If move + 1 < nPoint Then 'まだ全交差点を回っていない
SearchMoveRepeat nextPt, distance + dist(curPt, nextPt), move + 1 '経路を延ばす。
Else '全交差点を回っている場合最短記録更新。
minDistance = distance + dist(curPt, nextPt) '全距離
minMove = move + 1 '全交差点数
For k = 1 To minMove '全ルート履歴
minRoute(k) = route(k)
Next
ShowResult '結果表示
End If
availPoint(nextPt) = True '前の交差点に戻るので，通過可能に戻す
End If
End If
Next
End Sub

'一巡経路探索（出発点へ戻る。一度通過した方向の道は通らない）
'現在交差点curPtに居て、作りかけの経路の距離はdistance、既に交差点move個を通過した。
Private Sub SearchReturnRepeat(curPt As Integer, distance As Integer, move As Integer)
Dim branch As Integer '分岐
Dim nextPt As Integer '次交差点
Dim k As Integer

For branch = 1 To nPoint - 1
nextPt = (curPt + branch - 1) Mod nPoint + 1 '次交差点番号
If availRoad(curPt, nextPt) Then '次交差点片道が通過可能の場合
If minDistance > distance + dist(curPt, nextPt) Then '現在の最短距離を越えたら、その先を調べる必要なし。
availRoad(curPt, nextPt) = False '次交差点への片道を通過するので通過不可能にする
checkPoint(nextPt) = checkPoint(nextPt) + 1 '次交差点の通行回数を増加する
route(move + 1) = nextPt 'ルートの履歴設定
If Not CheckAllPoint(move) Then 'まだ全交差点を回っていない
If nextPt <> startPt Then '次交差点が出発点でない（全交差点未周回で出発点にもどると打ち切り）
SearchReturnRepeat nextPt, distance + dist(curPt, nextPt), move + 1 '経路を延ばす。
End If
Else '全交差点を回っている場合，出発点を加える
If minDistance > distance + dist(curPt, nextPt) + dist(nextPt, startPt) Then '現在の最短距離を越えたら、その先を調べる必要なし。
'最短記録更新。
route(move + 2) = startPt 'ルートの最後に出発点設定
minDistance = distance + dist(curPt, nextPt) + dist(nextPt, startPt)
minMove = move + 2
For k = 1 To minMove
minRoute(k) = route(k)
Next
ShowResult '結果表示
End If
End If
availRoad(curPt, nextPt) = True '前の交差点に戻るので，通過可能に戻す
checkPoint(nextPt) = checkPoint(nextPt) - 1 '前の交差点に戻るので，通過回数を戻す
End If
End If
Next
End Sub

'全交差点を通過したかどうか。
Private Function CheckAllPoint(move As Integer)
Dim i As Integer
Dim pass As Integer '通過交差点数

CheckAllPoint = False
If move + 1 < nPoint Then Exit Function '交差点の通過数が全交差点数以下なら絶対無理

pass = 0
For i = 1 To nPoint
If checkPoint(i) > 0 Then pass = pass + 1 '通過済み交差点のカウント
Next

CheckAllPoint = (pass = nPoint) '通過済み交差点数が全交差点数と等しい
End Function

'道のデータを読み取る。
Private Sub GetStartPoint(startStt As Integer, StartEnd As Integer)
Dim stt As Integer '指定出発点番号

stt = Range("start")
If stt = 0 Then
startStt = 1
StartEnd = nPoint
Else
startStt = stt
StartEnd = stt
End If
End Sub

'道のデータを読み取る。
Private Sub GetRoadTable()
Dim i As Integer
Dim j As Integer

nPoint = Range("points").Value
With Range("road")
For i = 1 To nPoint
For j = 1 To nPoint
dist(i, j) = .Cells(i, j).Value
Next
Next
End With
End Sub

'通行可能交差点初期設定
Private Sub ClearAvailablePoint()
Dim i As Integer

For i = 1 To nPoint
availPoint(i) = True
Next
End Sub

'通行可能片道初期設定 & 通過交差点初期設定
Private Sub ClearAvailableRoad()
Dim i As Integer
Dim j As Integer

For i = 1 To nPoint
checkPoint(i) = False '最初は全交差点未通過
For j = 1 To nPoint
availRoad(i, j) = dist(i, j) > 0 '片道に距離が設定されていたらTrue
Next
Next
End Sub

'結果を削除
Private Sub ClearResult()
Dim k As Integer

Range("minDistance").Clear
With Range("route")
For k = 1 To 20
.Cells(k, 1).Clear
Next k
End With
End Sub

'結果を表示
Private Sub ShowResult()
Dim k As Integer

Range("minDistance").Value = minDistance
With Range("route")
For k = 1 To minMove
.Cells(k, 1).Value = minRoute(k)
Next k
.Range(Cells(minMove + 1, 1), Cells(minMove * 2, 1)).Value = ""
End With
End Sub

'メッセージを表示
Private Sub ShowMsg(msg As String)
Range("message").Value = msg
End Sub

回答No.1

TAGOSAKU7

見てみたいですー

お礼

ありがとうございます。
見ていただけますか？

以下が組んでもらったプログラムで「一筆経路探索」の方です。

Option Explicit

Public nPoint As Integer '交差点の数
Public dist(20, 20) As Integer '距離を入れておくテーブル
Public availRoad(20, 20) As Boolean '片道通過可能テーブル　既に通ったかどうかを記録
Public availPoint(20) As Boolean '交差点通過可能配列　交差点を既に通ったかどうかを記録
Public checkPoint(20) As Integer '交差点通過回数配列
Public move As Integer '現在作りかけの経路の通過する交差点の延べ数
Public route(50) As Integer '現在作りかけの経路
Public distance As Integer '現在作りかけの経路の距離
Public minRoute(50) As Integer 'これまでに見つかった最短経路
Public minMove As Integer 'これまでに見つかった最短経路の通過する交差点の延べ数
Public minDistance As Integer 'これまでに見つかった最短経路の距離
Public startPt As Integer '出発交差点

'一筆経路探索（一度通過した交差点は通らない）
Sub SearchMove()
Dim startStt As Integer '出発点の開始交差点番号
Dim StartEnd As Integer '出発点の終了交差点番号

ShowMsg "一筆探索 実行中" 'メッセージ表示

ClearResult '結果削除

GetRoadTable '道のデータを読み取る。

ClearAvailablePoint '通行可能交差点初期設定

'検索
GetStartPoint startStt, StartEnd '出発点の範囲取得
minDistance = 30000 '大きな数値を入れておく

For startPt = startStt To StartEnd
ShowMsg "一筆探索 実行中　出発点" + str(startPt)
availPoint(startPt) = False '出発点通過するので通過不可能にする
route(1) = startPt 'ルートの履歴設定
SearchMoveRepeat startPt, 0, 1 '出発点startPtから経路検索
availPoint(startPt) = True '通過可能に戻す
Next
'結果表示
ShowResult

'メッセージ表示
ShowMsg "一筆探索 終了"

End Sub

'一巡経路探索（出発点へ戻る。一度通過した方向の道は通らない）
Sub SearchReturn()
Dim startStt As Integer '出発点の開始交差点番号
Dim StartEnd As Integer '出発点の終了交差点番号

ShowMsg "一巡探索 実行中" 'メッセージ表示

ClearResult '結果削除

GetRoadTable '道のデータを読み取る。

ClearAvailableRoad '通行可能片道初期設定 & 通過交差点初期設定

'検索
GetStartPoint startStt, StartEnd '出発点の範囲取得
minDistance = 30000 '大きな数値を入れておく
For startPt = startStt To StartEnd
ShowMsg "一巡探索 実行中　出発点" + str(startPt)
route(1) = startPt 'ルートの履歴設定
checkPoint(startPt) = 1 '出発点1回通過済み
SearchReturnRepeat startPt, 0, 1 '出発点startPtから経路検索
checkPoint(startPt) = 0 '出発点を未通過に戻す
Next
'結果表示
ShowResult

'メッセージ表示
ShowMsg "一巡探索 終了"

End Sub

'一筆経路探索（一度通過した交差点は通らない）
'現在交差点curPtに居て、作りかけの経路の距離はdistance、既に交差点move個を通過した。
Private Sub SearchMoveRepeat(curPt As Integer, distance As Integer, move As Integer)
Dim branch As Integer '分岐
Dim nextPt As Integer '次交差点
Dim k As Integer

For branch = 1 To nPoint - 1
nextPt = (curPt + branch - 1) Mod nPoint + 1 '次交差点番号
If availPoint(nextPt) Then '次交差点通過可能の場合
If minDistance > distance + dist(curPt, nextPt) Then '現在の最短距離を越えたら、その先を調べる必要なし。
availPoint(nextPt) = False '次交差点を通過するので通過不可能にする
route(move + 1) = nextPt 'ルートの履歴設定
If move + 1 < nPoint Then 'まだ全交差点を回っていない
SearchMoveRepeat nextPt, distance + dist(curPt, nextPt), move + 1 '経路を延ばす。
Else '全交差点を回っている場合最短記録更新。
minDistance = distance + dist(curPt, nextPt) '全距離
minMove = move + 1 '全交差点数
For k = 1 To minMove '全ルート履歴
minRoute(k) = route(k)
Next
ShowResult '結果表示
End If
availPoint(nextPt) = True '前の交差点に戻るので，通過可能に戻す
End If
End If
Next
End Sub

'一巡経路探索（出発点へ戻る。一度通過した方向の道は通らない）
'現在交差点curPtに居て、作りかけの経路の距離はdistance、既に交差点move個を通過した。
Private Sub SearchReturnRepeat(curPt As Integer, distance As Integer, move As Integer)
Dim branch As Integer '分岐
Dim nextPt As Integer '次交差点
Dim k As Integer

For branch = 1 To nPoint - 1
nextPt = (curPt + branch - 1) Mod nPoint + 1 '次交差点番号
If availRoad(curPt, nextPt) Then '次交差点片道が通過可能の場合
If minDistance > distance + dist(curPt, nextPt) Then '現在の最短距離を越えたら、その先を調べる必要なし。
availRoad(curPt, nextPt) = False '次交差点への片道を通過するので通過不可能にする
checkPoint(nextPt) = checkPoint(nextPt) + 1 '次交差点の通行回数を増加する
route(move + 1) = nextPt 'ルートの履歴設定
If Not CheckAllPoint(move) Then 'まだ全交差点を回っていない
If nextPt <> startPt Then '次交差点が出発点でない（全交差点未周回で出発点にもどると打ち切り）
SearchReturnRepeat nextPt, distance + dist(curPt, nextPt), move + 1 '経路を延ばす。
End If
Else '全交差点を回っている場合，出発点を加える
If minDistance > distance + dist(curPt, nextPt) + dist(nextPt, startPt) Then '現在の最短距離を越えたら、その先を調べる必要なし。
'最短記録更新。
route(move + 2) = startPt 'ルートの最後に出発点設定
minDistance = distance + dist(curPt, nextPt) + dist(nextPt, startPt)
minMove = move + 2
For k = 1 To minMove
minRoute(k) = route(k)
Next
ShowResult '結果表示
End If
End If
availRoad(curPt, nextPt) = True '前の交差点に戻るので，通過可能に戻す
checkPoint(nextPt) = checkPoint(nextPt) - 1 '前の交差点に戻るので，通過回数を戻す
End If
End If
Next
End Sub

'全交差点を通過したかどうか。
Private Function CheckAllPoint(move As Integer)
Dim i As Integer
Dim pass As Integer '通過交差点数

CheckAllPoint = False
If move + 1 < nPoint Then Exit Function '交差点の通過数が全交差点数以下なら絶対無理

pass = 0
For i = 1 To nPoint
If checkPoint(i) > 0 Then pass = pass + 1 '通過済み交差点のカウント
Next

CheckAllPoint = (pass = nPoint) '通過済み交差点数が全交差点数と等しい
End Function

'道のデータを読み取る。
Private Sub GetStartPoint(startStt As Integer, StartEnd As Integer)
Dim stt As Integer '指定出発点番号

stt = Range("start")
If stt = 0 Then
startStt = 1
StartEnd = nPoint
Else
startStt = stt
StartEnd = stt
End If
End Sub

'道のデータを読み取る。
Private Sub GetRoadTable()
Dim i As Integer
Dim j As Integer

nPoint = Range("points").Value
With Range("road")
For i = 1 To nPoint
For j = 1 To nPoint
dist(i, j) = .Cells(i, j).Value
Next
Next
End With
End Sub

'通行可能交差点初期設定
Private Sub ClearAvailablePoint()
Dim i As Integer

For i = 1 To nPoint
availPoint(i) = True
Next
End Sub

'通行可能片道初期設定 & 通過交差点初期設定
Private Sub ClearAvailableRoad()
Dim i As Integer
Dim j As Integer

For i = 1 To nPoint
checkPoint(i) = False '最初は全交差点未通過
For j = 1 To nPoint
availRoad(i, j) = dist(i, j) > 0 '片道に距離が設定されていたらTrue
Next
Next
End Sub

'結果を削除
Private Sub ClearResult()
Dim k As Integer

Range("minDistance").Clear
With Range("route")
For k = 1 To 20
.Cells(k, 1).Clear
Next k
End With
End Sub

'結果を表示
Private Sub ShowResult()
Dim k As Integer

Range("minDistance").Value = minDistance
With Range("route")
For k = 1 To minMove
.Cells(k, 1).Value = minRoute(k)
Next k
.Range(Cells(minMove + 1, 1), Cells(minMove * 2, 1)).Value = ""
End With
End Sub

'メッセージを表示
Private Sub ShowMsg(msg As String)
Range("message").Value = msg
End Sub