Consセルがメッセージを受け取って動くLispもどきをPharo3.0 Smalltalk で

OOP

引数を評価する(carをevalしていく)ときにatomとして使っているSmalltalkのデータ全てがevalメッセージを理解

http://phaendal.hatenablog.com/entry/2015/04/17/164825


名詞とか動詞とか宣言的とかは難しくてよく分からないのですが（をゐ）、このアイデアに触発されて、タイトルにあるようにとにかく Consセルとそれに EVAL や APPLY というメッセージを送ることで評価できる Lisp っぽく動くものを手軽にでっち上げることを目指しました。


ふだんなら Squeak で書くところなのですが、これまで Pharo は新しいことをいろいろ覚えるのがめんどくさくて触ったことがなかったので、Squeak から派生して先ごろついに 4.0 が出るまでに進化したこやつの成長ぶりを確認する敵情視察も兼ねて Pharo4.0 で書いてみよう！

と…思い立ったまではよかったのですが、この出たばかりの Pharo4.0 は、なんかいろんなところが壊れていることが判明したので、これよりはいくぶんかこなれているであろう一つ前の Pharo3.0 を使うことにしました。^^;


現行バージョンではないためアーカイブされている Pharo3.0 は http://files.pharo.org/platform/ から各ホストOS（mac、linux、win）用のものが入手可能です。三つの OS で共通して使える Pharo3.0-portable.zip もあります。zip を展開すると、たとえば winであれば Pharo.exe をダブルクリックすると自動的に Pharo3.0.image（後述の永続化されたオブジェクトを収めたバイナリーファイル）を読み込んで Smalltalk 環境が立ち上がります。


Smalltalk ではシステムブラウザ（場合によってはクラスブラウザとも言う）を使ってクラス定義やそこにメソッドを書きます。Pharo3.0 のシステムブラウザ（デスクトップクリック→System Browser で起動）はこんな画面です。

http://squab.no-ip.com/collab/uploads/Pharo3Browser.png


おおまかには上段に左から「パッケージ名一覧」「クラス名一覧」「プロトコル名一覧」「メソッド名一覧」の枠があり、上段で選択したクラスやメソッドの定義やコードを記述するのに下段の大きな枠を使う仕組みになっています。

この中で３番目の「プロトコル」というちょっと見慣れない概念は、メソッドカテゴリーやメッセージカテゴリーとも呼ばれ、クラスに定義されたメソッドを分類するための属性です。メソッドを定義するときにあらかじめ指定しておく必要があるものですが、特に指定しなければ as yet classified になりますし、あとから変更することも可能なので比較的ゆるいです。

後の Objective-C では同名のプロトコルという言語機能が、その後継の Java のインターフェイスに相当する機構の前身に進化したりしていますが、Smalltalk の時点ではまだメソッドに定められている属性のひとつ…程度の能力しかありません（なお、実装上はクラスが有する属性です。為念）。


下段のコードを記述する枠には、当該メソッドをコールするときに送信するメッセージ記述を模したメッセージパターン（メソッド名と仮引数名の宣言を兼ねる）に続いてメソッド本体を記述する決まりになっています。

Smalltalk には（GNU Smalltalk など変わり種の処理系を除き）他の言語にあるメソッド定義のための構文のようなものは存在しませんので、システムブラウザというマルチペインのグラフィカルな UI が、そうした構文や特殊形式の肩代わりをしていると考えることもできます。


Smalltalk では、クラスはもちろん、メソッドもそれを生成するのに使った（つまり我々が書いた）ソースコードもオブジェクトとして扱われ、たとえばメソッドのソースはそのメソッドの属性のような扱いになります（メソッドに getSource というメッセージを送るとそのソースが得られるといったふうに）。環境全体が簡易なオブジェクトストア（OODB）のようなものだと考えると、他の普通の処理系向けの IDE との違いを理解しやすいと思います。


では実際に、次のような感じで動作する ConsCell を作ってみたいと思います。

ConsCell car: 1 cdr: 2   "=> (1 . 2) "

#(a (1 2 3) c d) as: ConsCell   "=> (a (1 2 3) c d) "

(#(+ 1 2 3 4) as: ConsCell) EVAL   "=> 10 "

(#(MAP factorial (LIST 1 2 3)) as: ConsCell) EVAL   "=> (1 2 6) "

(#(reduce: (asArray 1 2 3) +) as: ConsCell) EVAL   "=> 6 "


主に配列を Consセルを使ったリストに変換し、さらにそれにメッセージを送ることで評価できるように。あと、+ や factorial、reduce: といった Smalltalk に組み込みのメソッドもそのまま使えるようにします。


ファイルアウトしたコード（すなわち、ファイルイン可能なコード）は MessageReceivableCons-Lisp.st ですが、これだとチャンクの区切りやメタ情報が入ったり、順不同だったりして読みにくいので、以下では改めて

クラス名（クラスメソッドの場合は クラス名 class） > カテゴリー名 > メッセージパターン
    メソッド本体


という独自記法で抜粋して解説します。


▼ConsCell の定義とアクセッサー（accessingプロトコル）生成

ConsCell には car と cdr というインスタンス変数を用意します。システムブラウザのクラス名一覧枠を右クリック→ Add class... でシステムにクラスを追加できます。

Object subclass: #ConsCell
    instanceVariableNames: 'car cdr'
    classVariableNames: ''
    category: 'MessageReceivableCons-Lisp'


アクセッサーはインスタンス変数と同名のものを用意します。ただ Smalltalk ではコロンもメソッド名（セレクターとも言う）に含まれるため、この「同名」と言う表現には語弊があり（というか明かな間違いで）、コロンの有り（セッター）無し（ゲッター）で別の独立したメソッドとして用意する必要があります。

いちいち手で書いてもよいのですが、数が多いと大変なので、クラス名一覧枠で ConsCell を選択して右クリック→ Analyze... → Create inst var acccessors した方が楽でしょう（Pharo4.0 ではなぜかこの機能が消滅しています。これが分かった時点で今回の Pharo4.0 の使用は諦めました。^^;）。

ConsCell > accessing > car
    ^ car

ConsCell > accessing > car: aCellOrObject
    car := aCellOrObject

ConsCell > accessing > cdr
    ^ cdr

ConsCell > accessing > cdr: aCellOrObject
    cdr := aCellOrObject


これで

ConsCell new car: 1; cdr: 2; yourself

という式をどこか（文字が入力できれば原則どこでもＯＫですが普通は デスクトップ右クリック→ Workspace ）に入力し Print it（alt + p）すると、任意の ConsCell のインスタンスが生成できるのが確認できます。


▼文字列化（printingプロトコル）と判定メソッド（testingプロトコル）

ただ、今の状態ですと ConsCell インスタンスを生成しても 「a ConsCell」としか表示されず、いちいちインスペクト（Inspect it）するなどないと中身が分からず面倒です。そこで内容を反映した文字列化を適宜おこなってくれるよう printingプロトコルにある printOn: メソッドをオーバーライドします。なお、プロトコルは、上段第三枠の右クリック→ Add protocol... で追加できます。

ConsCell > printing > printOn: aStream
    | nextCellOrObject |
    aStream nextPut: $(.
    aStream nextPutAll: car asString.
    nextCellOrObject := cdr.
    [ nextCellOrObject isConsCell ]
        whileTrue: [
            aStream
                space;
                nextPutAll: nextCellOrObject car asString.
            nextCellOrObject := nextCellOrObject cdr ].
    nextCellOrObject notNil
        ifTrue: [ aStream nextPutAll: ' . ' , nextCellOrObject asString ].
    aStream nextPut: $)


コンパイル（alt + s）時、ConsCell のインスタンスか否かを判定するメソッド（testingプロトコル）である isConsCell が未定義であることを（あるいはスペルミスではないかと）とがめられますが、その場は isConsCell で間違いないことだけを伝えてコンパイルは完了してください。

もちろん、あとで忘れずに定義しておく必要はあります。

Object > *MessageReceivableCons-Lisp > isConsCell
    ^ false

ConsCell > testing > isConsCell
    ^ true


本来であれば Object>>#isConsCell も ConsCell>>#isConsCell 同様に testingプロトコルに属させたいところですが、そうしてしまうと MessageReceivableCons-Lisp パッケージに同梱できないので、やむを得ず、パッケージ名に * 付した *MessageReceivableCons-Lisp という特殊なプロトコルに属させています。ここらへんは、Montecello などで新たに導入された今どきのパッケージ管理の限界で、個人的にも気にくわないところです。

余談ですが、Smalltalk 処理系に比較的最近組み込まれるようになった分散管理が可能な VCS である Monticelloではなく、Smalltalk に古くからあるチェンジセットという古典的なソースコード管理機構を使う場合は、文字通り「（システムに加えられた）変更の集合」として黙っていても（追加、変更の別を問わず）すべて蓄積されるため、このへんの気遣いは無用です。


これで、ConsCellオブジェクトの car、cdr の中身を反映した文字列化がされるようになったはずです。Print it して試してみましょう。

ConsCell new car: 1; cdr: 2; yourself   "=> (1 . 2) "

▼コンストラクター（instance creationプロトコル）、配列化メソッド（convertingプロトコル）

いちいち ConsCell を new して car と cdr をセットするのは面倒なので、ConsCell class（メタクラス）に car:cdr: メソッドを定義します。システムブラウザでメタクラスにメソッドを定義する（つまり、クラスメソッドを定義する）には、中央左寄りにある □ Class side と書かれたスイッチをクリックして ■ にしてから作業（プロトコル追加→メソッドソース記述、コンパイル）します。

ConsCell class > instance creation > car: carCellOrObject cdr: cdrCellOrObject
    ^self new car: carCellOrObject; cdr: cdrCellOrObject; yourself


これだけでもだいぶすっきりするのですが、

ConsCell car: 1 cdr: 2   "=> (1 . 2) "


リストを定義しようとするとやっかいなことになります。

ConsCell car: 1 cdr: (ConsCell car: 2 cdr: (ConsCell car: 3 cdr: nil))   "=> (1 2 3) "


そこで、newFrom: メソッドをオーバーライドして

ConsCell newFrom: #(1 2 3)

もしくは

#(1 2 3) as: ConsCell


という記述で配列などの順序付きコレクションを ConsCell のリストに変換できるようにしましょう。

ConsCell class > instance creation > newFrom: aCollection
    | instance elem next |
    aCollection isEmpty ifTrue: [ ^ nil ].
    elem := aCollection first.
    (elem isCollection and: [ elem isString not ]) ifTrue: [ elem := elem as: self ].
    instance := next := self new car: elem; yourself.
    aCollection allButFirstDo: [ :each |
        elem := each.
        (elem isCollection and: [ elem isString not ]) ifTrue: [ elem := each as: self ].
        next cdr: (next := self new car: elem; yourself) ].
    ^ instance


これで次の記述が可能になります。

#(a (1 2 3) b c) as: ConsCell   "=> (a (1 2 3) b c) "

▼ちょっとした細工と便利メソッド
なぜか Phato では Squeak などでは可能な、通常のブロック（一つ目の例）の代わりにシンボルを渡してメソッドを呼び出す二つ目の例のようなこと

#(1 2 3) reduce: [:sum :x | sum + x]   "=> 6 "

#(1 2 3) reduce: #+  "=> error "


がエラーになってできないため不便きわまるので、これをちょいちょいといじってできるようにしておきます。なお、ここからふたたびインスタンスメソッドの定義なので、直前にクラスメソッドの #newFrom: を定義するために切り替えたシステムブラウザの ■ Class side チェックをクリックして元の □ に戻しておくのを忘れずに！（これを読みながら逐次定義している場合）

Symbol > *MessageReceivableCons-Lisp > argumentCount
    ^ self numArgs + 1

Symbol > *MessageReceivableCons-Lisp > valueWithArguments: args
    ^ args first perform: self withArguments: args allButFirst


という二つのメソッドを Symbol に追加しておくと、期待通りの動作をしてくれるようになります。

#(1 2 3) reduce: #+  "=> 6 "


用意しておくとあとあと便利なので、Consセルで表現されたリストの要素を配列化する ConsCell>>#asArray を convertingプロトコルに、#collect: を enumeratingプロトコルに定義しておきます。

ConsCell > converting > asArray
    ^ (Array with: car), (cdr ifNil: [ #() ]) asArray

ConsCell > enumerating > collect: aBlock
    ^ self class
        car: (aBlock value: car)
        cdr: (cdr isConsCell
           ifTrue: [ cdr collect: aBlock ]
           ifFalse: [ cdr ])


試してみます。

(#(1 2 3) as: ConsCell) asArray   "=> #(1 2 3) "
(#(1 2 3) as: ConsCell) collect: #negated   "=> (-1 -2 -3) "


念のため、この asArray はリストの各要素に再帰的に適用されないので、要素が Consセルでもあそれは配列には変換されません。


▼EVAL、APPLY、MAP の定義

では本題の Lisp（っぽい）コードを記述した ConsCell に EVAL メッセージを送って評価できるように ConsCell>>#EVAL メソッドを定義しましょう。同時に Object>>#EVAL の定義も忘れずに。あと、 APPLY するときに流用する Smalltalk の二項セレクターの判定が簡潔に記述できるよう Symbol>>#isBinarySelector もあらかじめ定義しておきます。

Symbol > *MessageReceivableCons-Lisp > isBinarySelector
    ^ self allSatisfy: #isSpecial

Object > *MessageReceivableCons-Lisp > EVAL
    ^ self

ConsCell > LISP-FUNCTIONS > APPLY
    cdr isNil ifTrue: [ ^ self class perform: car ].
    car isBinarySelector ifTrue: [ ^ cdr asArray reduce: car ].
    car numArgs = 0 ifTrue: [ ^ car value: cdr ].
    ^ car valueWithArguments: cdr asArray

ConsCell > LISP-FUNCTIONS > EVAL
    | funSymbol args |
    funSymbol := car EVAL.
    args := cdr collect: #EVAL.
    ^ (self class car: funSymbol cdr: args) APPLY


評価してみます。

(#(+ 1 2 3 4) as: ConsCell) EVAL   "=> 10 "
(#(* (+ 1 2) 3 4) as: ConsCell) EVAL   "=> 36 "


よさそうですね。


最後にこのエントリーの冒頭のと、元エントリーのサンプルコードなども評価できるように、いくつか LISP-FUNCTIONSプロトコルにメソッドを追加しましょう。

ConsCell > LISP-FUNCTIONS > CONS
    ^ self class car: car cdr: cdr car

ConsCell > LISP-FUNCTIONS > CAR
    ^ car car

ConsCell > LISP-FUNCTIONS > CDR
    ^ car cdr

ConsCell > LISP-FUNCTIONS > LIST
    ^ self

ConsCell > LISP-FUNCTIONS > MAP
    ^ cdr car collect: car

以下、久しぶりに Pharo を触った感想をざっくばらんに。

テキスト編集時に again（alt + j）や again many（alt + shift + j）、exchange（alt + e）、duplicate（alt + e）を古くから愛用している Squeakスキーとしては、これらの画期的テキスト編集向け機構を Pharo に残さなかった（残せなかった、あるいは正常に動作させられない、させる気のない）開発陣には殺意すら禁じ得ませんがｗ、今どきの Find/Replace はまあ普通に作ってあるしこれでいいと思います。

今回調べていてちょっと驚いたのは、意外にも古典的なチェンジセットがまだかろうじて使えることと、その一方で、古典的なプロジェクト機構（Smalltalk に古来からある仮想デスクトップ機構で、チェンジセットと紐付けしてそれを視覚的に切り替えるのにも使用できる）が完全に取り払われていて、チェンジセットがほぼ使いものにならない状態だったことです。プロジェクトは Pharo のかなり早い時期に取り除かれていたようで、なんだかすごく残念でした。

クラス名やメソッド名の補完は今風だしすごく便利だと思うのですが、query symbol（alt + q 連打）で満足している身としては、望まない動作をすることもあるのでプラマイゼロ…といったところでしょうか。

月並みですが、作っている人も使っている人も、古典的な Smalltalk環境に思い入れのない向きの Smalltalk環境としてどんどん進化している感じですね。

ジバニャン方程式を Squeak Smalltalk で

OOPL



輪郭抽出が手抜きでちょっとあれですが…^^;

| jibanyanEquation form size |

jibanyanEquation := [:x :y |
   {  {  {1-(x/108 raisedTo: 2)-(y/94 raisedTo: 2). y} min.
         {  1-(x abs-119/103 raisedTo: 2)-(y-56/86 raisedTo: 2).
            1-(x abs-15/77 raisedTo: 2)-(y-119/100 raisedTo: 2)} min.
         1-(x abs-42/66 raisedTo: 2)-(y/55 raisedTo: 2).
         {55+y. 51-x abs. y negated} min} max.
         3*(y-100) abs-(2*(x-75))
   } min * {
      {  {  {1-(x/106 raisedTo: 2)-(y/92 raisedTo: 2). y} min.
            {  1-(x abs-119/101 raisedTo: 2)-(y-56/84 raisedTo: 2).
               (x abs-99/40 raisedTo: 2)+(y-54/86 raisedTo: 2)-1. 92-x abs} min.
            1-(x abs-42/64 raisedTo: 2)-(y/53 raisedTo: 2)} max.
         {  (x abs-52/26 raisedTo: 2)+(y+28/26 raisedTo: 2)-1. 
            (x abs-51/13 raisedTo: 2)+(y/13 raisedTo: 2)-1.
            {x abs-51. y} max} min} min. 
      ((x/51+(10/51*((y abs/61.2 raisedTo: 1.2)*Float pi*7/2) sin)) abs raisedTo: 2/3)
         +(y abs/61.2 raisedTo: 2/3)-1
   } min * {
      1-(x/32 raisedTo: 2)-(y+30/32 raisedTo: 2).
      1-(x abs+5/22 raisedTo: 2)-(y-18/22 raisedTo: 2)
   } min * {
      1-(x abs-18/20 raisedTo: 2)-(y+10/20 raisedTo: 2).
      (x abs-20/22 raisedTo: 2)+(y+7/20 raisedTo: 2)-1
   } min * (1-(x abs-51/11 raisedTo: 2)-(y/11 raisedTo: 2))
].

size := 300.
form := Form extent: size asPoint.
(0 to: size) - (size // 2) asDigitsToPower: 2 do: [:xy |
   | pos |
   (pos := xy first @ xy second) asString displayAt: 100 asPoint.
   form pixelValueAt: size // 2 + pos put: ((jibanyanEquation value: pos x value: pos y) >=0) asBit
].
form := form flipVertically asFormOfDepth: 8.
{size // -2. 0@ -75. 0@0. -50@0. 50@0. 0@17} do: [:pos |
   form shapeBorder: Color red width: 1 interiorPoint: pos + form center sharpCorners: false internal: true].
form replaceColor: Color black withColor: Color white.
form replaceColor: Color red withColor: Color black.
form asMorph openInHand

http://squab.no-ip.com/collab/uploads/jibanyan.png

プロ生ちゃん #カレンダープログラミング を Smalltalk で

OOPL

  • プログラミング言語は自由（既に応募がある言語でも OK）
  • コードを実行した当月の日曜始まりのカレンダーを出力する
    • 追記： 当月を取得できない処理系は、年と月を指定する
  • 出力形式はサンプルを参考に、細かい点は自由

「プロ生ちゃん #カレンダープログラミング プチコンテスト 2014」開催！ | プログラミング生放送


Squeak もしくは Pharo という Smalltalk 処理系をインストールして起動後、デスクトップメニューから Workspace を開いてコードを貼り付けてから全選択し、右クリックメニューから print it（もしくは、alt/cmd + p ）すると動作します。（ideone.com などにある GNU Smalltalk 等では残念ながら動きません。あしからず）

(Date today month weeks collect: [:week |
   (week dates collect: [:date | date month ~= Date today month
      ifTrue: ['  '] ifFalse: [date dayOfMonth printStringLength: 2]]
   ) reduce: [:weekLineStr :dateStr | weekLineStr, ' ', dateStr]]
) asStringWithCr, String cr

          1  2  3  4
 5  6  7  8  9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31

久しぶりに竹内関数で JavaScript、Python、Ruby、Scheme と Smalltalk とを戦わせてみる

OOPL


AO bench で味を占めたので。

今回は上のリンク先の結果と対比できるように tarai（y を返す）ではなく tak（z を返す。 “ニセ”竹内関数）で tak(20, 10, 0) を手元の環境（Intel Core i7-4650U @1.7GHz/2.3GHz、Win8.1 64-bit）で計測してみました。インストールの手間もあって、必ずしも最新バージョンをそろえられなかったのはご容赦ください。


　言語　 　処理系　 　結果　
　Smalltalk　 　Squeak 4.5 CogVM　 　1.33 sec　
　　 　Squeak 4.5 SpurVM　 　1.19 sec　
　　 　Squeak 4.3 CogVM　 　0.741 sec　
　　 　VisualWorks 7.10.1nc　 　3.87 sec　
　　 　Dolphin Smalltalk X6 (6.0.3ce)　 　3.45 sec　
　　 　GNU Smalltalk 3.1　 　14.1 sec　
　Python　 　Python 3.2.5　 　11.4 sec　
　Ruby　 　Ruby 2.2.0dev　 　4.52 sec　
　Scheme　 　Gauche 0.9.5_pre1　 　3.27 sec　
　JavaScript　 　Node.js 0.10.31　 　0.486 sec　
　C　 　gcc 4.8.3　 　0.217 sec　


いつの間にか VisualWorks より爆速になった Squeak（CogVM）は安定の結果ですが、その中でも AO bench で威力を発揮した SpurVM が期待したほどではなかったのが残念だったのに対し、思わぬ伏兵として Squeak 4.3 の古い CogVM が意外な好成績をたたき出したのが興味深いところです。Dolphin Smalltalk も入れたのでついでに計ってみたのですが、古い処理系のわりに健闘しています。

他言語では、JavaScript の V8エンジンが相変わらずバカっぱやいですね。勝てる気がしません。


Smalltalk で使用したコード（共通）

| tak res |
tak := nil.
tak := [:x :y :z |
   x <= y ifTrue: [z] ifFalse: [
      tak
         value: (tak value: x-1 value: y value: z)
         value: (tak value: y-1 value: z value: x)
         value: (tak value: z-1 value: x value: y)
   ]
].

(Time millisecondsToRun: [res := tak value: 20 value: 10 value: 0]) -> res

その他の言語のコードと出力

$ python3 -V
Python 3.2.5

$ python3 tak.py
11.36166000366211 1

$ cat tak.py
from time import time

def tak(x, y, z):
    if x <= y: return z
    return tak( tak(x-1, y, z), tak(y-1, z, x), tak(z-1, x, y) )

start = time()
res = tak(20, 10, 0)
print( time() - start, res )
$ ruby -v tak.rb
ruby 2.2.0dev (2014-08-26 trunk 47287) [x86_64-cygwin]
1
4.52072

$ cat tak.rb
def tak(x, y, z)
  if x <= y then
    z
  else
    tak(tak(x-1, y, z), tak(y-1, z, x), tak(z-1, x, y))
  end
end

start = Time.now
puts tak(20, 10, 0)
puts Time.now - start
$  gosh -V
Gauche scheme shell, version 0.9.5_pre1 [utf-8,pthreads], x86_64-unknown-cygwin

$ gosh tak.scm
;(time (display (tak 20 10 0)))
; real   3.274
; user   3.265
; sys    0.000
1

$ cat tak.scm
(define (tak x y z)
   (if (<= x y) z
     (tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y))))

(time (display (tak 20 10 0)))
$ node -v
v0.10.31

$ node tak.js
486 1

$ cat tak.js
function tak(x, y, z){
   if(x <= y){ return z; }
   return tak( tak(x-1, y, z), tak(y-1, z, x), tak(z-1, x, y) );
}

var start = (new Date()).getTime();
var res = tak(20, 10, 0);
console.log((new Date()).getTime() - start, res)
$ gcc --version
gcc (GCC) 4.8.3
Copyright (C) 2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.


$ cat tak.c
#include <stdio.h>

int tak(int x, int y, int z){
   if (x <= y){
      return z;
   } else {
      return tak( tak(x-1, y, z), tak(y-1, z, x), tak(z-1, x, y) );
   }
}

int main(void){
   printf("%d\n", tak(20, 10, 0));
   return 0;
}

$ gcc -O3 tak.c -o tak_O3

$ time ./tak_O3
1

real    0m0.217s
user    0m0.171s
sys     0m0.015s

ひさしぶりに AO bench を試したら Squeak/Pharo が（少しだけど 圧倒的に）VisualWorks より速くなっていたでござるの巻

OOPL

Island Life - Gaucheでaobench再び に触発されて、マシンも処理系も前回から刷新されたことだしと試してみました。コードはいろいろとひどいのであらためて書き下ろしたい気持ちもありましたが、へんに Smalltalk っぽく書き換えたところで遅くなるだけなので、前回のまま使いました。使用したマシンのスペックは Intel Core i7-4650U @ 1.7GHz/2.30GHz、Win 8.1 (64 bit）です。

　処理系　 　時間　
　VisualWorks 7.10.1 (64 bit)　 　34 sec　
　Pharo 3.0 / Cog JIT VM　 　27 sec　
　Squeak 4.5 / Cog JIT VM　 　26 sec　
　Squeak 4.5 (trunk46-spur.image) / Cog Spur JIT VM　 　13.5 sec　
　Squeak 4.3 / Cog JIT VM　 　37 sec　
　Squeak 4.3 / 旧 非JIT VM　 　114 sec　
　Ruby 2.1.2　 　64 sec
　C　 　1.7 sec　


ざっと C の 15倍遅いくらいでしょうか。Cog VM おそるべし。


[追記] …と思ったら、id:squeaker さん情報によれば Cog VM はさらに進化しているらしく、最新の Spur というバージョンを使うと C の 8倍程度の遅さをたたき出したのでありました。すばらしい。


Cog Spur VM とそれに対応した仮想イメージは、こちらから入手可能です。

[追記ここまで]


参考まで Gauche-0.9.5_pre1 は GAUCHE_AVAILABLE_PROCESSORS = 1 で 54s 、この制約をつけないでコア全部使うと 29s でした(cygwin64 環境。前後しますが Ruby、C も同じ）。


あと、Gauche は 0.9.4 も 0.9.5_pre1 も cygwin64 では現状なぜか gc のあたりでビルドに失敗するので（trunk にはパッチが当たっているはずなのですが…）、C はよくわからないながらもエラーから判断して ./gc/include/gc.h の _data_start__ をのたぐいを __data_start__ に書き換えて無理矢理とおしたのを使っています（下はそのときのエラー）。

main.o:main.c:(.rdata$.refptr._bss_start__[.refptr._bss_start__]+0x0): `_bss_start__' に対する定義されていない参照です
main.o:main.c:(.rdata$.refptr._data_start__[.refptr._data_start__]+0x0): `_data_start__' に対する定義されていない参照です
main.o:main.c:(.rdata$.refptr._bss_end__[.refptr._bss_end__]+0x0): `_bss_end__' に対する定義されていない参照です
main.o:main.c:(.rdata$.refptr._data_end__[.refptr._data_end__]+0x0): `_data_end__' に対する定義されていない参照です
collect2: エラー: ld はステータス 1 で終了しました

九州の七つの県を三色で塗り分ける問題を Squeak Smalltalk で

OOPL

688 ：デフォルトの名無しさん：2014/08/03(日) 16:21:36.50 ID:vVRF2pWw
お題：九州の七つの県を三色で塗り分ける。

プログラミングのお題スレ Part4 
| 九州 配色 状態 待行列 |
九州 := {
   #福岡 -> #(佐賀 熊本 大分).
   #佐賀 -> #(福岡 長崎).
   #長崎 -> #(佐賀).
   #大分 -> #(福岡 熊本 宮崎).
   #熊本 -> #(福岡 大分 宮崎 鹿児島).
   #宮崎 -> #(大分 熊本 鹿児島).
   #鹿児島 -> #(熊本 宮崎)
}.

配色 := 九州 inject: Dictionary new into: [:辞書 :kv | 辞書 at: kv key put: #(赤 青 黄) asOrderedCollection; yourself].
配色 at: #福岡 put: #(赤) asOrderedCollection.
状態 := 九州 collect: [:kv | kv key -> (配色 at: kv key) -> (kv value collect: [:val | 配色 at: val])].
待行列 := OrderedCollection with: 状態.
[待行列 notEmpty] whileTrue: [
   | 県と候補色群 |
   状態 := 待行列 removeFirst.
   配色 := 状態 collect: #key.
   県と候補色群 := 配色 detect: [:kv | kv value size > 1] ifNone: [^配色 collect: [:kv | kv value: kv value first; yourself]].
   県と候補色群 value do: [:候補色 |
      | 次状態 |
      次状態 := 状態 veryDeepCopy.
      (次状態 detect: [:kv | kv key key == 県と候補色群 key]) key value removeAllSuchThat: [:val | val ~= 候補色].
      次状態 do: [:kv | kv key value size = 1 ifTrue: [kv value do: [:vals | vals removeAllFoundIn: kv key value]]].
      (次状態 noneSatisfy: [:kv | kv key value isEmpty]) ifTrue: [待行列 add: 次状態]]
]

=> {#'福岡'->#'赤' . #'佐賀'->#'青' . #'長崎'->#'赤' . #'大分'->#'青' . #'熊本'->#'黄' . #'宮崎'->#'赤' . #'鹿児島'->#'青'}


読み下すとき、kv のキーが何で対応する値がなんなのかわからずピンとこないのでイマイチ。

Coffee Time Challenges, Q13 How many を Squeak Smalltalk で

OOPL

ときどきの雑記帖″ 2014年7月(下旬) 経由で。（ネタバレ注意）

13) How many

Challenge: ABCDEFGHIJ is a ten-digit-number. All of the digits are distinct. If 11111 divides it evenly, how many possibilities are there for ABCDEFGHIJ?

Coffee Time Challenges


方針は合っているはずなので、あとはスタート値に注意ですね。

((1023456789 roundTo: 11111) to: 9876543210 by: 11111) count: [:each | each asString asSet size = 10]  "=> 3456 "