平和な動物園を作ろう!をインスタンス特異的メソッドを用いてSqueak Smalltalkで


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: を書き換えてしまうのは、何か違う気がするので(というか、ダメ。ゼッタイ。w)、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. "keys asString displayAt: 20@20."
   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

"=> a Set(
   an Array1('スイギュウ' 'インパラ' 'ニシキヘビ' 'カバ' 'サイ' 'オオカミ' 'トラ' 'ライオン' 'ゾウ' 'ワニ')
   an Array1('スイギュウ' 'インパラ' 'ニシキヘビ' 'カバ' 'サイ' 'オオカミ' 'ライオン' 'トラ' 'ゾウ' 'ワニ')
)->2160

その後よく考えたら、素直に書いた方がシンプルだし速かったでござるの巻。あと、パラメーターのコピペミスがあったので、結果と共に差し替えました。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

"=> a Set(#(6 9 3 8 7 4 5 1 10 2) #(6 9 3 8 7 4 1 5 10 2))->2160 "

さらに追記

なんと出題の動物の相性のデータにも対称になっていないという誤りがあったみたいで、

| 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

「『出現確率1%のガチャを100回引いても,4割近くの人は全部はずれる。“本当の確率”を読み解いてみよう』を素直に解いてみる」をSqueak Smalltalkで


「1 - 100回引いてハズす確率」ではなく、各回の当たる確率を積算して算出する計算はどうなるか、というお話にからめて、最後に添えられた Ruby 版で、Smalltalk でもおなじみの inject (Smalltalk では inject:into: )が使われていたので Squeak Smalltalk でも書いてみました。

(0 to: 99) inject: 0 into: [:r :n | r+((0.99 raisedTo: n)*0.01)] "=> 0.63396765872677 "


残念ながら Squeak には raisedTo: のエイリアスとして ** が用意されてないのと(Pharo にはあるらしい)、二項メッセージ式に優先順位がないせいで括弧が増えるのがアレですが、よく似ていますね。


なお、Smalltalk でも Squeak や Pharo に限れば、APL 譲り(…とういかワナビ?)の配列計算が使えるので、ちょっと趣を変えて同じようなことをこんなふうにも書くことができます。

((0.99 raisedTo: (0 to: 99)) * 0.01) sum "=> 0.6339676587267705 "


Squeak や Pharo の raisedTo: は、引数に配列を与えれば答えを配列で返すしくみになっています( raisedTo: の返値になぜか生じる丸め誤差が見苦しいので rounded しています)。

(3 raisedTo: (0 to: 4)) rounded "=> #(1 3 9 27 81) "


ではメッセージ raisedTo: 〜 のレシーバーが配列なら、配列の配列が返るかというとそうはならず、対応した各要素について累乗値が返ってきます。

#(3 4 5) raisedTo: #(0 1 2) "=> #(1 4 25) "


したがって、レシーバーと raisedTo: の引数の配列のサイズが違うとエラーになるので要注意です。

#(3 4 5 6) raisedTo: #(0 1 2) "=> Error: otherCollection must be the same size "


余談ですが、整数の累乗なのに配列だと Float に変換されてしまう謎も含め、なぜこのような振る舞いになるかというのは、Number>>#raisedTo: の定義をみると分かります。

Number >> raisedTo: aNumber 
"Answer the receiver raised to aNumber."

aNumber isInteger ifTrue: [
"Do the special case of integer power"
^ self raisedToInteger: aNumber].
aNumber isFraction ifTrue: [
"Special case for fraction power"
^ (self nthRoot: aNumber denominator) raisedToInteger: aNumber numerator ].
self < 0 ifTrue: [
^ ArithmeticError signal: 'Negative numbers can''t be raised to float powers.' ].
0 = aNumber ifTrue: [^ self class one]. "Special case of exponent=0"
1 = aNumber ifTrue: [^ self]. "Special case of exponent=1"
0 = self ifTrue: [ "Special case of self = 0"
aNumber < 0
ifTrue: [^ (ZeroDivide dividend: self) signal]
ifFalse: [^ self]].
^ (aNumber * self ln) exp "Otherwise use logarithms"


なお、レシーバーが配列の場合は、まず Collection>>#raisedTo: が呼ばれるので、レシーバーが整数の場合とは振る舞いが異なってきます。

Collection >> raisedTo: arg
^ arg adaptToCollection: self andSend: #raisedTo:
Collection >> adaptToCollection: rcvr andSend: selector
"If I am involved in arithmetic with another Collection, return a Collection of
the results of each element combined with the scalar in that expression."


rcvr isSequenceable & self isSequenceable ifFalse:
[self error: 'Only sequenceable collections may be combined arithmetically'].
^ rcvr with: self collect:
[:rcvrElement :myElement | rcvrElement perform: selector with: myElement]