“とある世界のタクシー料金”問題を Squeak/Pharo Smalltalk で

| cityOfPlace distOfSection additFare initFare fareFor |
cityOfPlace := Dictionary new.
#(円來 'ABC' 炭州 'DEFG') pairsDo: [:ci :pls | pls do: [:pl | cityOfPlace at: pl put: ci]].

distOfSection := {
   'AC'->180.
   'AB'->1090.
   'DA'->540.
   'BC'->960.
   'BG'->1270.
   'DC'->400.
   'CF'->200.
   'DE'->720.
   'DF'->510.
   'EG'->1050.
   'FG'->230
} as: Dictionary.

initFare := {#円來->#(-995 400). #炭州->#(-845 350)} as: Dictionary.
additFare := {#円來->#(-200 60). #炭州->#(-200 50)} as: Dictionary.

fareFor := [:path |
   | path1 distAndFare |
   path1 := path. "for Pharo"
   distAndFare := (initFare at: (cityOfPlace at: path1 first)) copy.
   [path1 size < 2] whileFalse: [
      | section nextDist city |
      section := path1 first: 2.
      nextDist := distOfSection at: section
         ifAbsent: [distOfSection at: (section := section reversed)].
      distAndFare at: 1 incrementBy: nextDist.
      city := cityOfPlace at: section first.
      [distAndFare first positive]
         whileTrue: [distAndFare := distAndFare + (additFare at: city)].
      path1 := path1 allButFirst.
   ].
   distAndFare last
].


#(
   (0  ADFC  510)
   (1  CFDA  500)
   (2  AB  460)
   (3  BA  460)
   (4  CD  400)
   (5  DC  350)
   (6  BG  520)
   (7  GB  530)
   (8  FDA  450)
   (9  ADF  450)
   (10  FDACB  750)
   (11  BCADF  710)
   (12  EDACB  800)
   (13  BCADE  810)
   (14  EGFCADE  920)
   (15  EDACFGE  910)
   (16  ABCDA  960)
   (17  ADCBA  1000)
   (18  BADCFGB  1180)
   (19  BGFCDAB  1180)
   (20  CDFC  460)
   (21  CFDC  450)
   (22  ABGEDA  1420)
   (23  ADEGBA  1470)
   (24  CFGB  640)
   (25  BGFC  630)
   (26  ABGEDFC  1480)
   (27  CFDEGBA  1520)
   (28  CDFGEDABG  1770)
   (29  GBADEGFDC  1680)
) do: [:data | self assert: (fareFor value: data second) = data last]


以下、解説。


cityOfPlace は乗降場所(A〜G)がどちらの市にあるか、の辞書です。

distOfSection は各区間がどのくらいの距離かを調べるための辞書です。キーである区間は乗降場所二カ所を表わす二文字の組み合わせの文字列で、距離を引けるようになっています。両端の乗降場所がある市が異なる場合については、最初の文字の市がその区間が属する市と同一になるようにしました。

initFare、additFare は、それぞれの市(円來、炭州)での初乗り、もしくは、加算の距離と運賃のタプル(配列ですが)を引くための辞書です。

これくらいを用意しておけば、料金体系の違う市が追加されることがあっても対応可能と考えました(無いと思いますが^^;)。


fareFor が料金計算機です。お題にあるように乗降場所のルート(パス)を表わす文字列を与えることでかかった料金の計算をします。


冒頭に

path1 := path. "for Pharo"

とあるのは、Squeak と違い、Pharo ではブロック引数への代入が禁じられているため、書き換え専用の一時変数(path1)を用意したからです。


まず、path1 の一文字目(path1 first)で cityOfPlace 辞書を引いてどちらの市からの乗車かを判定し、さらにその市の初乗り距離と料金のタプルを distAndFare の初期値として得ます。あとで処理を単純な加算ですませられるように、初乗り距離は負にしてあります。

distAndFare := (initFare at: (cityOfPlace at: path1 first)) copy.

あとで破壊的な操作をしているので、得られた値はここでコピーしておかないとひどい目に遭います。^^;


path1 が二文字より少なくなければ、最初の二文字から区間 section を得ます

section := path1 first: 2.


得られた区間をキーにして distOfSection 辞書から距離 nextDist を得ますが、見つからなければ section を逆順にして辞書を引き直します。

nextDist := distOfSection at: section
   ifAbsent: [distOfSection at: (section := section reversed)].


区間を Set のインスタンスとして管理しておけば逆順にして〜のくだりの処理は必要ないので、どうするかすこし迷ったところですが、区間が属する市、ひいては加算距離と料金を得るのに簡単で、distOfSection 辞書を複雑にしない方向にしました。

ここで得られた nextDist をもって、distAndFare の第一要素である初乗り距離(負数)に破壊的に加算します。

distAndFare at: 1 incrementBy: nextDist.

こういうむき出しの処理が入ると、distAndFare は料金メーターかなにかに抽象化したオブジェクトであったほうがコードの可読性が増すのでよいかなとも一瞬思いましたが、たとえば GUI をつけるとか、ゲームやシミュレーションにするとかの方向にこのお題が拡張されることはないと判断し、そういう仕組みを作り込むことはしませんでした。


続いて、必要なら加算距離・料金の計算をするために、区間が属する市を得ます。すでに section は第一文字目が示す乗降場所がその区間が属する市と一致するように変更されているので、キーは section first で事足ります。

city := cityOfPlace at: section first.


負数の初乗り距離に対して、正の区間距離を足していますので、それがゼロ以上になるのを待って(distAndFare first positive)、その間、距離を減算しつつ料金を加算します。

distAndFare := distAndFare + (additFare at: city))

距離と料金のタプル(配列)同士の加算(加算距離の方は負数なので減算)になっているのがミソとなっています。


最後に、path1 から最初の文字を省いて次の区間の計算を同様に繰り返し、

path1 := path1 allButFirst.


パスを消費しつくしたら、タプルの料金の方だけを返し終了する、

   distAndFare last


とそんな感じです。

「進捗・どう・です・か」を Squeak Smalltalk で

タイトルにもあるように「進捗・どう・です・か」をランダムな順序で表示し、「進捗どうですか」が完成したところで適当にクエスチョンマークをつけて去っていくプログラムです。

特に意味もなく文字カウントします。おおよそ数十文字から1000文字程度で目的を成し遂げて去っていきます。

「進捗・どう・です・か」をランダムに表示し「進捗どうですか」が完成したら煽ってくるプログラム | ぞうさんの何でもノート
| elems count tail |
elems := #(進捗 どう です か).
count := 0.
World findATranscript: nil.
Transcript cr.
tail := OrderedCollection new: elems size withAll: ''.
[  Transcript show: (tail removeFirst; add: elems atRandom).
   count := count + tail last size.
   tail asArray = elems
] whileFalse.
Transcript show: '???\' withCRs, count, '文字で煽られました。'

共立出版刊「Common Lisp オブジェクトシステム」の共通例題 Grapher の Smalltalk-80 版を Squeak 1.3 で

Ruby の「特異メソッド」命名の元ネタとも言われる共立出版刊「Common Lisp オブジェクトシステム」にあった各種 OOPL での共通例題の Smalltalk-80 版を Squeak Smalltalk のごく初期のバージョン(1.31)で動かしてみました。


http://squab.no-ip.com/collab/uploads/CLOS-Grapher.png http://squab.no-ip.com/collab/uploads/CLOS-Grapher-ori.png


だいぶ改変しないといけないのかな…とおそるおそる試しててみたところ、GrapherView >> #display を #displayView に変更するなどちょこっと変えるだけで案外あっさり動きました。あと、GrapherController >> #isControlActive は必要ないようだったので削ったり、通常のクリックでもメニューが出るように GrapherController >> #redButtonActivity を追加したりしてあります。


Squeak1.3 は ftp.squeak.org のアーカイブから入手してものを使用しました(Windows 版)。展開して、Squeak1.31.image を Squeak.exe にドロップインすると起動できます。手元の環境では、あらかじめ Squeak.exe のプロパティ→ 互換性で XP 互換にして動かすと安定するように見えました。


CLOS-Grapher.st を Squeak1.31 フォルダに移動してから Squeak 環境内で デスクトップクリック → open... → open file list でファイラを起動し、CLOS-Grapher.st を右クリック → fileIn で環境に読み込めます。Grapher 自体の起動は、下のペイン(選択ファイルの内容)をスクロールするなどして GrapherView open を見つけて選択し(あるいはどこかにタイプして入力してから改めて選択し)、右クリック → do it (d) で起動します。

ウインドウ内をクリックするとメニューが現われるので、add node もしくは複数のノードがある状態で add arc し、十字のマウスポインタで設置したいウインドウ内の位置をクリックする(前者)とノードを、つなぎたい2つのノードを順次クリックして選択する(後者)とアークを追加できます。


ちなみに、ここで用いた Squeak1.31 を使うと、第30回Smalltalk勉強会「もういちどMVC」 で使われた副読本 青木淳さんの「使わないと損をするModel-View-Controller」 のコードを移植した Mickey1(コントローラーが頑張る MVC )、Mickey2(依存性を利用する MVC )、Mickey3(プラガブルを利用する MVC )を動かしてみることも可能です。ぜひ、おためしあれかし。


Common Lisp オブジェクトシステム

Common Lisp オブジェクトシステム

“SEND + MORE = MONEY”ソルバーを Squeak Smalltalk で その4

久しぶりに SEND + MORE = MONEY 。以前書いたもの(ブルートフォース版)の焼き直しなのですが、少しだけ趣を変えてみました。デュードニーの覆面算というのですね。

| int solveAlphametics |

int := [:array | array reversed polynomialEval: 10].

solveAlphametics := [:spec |
   | check ans |
   check := spec value: (ans := OrderedCollection new).
   (0 to: 9) combinations: check numArgs atATimeDo: [:digits |
      digits permutationsDo: [:param | check valueWithArguments: param]].
   ans asArray].

solveAlphametics value: [:ans | [:S :E :N :D :M :O :R :Y |
   | a b c |
   (({S. M} noneSatisfy: #isZero) and: [
      (a := int value: {S.E.N.D})
      + (b := int value: {M.O.R.E})
      = (c := int value: {M.O.N.E.Y})]) ifTrue: [ans add: {a. b. c}]]].
"=> #(#(9567 1085 10652)) "

solveAlphametics value: [:ans | [:W :D :O :T :G :L :E :C :M |
   | a b c |
   (({W. G. D} noneSatisfy: #isZero) and: [
      (a := int value: {W.W.W.D.O.T})
      - (b := int value: {G.O.O.G.L.E})
      = (c := int value: {D.O.T.C.O.M})]) ifTrue: [ans add: {a. b. c}]]].
"=> #(#(777589 188106 589483) #(777589 188103 589486)) "

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

引数を評価する(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(maclinux、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


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

この中で3番目の「プロトコル」というちょっと見慣れない概念は、メソッドカテゴリーやメッセージカテゴリーとも呼ばれ、クラスに定義されたメソッドを分類するための属性です。メソッドを定義するときにあらかじめ指定しておく必要があるものですが、特に指定しなければ 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

という式をどこか(文字が入力できれば原則どこでもOKですが普通は デスクトップ右クリック→ 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 に残さなかった(残せなかった、あるいは正常に動作させられない、させる気のない)開発陣には殺意すら禁じ得ませんがw、今どきの Find/Replace はまあ普通に作ってあるしこれでいいと思います。

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

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

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

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



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

| 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 で

  • プログラミング言語は自由(既に応募がある言語でも 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