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

質問

すいません。数学に関してまったくの素人です。
建築の学生なのですが、卒論の対象地の一つの分析として次のようなことを行っております。

「対象地に12の交差点があって
１．この交差点全てを最短経路でまわりたい。（スタートとゴールがいっしょ。）
２．交差点全てを最短経路で通過したい。（スタートとゴールはちがう）

ということをやるようになってます。
１．に関しては巡回セールスマン問題の分岐限定法でパズル的にとけばいいのでしょうか？
２．に関してはまったくわかりません。そもそもどのようにスタートとゴールを設定すればいいのか・・・
また上記のような場合に適応できるプログラムは出回っているのでしょうか？もしくは自分で作れるものなのでしょうか？プログラムに関してもまったく素人です。

このように質問ばかりですいません。書いてあることでわからないことがあれば、言ってください。わかるかたご教授ください。お願いします。

回答No.4

stomachman · ベストアンサー

交差点数12、「片道」の数50（各交差点が４ないし５叉路）という条件で、少しだけ改良したバージョンでテストしました。（ちょっとした無駄な探索の削除（枝刈り）、ルートのテストの高速化も入れました。）
　巡回路ではなく、全部の交差点を通れば良いという条件で走らせてみたところ、出発点をふくめて数えて４つめの交差点の選択が変更されるまでに25分（PowerBook G3 333MHz、Microsoft Excel98）。ということは、２つ目の交差点の候補を全部調べ終わるにはさらに16倍=8時間、出発点を変えて全部調べるのに4日ぐらいという見積になります。

　ところがですよ、visual basicてのは表示がめちゃくちゃ遅いのです。だから途中経過の表示をやめればうんと速くなります。
余計な表示を止めた、ちょっとだけ改良版では、交差点数12、「片道」の数50（各交差点が４ないし５叉路）の巡回路で約６分でした。（実に表示に４日かかってたわけですね！）

プログラムは以下の通りです。

Dim nPoint As Integer
Dim dist(20, 20)
Dim available(20, 20) As Boolean
Dim move As Integer
Dim route(100) As Integer
Dim minRoute(100) As Integer
Dim visit(20) As Integer
Dim minMove As Integer
Dim minDistance

Sub check()
getRoad
clearAvailable
showMinDistance 'just for fun
k = nPoint
k = 1 'for round trip
For i = 1 To k
For j = 1 To nPoint
visit(j) = 0
Next j
route(0) = i
visit(i) = visit(i) + 1
Call search(i, 0, 0)
Next i
Call putResult
End Sub

Private Sub search(i, distance, move)
For jj = i To i + nPoint - 2
j = (jj Mod nPoint) + 1
goon = available(i, j) And (dist(i, j) > 0)
If goon Then
If visit(i) > 1 And move > 0 Then
goon = (route(move - 1) <> j)
End If
End If
If goon Then
available(i, j) = False
route(move + 1) = j
visit(j) = visit(j) + 1
If minDistance > distance + dist(i, j) Then
If roundTrip(move + 1) Then
minDistance = distance + dist(i, j)
showMinDistance 'just for fun
minMove = move + 1
For k = 0 To minMove
minRoute(k) = route(k)
Next k
Else
Call search(j, distance + dist(i, j), move + 1)
End If
End If
available(i, j) = True
visit(j) = visit(j) - 1
End If
Next jj
End Sub

Private Sub showMinDistance()
Range("minDistance") = minDistance
End Sub

Private Sub putResult()
showMinDistance
With Range("route")
For k = 0 To minMove
.Cells(k + 1, 1) = minRoute(k)
Next k
.Cells(minMove + 2, 1) = ""
End With
End Sub

Private Function roundTrip(m)
rountTrip = False
If m < nPoint Then Exit Function
If route(m) <> route(0) Then Exit Function 'for round trip
For kk = 1 To nPoint
If visit(kk) = 0 Then Exit Function
Next kk
roundTrip = True
End Function

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

Private Sub clearAvailable()
For i = 1 To nPoint
For j = 1 To nPoint
available(i, j) = (dist(i, j) > 0)
Next j
Next i
End Sub

なお、
Dim route(100) As Integer
Dim minRoute(100) As Integer
の100てのは扱える「片道」の数の上限です。
また、 'for round trip　の付いている行を取り除けば、巡回経路じゃなく、最短経路探索のプログラムになります。
このプログラムに残っている 'just for funの表示部分は実行される回数がごく少ないので、このままにしておきましょう。

また、d(i,j)の行列が対称でなくても構いません。

お礼

stomachmanさん。ありがとうございました。

本来、対象地の図面、交差点データ、街路データなどを準備しないと非常にやりずらかったはずなのに、それなしで面倒を見ていただいたことに本当に感謝です。

その後、なんとか自身のつてをたよりプログラムの相談者が見つかり解決することできました。やはり実際に図面を見ないと、僕の説明が非常に悪かったらしく、解釈が微妙にずれていたことを指摘されました。

では、ありがとうございました。

回答No.3

stomachman

24時間懸かっても全然進まない・・・う～ん、テストしたんですけどねえ？
何か間違えたかなあ？もういっぺんテストしてみますね。

えっと、多分交差点の間の道の数がやたら多いのではないかと思います。せいぜい四つ角ぐらいかと思ってたんですが。

まずは、交差点数６～８、各３～４つ辻ぐらいで走らせてみて、旨く動くかどうかテストした方が良さそうですね。

行きと帰りで「距離」が違う場合には、入力する行列が対称でなくなるだけと思います。

回答No.2

kony0

２．について、とりあえず答えを出したいだけだったら。。。

節点が１２個しかないですし、スタートとゴールの選び方はたかだか６６通り。
で、スタートとゴールの２点と距離０の枝で結ぶダミー節点をもうけて、そのダミーを出発点とする巡回セールスマン問題を解くというのを６６回やって、そのうちの最短なものを選べば、一応答えが出そうな気がします。

＃アドバイスにもならないなぁ、こんな力業じゃ。^^;

お礼

kony0さんありがとうございます。

ダミー節点の話は、なんとなくはわかります。ありがとうございました。

お礼が遅くなってすいませんでした。
現在、身近にプログラムに詳しい人を頼りつつ、なんとか解決しようとしている日々です。

nintai

回答No.1

stomachman

この当たりの板では回答を手加減するのが慣例ですが、めんどくさいので書いちゃいます。

「同じ道を同じ向きに２度以上通る経路は最短経路ではない」
これは直感的にお分かりになるかと思います。

仰るとおり、出発点に戻る問題の方が扱いやすそうです。

「問題の地図が、ある部分と残りとが１本の道Rだけで繋がっているように分けられる」（これは、「道Rを切ると、地図が２つに分かれる」と言い換えることもできます。）という場合には、必ず一本道Rを丁度一往復する。「同じ道を同じ向きに２度以上通るのは最短経路ではない」から同じ向きに2度通ることはなく、しかし一往復しないと地図全部を網羅して出発地点に帰れないからです。
このようにして、まず一本道を全部取り外して、幾つかの問題に分割してしまいます。（分けた一方が交差点１個だけから成る地図、ということもあり得ます。）

また、「ある交差点Pを取り除くと、地図が２つ以上に分けられる」というかなめの点Pがあったら、これもしめた物です。Pを通らなくては各部分を渡り歩けない訳ですから、Pを取り除いた地図それぞれにPを付加して、幾つかの小さい問題に分割することができる。

こういう処置をして、かなめの点も一本道もない地図が得られます。これ以上簡単にはなりそうにない。
この地図上で、巡回問題はどうすればよいのか。総当たりしかなさそうですね。
高々１２地点しかないんだから、たいしたことはありません。しかし同じ地点に何度も戻ってくる必要があるかもしれない、ということに留意する必要があります。下手な探索をやると無限ループに嵌ってしまう。AからBへ行ってAへ行ってBへ行って…
無限ループを避けるには「同じ道を同じ向きに２度以上通るのは最短経路ではない。」ということを利用すると良いです。つまり、例えばA地点とB地点を結ぶ道を「AからBへの道」「BからAへの道」の２つの「片道」に分けて考える。全部の道をこのように分けて、一度通過した片道は二度と使えないように×印をつけてしまう。そうやって探索(search)をすれば良いのではないかな？
一番単純なのは、どこでも良いから出発点として、行ける所へ行く（そして片道に×をつける）。どんどん行く。全部の点を踏破し出発点に帰った（ら経路と距離を記録する）か、どこにも行けなくなったら、ひとつ戻って（戻った道の×を消す）、別の道を行ってみる。そうやって、出発点からどこにも行くところがなくなるまで繰り返す。最後に最短記録を調べる。
　これは木の探索(tree search)の問題です。

　出発点に戻ってこなくて構わない、という問題の方はどうしましょう？
出発点を決めてひとつづつ調べるしかないようです。最後にどこに行き着こうが、全部の交差点を通ったら一つの経路が得られたことになる。
この場合にも、一本道やかなめの点の概念を利用すれば、無駄な探索はだいぶ減らせそうですね。

　まあ取りあえず、一本道、かなめの点も含めて探索をやるプログラムを書いてみましょう。Excelとvisual basicならお持ちでしょう。

　以下は手抜きです。もう少し工夫して高速化できるけど、まあいいや。
　まず、交差点に1から順に番号を割り当てておきます。
Excelのワークシートを用意し、
・一つのセルに名前「points」を付け、交差点の数を入力します。たとえば12と入れる。
・points行、points列の正方形の領域を選択して「road」と名前を付け、交差点iから交差点jまでの距離を、この正方形領域のi行j列のセルとj行i列のセルに入力します。全ての道をこのようにして入力し、残りのセルは空白にしておきます。
・一つのセルに名前「minDistance」を付けます。ここに最短経路の長さを表示させる。
・縦一列のセル（数十行分あれば良いでしょう）に名前「route」を付けます。ここに経路を表示させる。

このワークシートにVisual Basicの標準モジュールを付け加えて、以下のプログラムを入力します。
んで、マクロ「sagase」を実行する。そのうち答が出るでしょう。

以下のプログラム中で、
(#1)と(#4)の行は出発点に戻ってくるという条件の場合に必要で、戻ってこなくて良いという条件なら削除します。
(#2)と(#3)の行は、探索を待っている間に途中経過を眺めて気を紛らわすためのもので、削除した方が速くなりますが、コンピュータが動いていると確信したければこのまま。

このアルゴリズムは木の深さ優先探索です。

Dim nPoint As Integer '交差点の数
Dim dist(20, 20) '距離を入れておくテーブル。dist(i,j)=dist(j,i)である。
Dim available(20, 20) As Boolean '片道を既に通ったかどうかを記録するテーブル
Dim move As Integer　'現在作りかけの経路の通過する交差点の延べ数
Dim route(50) As Integer　'現在作りかけの経路
Dim distance　'現在作りかけの経路の距離
Dim minRoute(50) As Integer 'これまでに見つかった最短経路
Dim minMove As Integer 'これまでに見つかった最短経路の通過する交差点の延べ数
Dim minDistance 'これまでに見つかった最短経路の距離

Sub sagase()
getRoad
clearAvailable
k = nPoint
k = 1 'for round trip (#1)
For i = 1 To k
route(0) = i
Call search(i, 0, 0)
Next i
Call putResult(minMove, minDistance) '結果を表示
End Sub

Sub search(i, distance, move) '現在交差点iに居て、作りかけの経路の距離はdistance、既に交差点move個を通過した。
For jj = i To i + nPoint - 2
j = (jj Mod nPoint) + 1
If available(i, j) And (dist(i, j) > 0) Then
available(i, j) = False
route(move + 1) = j
Call showOne(move + 1, minDistance) 'just for fun (#2)
If minDistance > distance + dist(i, j) Then 'これまでに見つかっている最短距離を越えたら、その先を調べる必要なし。
If roundTrip(move + 1) Then '経路が見つかったなら、最短記録更新。
minDistance = distance + dist(i, j)
minMove = move + 1
For k = 1 To minMove
minRoute(k) = route(k)
Next k
Else
Call search(j, distance + dist(i, j), move + 1) '経路を延ばす。
End If
End If
Call hideOne(move + 1) 'just for fun (#3)
available(i, j) = True '今のは、なし。
End If
Next jj
End Sub
Private Sub showOne(m, d)
Range("minDistance") = d
Range("route").Cells(m + 1, 1) = route(m)
End Sub
Private Sub hideOne(m)
Range("route").Cells(m + 1, 1) = ""
End Sub

Private Sub putResult(m, d) '結果を表示
Range("minDistance") = d
With Range("route")
For k = 0 To m
.Cells(k + 1, 1) = route(k)
Next k
.Cells(m + 2, 1) = ""
End With
End Sub
Private Function roundTrip(m) '経路が見つかったかどうか。
Dim checklist(20) As Boolean
rountTrip = False
If m < nPoint Then Exit Function
If route(m) <> route(0) Then Exit Function 'for round trip　(#4)
For i = 1 To nPoint + 1
checklist(i) = False
Next i
For j = 1 To m
checklist(route(j)) = True
Next j
i = 1
While checklist(i)
i = i + 1
Wend
roundTrip = (i > nPoint)
End Function
Private Sub getRoad() '道のデータを読み取る。
Sum = 0
nPoint = Range("points").Value
With Range("road")
For i = 1 To nPoint
For j = 1 To nPoint
dist(i, j) = .Cells(i, j).Value
Sum = Sum + dist(i, j)
Next j
Next i
End With
minDistance = Sum * 2 '最短経路は絶対にこれよりは短い。
End Sub
Private Sub clearAvailable()
For i = 1 To nPoint
For j = 1 To nPoint
available(i, j) = (dist(i, j) > 0)
Next j
Next i
End Sub

お礼

stomachmanさん

本当に、本当にありがとうございます。
さっそくやってみました。
しかし10時間ぐらいたっても「実行中」となってました。
まだ計算しているんでしょうか？
私の入力の仕方にもんだいがあるのでしょうか？
routeの欄で12個ぐらい表示したところからなかなか進まないんですよ。計算してるように見えるんですが。

またdist(i,j)=dist(j,i)ではないときは、（というか坂道があって行きと帰りが微妙に違います。）
簡単に変更できるのですか？

また何か進展がありましたらご報告させていただきます。本当にありがとうございました。

nintai

補足

stomachmanさん、先日はありがとうございました。

あれから24時間ほどパソコンをつけっぱなしにしてみましたが、やはりループ？ですか？してるみたいです。合計4台のパソコンでおなじことしたんですが・・・

では、またちゃんとでるように試行錯誤したいと思います。

nintai