円順列の組合せで最適値を求めたいのですが．．．

こまっています。どなたか教えてください。
プログラムで下の問題を解こうと考えていたのですが．．．

問題は、３０個の重さの違う（ばらつきの範囲は平均から１０％程度）
物を円形に（均等に）並べます。その時の円の中心と重りの組合せ
による重心がもっとも近いものを求めたいのです。
ベクトルの合成で一番小さくなる組合せと考えていただいて
いいと思います。

組合せは２９！通りあるのはわかるのですが．．．
どのように計算して（考えて）いけばよいか見当もつかず困っています。
どうかよろしくお願いします。

No.3 ベストアンサー 回答者： stomachman 回答日時： 2003/02/08 18:55

実地に応用なさろうとしているんだろうと思います。

準最適、だいたい宜しいんじゃないでしょうか、ある許容範囲内に入れば可。という程度で満足できるとするなら、こんなアプローチはどうでしょうか。

(1) ３０個の物を円周上の等間隔３０箇所にランダムに配置し、それらの重心と中心との距離の二乗dを計算します。
(2)２つの物を入れ替えることで、dを改良出来ないか調べます。どの二つを入れ替えてみるかはランダムに選び、dが小さくなるなら実際に入れ替える。

で、(2)を繰り返してdをダンダン改良していくんです。(2)を計算する際には、勿論お分かりでしょうけれど、何もまともに３０個の重心を計算し直さなくても良いから簡単です。
実際、(2)を繰り返してみると、そう何度も入れ替えないうちにdが改良されなくなっちゃうとおもいます。これはlocal minimumに落ち込んでいるんです。
だからここまでを１クール（＜クールってなに？）と数えて、
(3) 何クールもやってみる。そうして一番良かったのを採用するんです。

＊で、ちょっと実験してみました。

・(1)30個の物の質量を0～1の一様乱数で作ってランダムに並べてみたら、d=4.09でした。
・(2)を1000回繰り返しました。
・(3) 100クール試みました。

最も成績が悪かったクールで、d=1.2×10^(-4)
最も成績が良かったクールで、d=8.7×10^(-9)
平均はd=1.1×10^(-5)
でした。
また、(2)を1000回繰り返したうち、実際に入れ替えが起こった回数は平均16.9回でした。

この程度のやり方でも結構イイ線行くものです。計算時間はアッという間ですし。

この回答へのお礼

ありがとうございます
ちょっと返事が遅くなりました。すいません
実際に試していただいたみたいで
ほんとうにありがとうございます。
重心と中心との距離の二乗dを計算するのですね
ランダムに入れ替えるのはちょっと工夫して見ます。

お礼日時：2003/02/09 20:44

No.4 回答者： stomachman 回答日時： 2003/02/12 23:18

では折角ですから、テストに使ったExcel用VBのコードを。

円の半径は1としています。

Dim cnt
Dim wgt(30), sinT(30), cosT(30)
Dim xsum, ysum, wsum2, dist2, wsum2dist2
Dim wgtSv(30), dist2sv, xsumSv, ysumSv

Sub exec() 'メインプログラム
Call initialize
Call calcDist
Call displayThem(0)
For k = 1 To 100
Call shuffle
Call calcDist
Call improveDist(1000)
Call displayThem(k)
Next k
End Sub

Sub initialize() 'excelのworksheetの第一行目からおもりの質量を読みとる。
Pi = 3.14159265358979
cnt = 30 'おもりの個数
dt = 2 * Pi / cnt '円周を分ける角度
wsum = 0
For j = 1 To cnt
wgt(j) = Cells(1, j) 'excelのworksheetの第一行目からおもりの質量を読みとる。
sinT(j) = Sin(j * dt) 'sineのテーブル
cosT(j) = Cos(j * dt) 'cosineのテーブル
wsum = wsum + wgt(j) 'おもりの質量の合計
Next j
wsum2 = wsum ^ 2
End Sub

Sub calcDist() '重心と中心の距離の２乗を計算する。
xsum = 0
ysum = 0
For j = 1 To cnt
xsum = xsum + sinT(j) * wgt(j)
ysum = ysum + cosT(j) * wgt(j)
Next j
wsum2dist2 = ((xsum ^ 2) + (ysum ^ 2))
dist2 = wsum2dist2 / wsum2
End Sub

Sub displayThem(k) '並べ方と、重心と中心の距離の二乗を表示する。
For j = 1 To cnt
Cells(k + 4, j) = wgt(j)
Next j
Cells(k + 4, cnt + 2) = dist2
End Sub

Sub shuffle() 'おもりの順番をランダムに入れ替える
For c1 = 1 To cnt
c2 = c1
While c2 = c1
c2 = Int(Rnd(1) * cnt) + 1
Wend
Call swap(c1, c2)
Next c1
Call calcDist
End Sub

Sub improveDist(rep)
For m = 1 To rep
'2個をランダムに選んで、入れ替えたらどうなるか計算する。
c1 = Int(Rnd(1) * cnt) + 1
c2 = c1
While c2 = c1
c2 = Int(Rnd(1) * cnt) + 1
Wend
xsumTry = xsum - (wgt(c1) - wgt(c2)) * (sinT(c1) - sinT(c2))
ysumTry = ysum - (wgt(c1) - wgt(c2)) * (cosT(c1) - cosT(c2))
wsum2dist2Try = (xsumTry ^ 2) + (ysumTry ^ 2)
If wsum2dist2Try < wsum2dist2 Then '改良されるなら本当に入れ替える。
xsum = xsumTry
ysum = ysumTry
wsum2dist2 = wsum2dist2Try
dist2 = wsum2dist2 / wsum2
Call swap(c1, c2)
End If
Next m
End Sub

Sub swap(c1, c2) '2個のおもりを入れ替える
s = wgt(c1)
wgt(c1) = wgt(c2)
wgt(c2) = s
End Sub

この回答へのお礼

ありがとうございます
早速、使って見ます。

お礼日時：2003/02/13 21:25

No.2 回答者： Largo_sp 回答日時： 2003/02/08 02:12

プログラムで、無限時間かけられるなら、こういうのはどうでしょうか...

収束時間とか全くわかりませんが、
1.対面同士に適当に石を置く。
2.それに対して直角に、２つ置く
3.合成したベクトルに一番近い組み合わせで石を置いていく...
4.すべておき終わったら任意の３つのいれかえで、ベクトルが最小に
なるものをさがす。
5.３つ入れ替えをベクトルが小さくならなくなるまで繰り返す....

というのはどうでしょうか....
極端な話５だけでもいいとおもいますが、1～3を加えたほうが収束が
早くなりそうなきがしたので...

この回答へのお礼

ありがとうございます
３つの入れ替えと最初の置き方が
ポイントですね。
あとは、時間的にどのぐらいかかるか？ですね。
チャレンジしてみます

お礼日時：2003/02/09 20:50

No.1 回答者： eatern27 回答日時： 2003/02/07 23:17

まずは、左右対称になるのは除いて

２９!／２通り
にするのはどうですか?

円順列と見るのではなく、数珠順列(でしたっけ?)と考えるのです。