http://echo.2ch.net/test/read.cgi/tech/1444216746/361 経由で、
あなたは，さいたま動物園の園長に選ばれました．さいたま動物園には全部で10種類の動物たちがいます．あなたの園長としての初仕事は，これらの動物たちをどのオリに入れるかを決めることになりました．
さて，ここで問題なのは，
・動物たちには相性の良し悪しがある．
・相性の悪い動物たちをお互いに近いオリにいれると，みんなが暴れだしてしまう．
・動物たちの不満度が小さくなるようにオリを選んでやる必要がある．
ということです．
動物たちの不満度は，
(各オリの間の距離) × (各動物の間の相性)の総和
で表されます．
さぁ，地図に示されたオリに動物たちをうまく割り当てて，動物たちの不満度が小さい平和な動物園を作ってください．
平和な動物園を作ろう！ ―2次割当て問題って何?― 埼玉大学工学部情報システム工学科池口研究室
手抜きをすべく、Matrix で行あるいは列単位で permutationsDo: を使いたかったのですが、そもそも Matrix は SequenceableCollection のサブクラスではなかったので permutationsDo: は端から使えないことが発覚（ permutationsDo: は SequenceableCollection に定義されている。為念）。そこで、配列の配列を使うことにしました。
ただし素朴にデータだけからなる配列の配列では、並べ替えた際に動物との対応が面倒になるので、key に動物名、value に配列を持たせた Association を要素にしました。
animals := {
'ライオン' -> #(0 2 6 4 6 2 4 4 2 4).
'ワニ' -> #(2 0 4 2 2 2 2 2 2 6).
'ニシキヘビ' -> #(6 4 0 2 6 8 8 6 4 8).
'オオカミ' -> #(4 2 2 0 4 2 6 6 2 6).
'トラ' -> #(6 2 6 4 0 2 4 4 2 4).
'スイギュウ' -> #(2 2 8 2 2 0 6 6 6 8).
'サイ' -> #(4 2 8 6 4 6 0 6 6 4).
'カバ' -> #(4 2 8 6 4 6 6 0 6 6).
'インパラ' -> #(2 2 4 2 2 6 6 6 0 6).
'ゾウ' -> #(4 6 8 6 4 8 4 6 6 0)}.
こうしておけば動物名も一緒にスワップできるので何かと便利で一件落着…かと思いきや、動物をスワップしたら、その動物との相性を記したデータの対応する位置の要素も連動してスワップさせないといけません。
うーむ、やはり permutationsDo: 相当を書くしかないのかな…と諦めかけたのですが、それだとなんか負けた気(謎)がします。
あらためて SequenceableCollection>>#permutationsDo: 内の処理を眺めてみると、size と swap:with: しか使われていないことが分かります。
SequenceableCollection >> permutationsDo: aBlock
"Repeatly value aBlock with a single copy of the receiver. Reorder the copy
so that aBlock is presented all (self size factorial) possible permutations."
"(1 to: 4) permutationsDo: [:each | Transcript cr; show: each printString]"
self shallowCopy permutationsStartingAt: 1 do: aBlock
SequenceableCollection >> permutationsStartingAt: anInteger do: aBlock
"#(1 2 3 4) permutationsDo: [:each | Transcript cr; show: each printString]"
anInteger > self size ifTrue: [^self].
anInteger = self size ifTrue: [^aBlock value: self].
anInteger to: self size do:
[:i | self swap: anInteger with: i.
self permutationsStartingAt: anInteger + 1 do: aBlock.
self swap: anInteger with: i]
つまり、animals に対して swap:with: で前述の処理（行・列要素のスワップの連動）を行なうようなんとか多態させることさえできれば、permutationsDo: を使って手を抜くという目的は果たせそうです。
とはいえ animals を permutationsDo: するためだけに swap:with: を書き換えてしまうのは、何か違う気がするので（というか、ダメ。ゼッタイ。ｗ）、assureUniClass してインスタンス特異的クラスを作成し、インスタンス特異的メソッドとして swap:with: を再定義することにしました。
…というような腑抜けた方針で書いたのが、このコードです。
| animals cages ans |
animals := {
'ライオン' -> #(0 2 6 4 6 2 4 4 2 4).
'ワニ' -> #(2 0 4 2 2 2 2 2 2 6).
'ニシキヘビ' -> #(6 4 0 2 6 8 8 6 4 8).
'オオカミ' -> #(4 2 2 0 4 2 6 6 2 6).
'トラ' -> #(6 2 6 4 0 2 4 4 2 4).
'スイギュウ' -> #(2 2 8 2 2 0 6 6 6 8).
'サイ' -> #(4 2 8 6 4 6 0 6 6 4).
'カバ' -> #(4 2 8 6 4 6 6 0 6 6).
'インパラ' -> #(2 2 4 2 2 6 6 6 0 6).
'ゾウ' -> #(4 6 8 6 4 8 4 6 6 0)}.
cages := #(
(0 3 4 5 8 10 9 6 2 4)
(3 0 4 4 7 9 9 8 5 9)
(4 4 0 2 4 7 5 4 4 8)
(5 4 2 0 3 5 5 5 5 9)
(8 7 4 3 0 3 5 6 8 12)
(10 9 7 5 3 0 4 7 10 14)
(9 9 5 5 5 4 0 3 8 11)
(6 8 4 5 6 7 3 0 5 8)
(2 5 4 5 8 10 8 5 0 4)
(4 9 8 9 12 14 11 8 4 0)).
ans := Set new -> Float infinity.
animals assureUniClass class compile: 'swap: i with: j
super swap: i with: j.
self do: [:each | each value swap: i with: j]'.
animals permutationsDo: [:perm |
| keys values sum |
keys := perm collect: #key.
values := perm collect: #value.
sum := (values * cages) sum sum.
ans value = sum ifTrue: [ans key add: keys].
ans value > sum ifTrue: [ans := (Set with: keys) -> sum]].
^ans
その後よく考えたら、素直に書いた方がシンプルだし速かったでござるの巻。あと、パラメーターのコピペミスがあったので、結果と共に差し替えました。orz
| animals cages ans |
animals := #(
(0 2 6 4 6 2 4 4 2 4)
(2 0 4 2 2 2 2 2 2 6)
(6 4 0 2 6 8 8 6 4 8)
(4 2 2 0 4 2 6 6 2 6)
(6 2 6 4 0 2 4 4 2 4)
(2 2 8 2 2 0 6 6 6 8)
(4 2 8 6 4 6 0 6 6 4)
(4 2 8 6 4 6 6 0 6 6)
(2 2 4 2 2 6 6 6 0 6)
(4 6 8 6 4 8 4 6 6 0)).
cages := #(
(0 3 4 5 8 10 9 6 2 4)
(3 0 4 4 7 9 9 8 5 9)
(4 4 0 2 4 7 5 4 4 8)
(5 4 2 0 3 5 5 5 5 9)
(8 7 4 3 0 3 5 6 8 12)
(10 9 7 5 3 0 4 7 10 14)
(9 9 5 5 5 4 0 3 8 11)
(6 8 4 5 6 7 3 0 5 8)
(2 5 4 5 8 10 8 5 0 4)
(4 9 8 9 12 14 11 8 4 0)).
ans := Set new -> Float infinity.
(1 to: animals size) permutationsDo: [:perm |
| sum |
sum := 0.
perm doWithIndex: [:pi :i |
perm doWithIndex: [:pj :j |
sum := ((animals at: pi) at: pj) * ((cages at: i) at: j) + sum]].
ans value = sum ifTrue: [ans key add: perm copy].
ans value > sum ifTrue: [ans := (Set with: perm copy) -> sum]].
ans
さらに追記。
なんと出題の動物の相性のデータにも対称になっていないという誤りがあったみたいで、
| animals |
animals := #(
(0 2 6 4 6 2 4 4 2 4)
(2 0 4 2 2 2 2 2 2 6)
(6 4 0 2 6 8 8 6 4 8)
(4 2 2 0 4 2 6 6 2 6)
(6 2 6 4 0 2 4 4 2 4)
(2 2 8 2 2 0 6 6 6 8)
(4 2 8 6 4 6 0 6 6 4)
(4 2 8 6 4 6 6 0 6 6)
(2 2 4 2 2 6 6 6 0 6)
(4 6 8 6 4 8 4 6 6 0)).
animals - ((1 to: animals size) collect: [:idx | animals collect: [:each | each at: idx]])
=> #(
(0 0 0 0 0 0 0 0 0 0)
(0 0 0 0 0 0 0 0 0 0)
(0 0 0 0 0 0 0 -2 0 0)
(0 0 0 0 0 0 0 0 0 0)
(0 0 0 0 0 0 0 0 0 0)
(0 0 0 0 0 0 0 0 0 0)
(0 0 0 0 0 0 0 0 0 0)
(0 0 2 0 0 0 0 0 0 0)
(0 0 0 0 0 0 0 0 0 0)
(0 0 0 0 0 0 0 0 0 0))
対称となっていない相性の値がそれぞれ 8 の場合と 6 の場合で計算し直すと、結果は次のようになりました。
8 => a Set(
#(6 9 3 8 7 4 5 1 10 2)
#(6 9 3 8 7 4 1 5 10 2)
)->2164
6 => a Set(
#(6 9 3 7 1 5 4 8 10 2)
#(6 9 3 7 5 1 4 8 10 2)
#(6 9 3 8 7 4 1 5 10 2)
#(6 9 3 8 7 4 5 1 10 2)
#(6 9 7 8 4 1 5 3 10 2)
#(6 9 7 8 4 5 1 3 10 2)
#(6 9 8 7 4 1 5 3 10 2)
#(6 9 8 7 4 5 1 3 10 2)
)->2156
