|
|
|
|
|
||
|
||
オブジェクト指向の“モヤッと”の正体を知りたくなったら、id:sumim:20040525:p1 や id:sumim:20080415:p1 がお役に立つかも…。
メソッドを合成して新しいメソッドを生成するのはちょっと手ごわそうなのであとまわしにして、まずは簡単な無名関数を使ったバージョンから試します。
Smalltalk では無名関数はブロックと呼ばれ、式を [ ] で括ることで定義できます。
f := [3 + 4]
これを評価する際には value というメッセージを送ります。
f value "=> 7 "
引数をとるブロックの場合は、次のようにコロンに続けて仮引数（変数名）を列挙し、| で手続き本体と区切ります。
add := [:x :y | x + y]
引数をとるブロックの評価には value ではなく、引数の数だけ value: を重ねたメッセージを送ります。
add value: 3 value: 4 "=> 7 "
余談ですが、この式でコールされるメソッドは #value:value: という名前の、（先の引数無しブロックの評価時にコールされる）#value とも #value: とも違う独立したメソッドである点は他の言語のユーザーはハマリポイントかもしれません。Smalltalk ではコロンも含めてメソッド名で（つまり #value と #value: 、もちろん #value:value: はそれぞれ別のメソッドで区別される）、それをコールするメッセージ式では引数をコロンの直後に挿入あるいは追加する特殊な書き方をする（block.value:value:(3,4) ではなく block value: 3 value: 4 と書く）ということはちょっと変わっているので Smalltalkうんちくとしてセットでまとめて覚えておくとよいでしょう。
さて本題ですが、リンク元の Scala で書かれた in 、unlines 、putStr 、sort 、lines はそれぞれ（少々無理矢理）Smalltalk のブロックで記述すると次のようになります。
| in unlines putStr sort lines | in := UIManager default multiLineRequest: '' centerAt: Display center initialAnswer: '3\2\1' withCRs answerHeight: 200. unlines := [:seq | String streamContents: [:ss | seq do: [:str | ss nextPutAll: str] separatedBy: [ss cr]]]. putStr := [:str | World findATranscript: nil. Transcript cr; show: str]. sort := [:seq | seq sort]. lines := [:str | Array streamContents: [:ss | str linesDo: [:line | ss nextPut: line]]]. putStr value: (unlines value: (sort value: (lines value: in))).
1 2 3
ここで Scala の compose のようなことをするには、次のようにブロック（BlockClosure）に #<< というメソッドを定義します。
BlockClosure >> << other ^[:x | self value: (other value: x)]
メソッド名がたまたま #<< なのでちょっと読みにくくなってしまっていますが、冒頭の BlockClosure >> というのは BlockClosure クラスに以降に続くメソッドを定義するよ、という意味です。念のため、これはメソッドの所在を明確にするためのたんなる慣習にすぎず、文法とかの類ではありません。さらに余談ですが、Smalltalk にはメソッドを定義する構文がないので、クラスにメソッド本体（この場合 BlockClosure >> より後）の文字列を何らかの方法で（たとえばコンパイルをするためのメソッドの引数として、あるいはクラスブラウザのコード表示枠に入力し accept するなどして）渡してやる必要があります。
さて。この #<< を使うことで関数の合成が可能になり、（記号のみからなり、通常の言語の二項演算を真似た二項メッセージが value: in のような通常のキーワードメッセージより優先して評価されるルールも手伝って）括弧もなくなり、#value: のコールも一回で済むようになります。
putStr << unlines << sort << lines value: in
ただ Smalltalk では関数をブロックとして定義してこれに引数を与えて評価するという通常の言語の方法よりは、オブジェクトにメッセージを送って、オブジェクト自身（つまりメッセージのレシーバー）にそれが内包する適切な関数（メソッド）をコールさせるという方法をとります。
今回の例でなら、レシーバーは in に代入された文字列なので、それにまず lines というメッセージを投げ、その返値に sort、その返値に…というふうにしてそれぞれの返値にメッセージを順に送って結果を得るということをします。つまり適切なメソッドが定義されていれば、次のように書くのが通常ということになります。
in lines sort unlines putStr
そこでこんなふうにつぶやいたわけですが、
Smalltalkのメッセージ式だとstr lines sort unlines putStrと書ける（Rubyも同様）ので「括弧を減らすための関数合成」というとっかかりがつかめないでいるhttp://d.hatena.ne.jp/yuroyoro/20120203/1328248662 via https://twitter.com/#!/ukstudio/status/165325836357087232
@sumim
これに対して（だと思うのですが）次のようなサジェスチョンをいただきましたので、なるほどなとちょっと考え直してみることにしました。
関数合成と関数適用を分離して考える、ということを言いたかった
@yuroyoro
上にも書きましたが、in lines sort … では #lines 、#sort というメソッドが順次コールされてしまうので、まずこれらを合成してから in を引数としてコールするにはどうしたらよいかをひねり出してみます。
とりあえず in と #lines 、#sort 、#unlines の返値が属するクラスにその次にコールされるメソッドを定義しておきます。
SequenceableCollection >> unlines ^String streamContents: [:ss | self do: [:str | ss nextPutAll: str] separatedBy: [ss cr]]
String >> putStr World findATranscript: nil. Transcript cr; show: self
String >> lines ^Array streamContents: [:ss | self linesDo: [:line | ss nextPut: line]]
#sort は ArrayedCollection>>#sort としてすでにあるのでそれをそのまま使うことにしました。ちなみにこの「クラス名>>#メソッド名」という表記は当該メソッドオブジェクトを得るのにも使える Smalltalk式としても機能します（ただし Squeak Smalltalk とその影響を受けた一部の処理系限定。#compiledMethodAt: のほうが一般的）。
このメソッドオブジェクトを関数に見立て、通常（10 factorial）と違ってメッセージ送信によるメソッドサーチを介さずに静的にコールしたい場合には、Squeak Smalltalk では #valueWithReceiver:arguments: というメソッドを使うことができます。
| fact | fact := Integer >> #factorial. fact valueWithReceiver: 10 arguments: #() "=> 3628800 "
この #valueWithReceiver:arguments: というメソッドが、すでに書いたブロック版における評価のための #value: と同じ役割を果たすので、ブロック版で f と g の合成である f value: (g value: x) は、メソッド版では次のように書けます。
f valueWithReceiver: (g valueWithReceiver: x arguments: #()) arguments: #()
#valueWithReceiver:arguments: のように長いメソッド名が二度出てくるとちょっと鬱陶しいので、#inject:into: でまとめてしまうのもよいかもしれません。
{g. f} inject: x into: [:val :func | func valueWithReceiver: val arguments: #()]
ただこういう処理をする（つまり合成した）無名のメソッドを返すメソッドをどう書くか、となるとなかなか難しいものがあります。まじめに書くと大変なので、ここは Smalltalk の 変態性 メリットを活かし、ダミーで生成したメソッドのノードをいじって目的のメソッドを生成させることでお茶を濁すことにします。
CompiledMethod >> << other | sourceString methodNode literalNode | sourceString := 'AnonMethod ^#(g f) inject: self into: [:x :func | func valueWithReceiver: x arguments: #()]'. methodNode := Compiler new compile: sourceString in: UndefinedObject notifying: nil ifFail: []. literalNode := (methodNode encoder instVarNamed: #litSet) at: #(g f). {other. self} doWithIndex: [:cm :idx | literalNode key at: idx put: cm]. ^methodNode generate
具体的には、'AnonMethod #(g f) inject: self into: [:x :func | func valueWithReceiver: x arguments: #()]' という文字列をコンパイラに渡して生成したメソッドノード（抽象構文木）から、#(g f) に相当するリテラルノードを手繰って、本来シンボルの #g と #f であるこのノードが参照している先を強制的に other と self（つまり f << g なら g と f ）に置き換えてしまいます。それからその改変メソッドノードを使ってバイトコード列（すなわちメソッドオブジェクト）を生成してそれを返しています。
こんな #<< を定義することで、たとえば 10 factorial negated という式でコールされる #factorial と #negated という二つのメソッドに対して次のような合成後適用ができるようになります。
| fact nega | fact := Integer >> #factorial. nega := Number >> #negated. (nega << fact) valueWithReceiver: 10 arguments: #() "=> -3628800 "
わかりやすいように nega << fact は括弧でくくっていますが、前述の通り Smaltalk では二項メッセージ式は通常のキーワードメッセージ式より優先順位が高いので、この括弧は無しでも問題ありません。
ついでに今は #valueWithReceiver:arguments: の第二引数は無用なので #valueWithReceiver: というちょっと短いバージョンも定義しておきましょう。
CompiledMethod >> valueWithReceiver: rcvr
^self valueWithReceiver: rcvr arguments: #()
| fact nega | fact := Integer >> #factorial. nega := Number >> #negated. (nega << fact) valueWithReceiver: 10 "=> -3628800 "
ということでお膳立てがすべて整いましたので、あとは各々のメソッドをブロックの代わりに同名のテンポラリ変数に代入し、#value: の代わりに #valueWithReceiver: を使って評価するように変えれば完成です。
| in unlines putStr sort lines | in := UIManager default multiLineRequest: '' centerAt: Display center initialAnswer: '3\2\1' withCRs answerHeight: 200. unlines := SequenceableCollection >> #unlines. putStr := String >> #putStr. sort := ArrayedCollection >> #sort. lines := String >> #lines. (putStr << unlines << sort << lines) valueWithReceiver: in
1 2 3
「型を1つ引数にとり現在のスコープに唯一存在するその型のオブジェクトを返す演算子」である "the" ですが、あいにく Smalltalk のメッセージ式に the では馴染まないので thing というメソッドに置き換えて実装してみました。「クラス名 thing」でコールできます。
Smalltalk には thisContext という擬変数（代入できない変数）が予約語としてあって、実行時のコンテキスト（スタックフレーム）を文字通り「文脈」を表わすオブジェクトとして得て扱うことが可能なので、そこから手繰って指定された型（クラス）に属する唯一のインスタンスを特定できれば "the" 改め thing メソッドを比較的簡単に実装できます。
Behavior >> thing | env found | env := thisContext sender. found := (1 to: env size) select: [:idx | (env at: idx) isKindOf: self]. ^found size = 1 ifTrue: [env at: found first] ifFalse: [self error: 'only one thing can be specified']
使い方はこうです。
たとえば
one
two
three
...
という foo.txt があったとして、その一行目を読み込む処理
| file | file := FileStream fileNamed: 'foo.txt'. file nextLine.
=> 'one'
を、このように書くことができます。
{ 'foo.txt'.
FileStream fileNamed: String thing.
FileStream thing nextLine
} last
=> 'one'
後で参照するオブジェクトを生成するリテラルや式をGCされないように配列の要素にしておかないといけないのと、判定に #isKindOf: をつかっているのでサブクラスのインスタンスも拾ってきてしまう事の善し悪し等、いくつか問題もあるようなのでもう少し工夫が必要でしょうが、ネタとしてはとりあえずこんな感じで。
KentのSmalltalkでの記事。何年ぶりなんだか。http://t.co/EN0kCYAE
@umejava 1月19日
経由で、
面白そうなのでちょっと趣向を変えて Squeak Smalltalk のジェネレーターを使って書いて動きを見てみようと思います。
サイコロより目の数がひとつ余計ですが、二番目のリンクの最後にあるのと同じ７つの目がそれぞれ 1/8, 1/5, 1/10, 1/4, 1/10, 1/10, 1/8 というふうに偏った確率で出る場合を考えます。
まず、ケント・ベックも冒頭で触れているエイリアス法を使わないナイーブな実装。各目の閾値（境界）を前述確率から算出しておき、0から1未満の乱数がそのどの範囲に収まるかで出る目を選んでいます。
| loadedDie bag | loadedDie := Generator on: [:g | | probs sum rand thresholds | probs := {1/8. 1/5. 1/10. 1/4. 1/10. 1/10. 1/8}. self assert: probs sum = 1. sum := 0. thresholds := probs collect: [:prob | sum := sum + prob]. rand := Random new. [ | index | index := rand next. g yield: (thresholds findFirst: [:threshold | index < threshold]) ] repeat]. bag := Bag new. 100000 timesRepeat: [bag add: loadedDie next]. bag sortedElements
=> {1->12466 . 2->20021 . 3->9944 . 4->25094 . 5->10003 . 6->10003 . 7->12469}
ちなみに、結果と比べやすくするため、それぞの目が出る確率として与えられた分数列を小数に直すとこんなふうになります。
{1/8. 1/5. 1/10. 1/4. 1/10. 1/10. 1/8} collect: #asFloat
=> #(0.125 0.2 0.1 0.25 0.1 0.1 0.125)
ついでにケント・ベックの #inject:into: を使った版も Squeak Smalltalk でジェネレーターを使って書いてみましょう。
| loadedDie bag | loadedDie := Generator on: [:g | | probs rand | probs := {1/8. 1/5. 1/10. 1/4. 1/10. 1/10. 1/8}. self assert: probs sum = 1. probs := probs collectWithIndex: [:prob :idx | idx -> prob]. rand := Random new. [ | index | index := rand next. [:exit | probs inject: 0 into: [:sum :each | | next | next := sum + each value. index < next ifTrue: [g yield: each key. exit value]. next]. ] valueWithExit. ] repeat]. bag := Bag new. 100000 timesRepeat: [bag add: loadedDie next]. bag sortedElements
=> {1->12465 . 2->20210 . 3->10025 . 4->24757 . 5->10012 . 6->9956 . 7->12575}
メソッドにしないこの書き方だと、リターン（^）が使えない（しかたがないので #valueWithExit 構造で代用）ので、うれしさ半減で冗長になってしまうようです。^^;
さて。本題のエイリアス法ですが、これは簡単には、偏りのある目の出方を「目の数と同じ枚数のコインから１枚のコインの抽出（等確率）」と「そのコインの偏った裏表の出方」という二段階の作業の結果として置き換える考え方のようです。使用する各コインの表には各目を割り振り、その裏には本来の 1/n より多く出る確率を持つ他の目を適切に分割・分配しておきます。この余剰分の「適切な分割・分配」は機械的にすることができて、二番目のリンクにある「Algorithm: Vose's Alias Method」の項がわかりやすいです。画付きの解説もあるので適宜参照して下さい。
これにほぼ従ったかたちで Squeak Smalltalk で書き下すとこんなかんじになります。
| loadedDie bag | loadedDie := Generator on: [:g | | probs n group small large coins rand | probs := {1/8. 1/5. 1/10. 1/4. 1/10. 1/10. 1/8}. self assert: probs sum = 1. n := probs size. probs := probs collectWithIndex: [:each :idx | idx -> (each * n)]. group := probs groupBy: [:each | each value < 1] having: #notEmpty. small := group at: true. large := group at: false. coins := OrderedCollection new. [small notEmpty] whileTrue: [ | heads tails | heads := small removeFirst. self assert: large notEmpty. tails := large removeFirst. tails value: tails value + heads value - 1. tails value >= 1 ifTrue: [large add: tails] ifFalse: [small add: tails]. heads value: heads value -> tails key. coins add: heads]. [large notEmpty] whileTrue: [ | heads | heads := large removeFirst. self assert: heads value = 1. heads value: heads value -> nil. coins add: heads]. rand := Random new. [ | coin | coin := coins atRandom. g yield: (rand next < coin value key ifTrue: [coin key] ifFalse: [coin value value]) ] repeat]. bag := Bag new. 100000 timesRepeat: [bag add: loadedDie next]. bag sortedElements
=> {1->12561 . 2->19976 . 3->10096 . 4->24892 . 5->9977 . 6->10031 . 7->12467}
このくらいの長さになったら面倒くさがらずにベックがやっているようにちゃんとクラスを作った方がよさそうですね。^^;
ちなみに上のそれぞれをブロックで括り timeToRun して速度を計測したところ、順に 1427ms, 1585ms, 622ms となりました（1.8GHz Core i7, Win 7, Squeak4.2 CogVM）。当たり前ですがそれなりに効果は出ているようです。
Squeak Smalltalk には overlappingPairsCollect: という名前で標準装備されています。
もちろん等差数列を作るのにもこの関数は使えるのですが、この一般的に使える関数に使う名前としてはあまりに局所的。というわけで mapBetween としてみました。使いどころはかなり多そうです。各言語に標準装備されていないのがちょっと不思議なほど。
404 Blog Not Found:algorithm - mapBetween - 配列の隣接する2項にそれぞれ演算を施した配列
#(1 2 3 4 5) overlappingPairsCollect: #+
=> #(3 5 7 9)
蛇足ですが Smalltalk ではメソッド名のコロンは飾りではなく、コロンが付く場合、それ(複数含むときはそれら)も含めてのメソッド名です。たとえば hoge: と hoge は（たんに引数を「とる」「とらない」という区別以上に―）名前の異なる別メソッドとして明確に区別されます。Smalltalk の t が小文字なのと同じくらいに大事なことなのでご注意あれ、かし。
おもしろい。やってみよう。
この例題のような仕様の直方体の場合、二つに重なりがあるかは、X-Y 平面、X-Z 平面 Y-Z 平面への投影図（ふたつの矩形からなる）のどれにもちゃんと重なりがあるかどうかで判断できそうです。
Squeak Smalltalk の場合、すでに組み込みの「矩形オブジェクト」（Rectangle のインスタンス。原点座標 extent: 幅@高 で生成可能)があり、それに二つのインスタンスの重なりの有無を真偽値で返す #intersects: というメソッドもあるのでこれらを省力化のために積極的に活用します。
| rect1 rect2 rect3 | rect1 := 0@0 extent: 10@10. rect2 := 5@5 extent: 10@10. rect3 := 15@15 extent: 10@10. "重なりがある場合" rect1 intersects: rect2. "=> true " "重なりがない場合" rect1 intersects: rect3. "=> false "
前後しますが、x@y はやはり組み込みの「座標オブジェクト」（Point のインスタンス）を生成するための式です（リテラルっぽいですがそうではなくごく普通の式で、Number>>#@ というメソッドをコールしています）。
まず、こういうテストが通ることを目指します。
TestCase subclass: #CubeIntersectionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Sony-Quiz-Tests'
CubeIntersectionTest >> test000 "二つの直方体に重なりがあるかを真偽値で返すことができる" | cube1 cube2 cube3 | cube1 := 0@0@0 extent: 10@10@10. cube2 := 5@5@5 extent: 10@10@10. cube3 := 15@15@15 extent: 10@10@10. self assert: (cube1 intersects: cube2) = true. self assert: (cube1 intersects: cube3) = false
そのためには x@y@z に三次元座標オブジェクトを返させなければいけません。テストはこんな感じ。
CubeIntersectionTest >> test001 "x@y@z で三次元座標オブジェクト（a Point3D）を生成できる" self assert: (0@0@0) class = Point3D
このテストのコンパイル時に Point3D が見つからないがどうしたいか？とコンパイラーに怒られるので促されるままに定義しておきます。インスタンス変数は Point に倣って x y z でよいでしょう。
Object subclass: #Point3D instanceVariableNames: 'x y z' classVariableNames: '' poolDictionaries: '' category: 'Sony-Quiz'
いずれ Point3D class>>#x:y:z: も必要なので同様に Point class>>#x:y: に倣って先に定義しておきます。
Point3D class >> x: x y: y z: z ^self basicNew setX: x setY: y setZ: z
Point3D >> setX: newX setY: newY setZ: newZ x := newX. y := newY. z := newZ
さて。Smalltalk では x@y@z という式は、前述の x@y で生成された座標オブジェクト（Point のインスタンス）にあらためて @z というメッセージを送る、と解釈されます。したがって Point3D オブジェクトを生成させるには Point>>#@ を定義すればよいことになります。
Point >> @ z ^Point3D x: x y: y z: z
これで #test001 がグリーンに。あと、#test000 は最後まで通らないのでコメントアウトならぬブロックで括って機能しないようにしておくほうがオールグリーンが確認がしやすいと思います。
CubeIntersectionTest >> test000 [ "二つの直方体に重なりがあるかを真偽値で返すことができる" | cube1 cube2 cube3 | cube1 := 0@0@0 extent: 10@10@10. cube2 := 5@5@5 extent: 10@10@10. cube3 := 15@15@15 extent: 10@10@10. self assert: (cube1 intersects: cube2) = true. self assert: (cube1 intersects: cube3) = false ]
こうしてできあがった Point3D オブジェクトに、extent: w@h@d というメッセージを送ることで直方体オブジェクト（Cube のインスタンス）を生成できるようにします。まずテスト。
CubeIntersectionTest >> test002 "x@y@z extent: w@h@d で直方体オブジェクト（a Cube）を生成できる" self assert: (0@0@0 extent: 10@10@10) class = Cube
例によってコンパイル時に Cube が見当たらないといってコンパイラーが怒ってくるのでこれも促されるまま定義しておきます。インスタンス変数は Rectangle に倣って origin と corner でよいでしょう。
Object subclass: #Cube instanceVariableNames: 'origin corner' classVariableNames: '' poolDictionaries: '' category: 'Sony-Quiz'
Cube class >> origin: originPoint3D extent: extentPoint3D ^self basicNew setOrigin: originPoint3D corner: originPoint3D + extentPoint3D
Cube >> setOrigin: newOrigin corner: newCorner origin := newOrigin. corner := newCorner
Point3D>>#extent: は Point>>#entent: を参考にして書きます。
Point3D >> extent: aPoint3D
^Cube origin: self extent: aPoint3D
Point3Dオブジェクト同士の加算なども Point>>#+ に倣って定義。（#adaptToPoint3D:andSend: は YAGNI なのでエラーを出したほうがよいかも。）
Point3D >> + arg arg isPoint3D ifTrue: [^ (x + arg x) @ (y + arg y) @ (z + arg z)]. ^arg adaptToPoint3D: self andSend: #+
Object >> isPoint3D
^false
Point3D >> isPoint3D
^true
Point3D >> x
^x
Point3D >> y
^y
Point3D >> z
^z
お膳立ては整ったので最後に本題である Cube>>#intersects: の定義。X-Y、X-Z、Y-Z 平面に投影される矩形情報を得る便利メソッドをそれぞれ #xyRect #xzRect #yzRect とすれば Cube>>#intersects: は次のように書くことができます。
Cube >> intersects: aCube ^(self xyRect intersects: aCube xyRect) and: [self xzRect intersects: aCube xzRect] and: [self yzRect intersects: aCube yzRect]
#xyRect #xzRect #yzRect は実装はこんなので。
Cube >> xyRect ^origin x @ origin y extent: corner x @ corner y Cube >> xzRect ^origin x @ origin z extent: corner x @ corner z Cube >> yzRect ^origin y @ origin z extent: corner y @ corner z
最後に #test000 のブロックの囲いを外してグリーンになることを確認できれば、これでおしまい。
CubeIntersectionTest >> test000 "二つの直方体に重なりがあるかを真偽値で返すことができる" | cube1 cube2 cube3 | cube1 := 0@0@0 extent: 10@10@10. cube2 := 5@5@5 extent: 10@10@10. cube3 := 15@15@15 extent: 10@10@10. self assert: (cube1 intersects: cube2) = true. self assert: (cube1 intersects: cube3) = false
お題の二項目目を鑑みてもう少し網羅的なテストを書き足してもいいですね。
CubeIntersectionTest >> test003 "完全に内部にあるパターンや面や辺から一部がはみ出ているパターンでの交差" | cube | cube := 0@0@0 extent: 8@8@8. self assert: (cube intersects: (2@2@2 extent: 4@4@4)) = true. self assert: (cube intersects: (2@2@6 extent: 4@4@4)) = true. self assert: (cube intersects: (2@6@6 extent: 4@4@4)) = true CubeIntersectionTest >> test004 "面、辺、角のみで接していても交差とは判定しない" | cube | cube := 0@0@0 extent: 5@5@5. self assert: (cube intersects: (0@0@5 extent: 5@5@5)) = false. self assert: (cube intersects: (0@5@5 extent: 5@5@5)) = false. self assert: (cube intersects: (5@5@5 extent: 5@5@5)) = false
なお、#assert: で false かどうかをチェックする代わりに #deny: も使えます。同様に #assert: で true かどうかのチェックも本当は必要ありません。念のため。
最近のコメント
最近のトラックバック
