Parenscriptで少し遊んで見る （2）ドット記法編
@マクロが長い
Parenscriptを書いていると真っ先に気になってくるのが@マクロです。下記の最初の例のように一つ程度ではそうでもないですが、いくつか並ぶと主張が激しく気になってきます。newに至っては単体でもだいぶ見づらいです。
CL-USER> (import 'ps:@) T CL-USER> (ps:ps (setf (@ $scope -test) 20)) "$scope.Test = 20;" CL-USER> (ps:ps (ps:new ((@ test create) 10))) "new test.create(10);"
試しにドット記法で書いてみると一応動きますが警告が出ます*1。
CL-USER> (ps:ps (setf $scope.-test 20)) ; Warning: Symbol $SCOPE.-TEST contains one of '.[]' - this compound naming convention is no longer supported by Parenscript! "$scope.Test = 20;"
また、実際に問題になるのは他の機能と連携が取れないという部分で、例えばwith-slotsによるシンボル置き換えに反応してくれません。
; 警告とダブルクォーテーションの出力を省略 CL-USER> (ps:ps (with-slots (-test) $scope (setf (@ -test a1) 20) (setf -test.a2 20))) $scope.Test.a1 = 20; Test.a2 = 20;
力業でドット記法に対応する
要はドットがあったら「test.abc.def → (@ test abc def)」のように変換すればいいわけですよね、ということで、コードツリーを全走査して見つけたドット記法を片っ端から置き換えるps.マクロを作るという力業に出てみます。
(ql:quickload :parenscript) (ql:quickload :cl-ppcre) (defun replace-dot-sep (elem) (if (and (symbolp elem) (not (null (symbol-package elem)))) ; gensym case (let ((name (symbol-name elem)) (pack-name (package-name (symbol-package elem)))) (cond ((and (> (length name) 1) (string= name "!!" :start1 0 :end1 2)) (intern (subseq name 2) pack-name)) ((ppcre:scan "\\." name) `(ps:@ ,@(mapcar (lambda (x) (intern x pack-name)) (ppcre:split "\\." name)))) (t elem))) elem)) (defun replace-dot-in-tree (tree) (labels ((rec (rest) (let (result) (when rest (dolist (elem rest) (push (if (listp elem) (rec elem) (replace-dot-sep elem)) result))) (nreverse result)))) (rec tree))) (defmacro ps. (&body body) `(ps:ps ,@(replace-dot-in-tree body)))
2015/11/13追記: gensymで作られたシンボルのように、パッケージにinternされていないシンボルを渡された場合、(symbol-package elem)がNILとなってsymbol-name関数でエラーとなることがあったため、replace-dot-sep関数にNILチェックを追加しました。
シンボル名の頭に"!!"があるときは変換しないという逃げ道もつけてみました*2。余計かもしれません。試し打ちしてみます。
(ps. (setf $scope.abc.def 123) (with-slots (abc) $scope (setf abc.def 123) (setf !!abc.def 123))))
=> $scope.abc.def = 123; $scope.abc.def = 123; abc.def = 123;
ps.マクロの展開結果も見てみます。
(PARENSCRIPT:PS (SETF (@ $SCOPE ABC DEF) 123) (WITH-SLOTS (ABC) $SCOPE (SETF (@ ABC DEF) 123) (SETF ABC.DEF 123)))
いい感じですが、まだ問題があります。defmacro+psで定義したマクロなど、ps.マクロの外で作ったものを持ち込むと反応できません。
(ps:defmacro+ps test-mac (a) `(ps:with-slots (abc) ,a (ps:setf abc.value 100))) (print (ps. (test-mac $scope)))
=> abc.value = 100;
ps.マクロ側ではいかんともしがたいので、defmacro+ps側をラップしてdefmacro.psマクロを作成します。
(defmacro defmacro.ps (name args &body body) `(ps:defmacro+ps ,name ,args ,@(replace-dot-in-tree body))) (defmacro.ps test-mac (a) `(ps:with-slots (abc) ,a (ps:setf abc.value 100))) (print (ps. (test-mac $scope)))
=> $scopeabc.value = 100;
まだ抜けがあるかもしれませんが、その都度defmacro.psのように3行程度書けば対応可能なはずです。
ひとまとめ。
=> $scope.abc.def = 123; $scope.abc.def = 123; abc.def = 123; $scope.abc.value = 100;
別解（リンク）
もっときれいに、しかもCommon Lispのパッケージシステムの中に取り込む形で解決しているのが「http://e-arrows.sakura.ne.jp/2011/01/cl-wrapper-for-google-closure.html」です。
- 前の記事：「Parenscriptで遊んで見る (1) defun編 - eshamster’s diary」
- 次の記事：「Parenscriptで少し遊んで見る （3）キャメルケース編 - eshamster’s diary」
Parenscript関連記事
Lisp-Parenscript カテゴリーの記事一覧 - eshamster’s diary
Parenscriptで遊んで見る (1) defun編
TypeScriptやCoffeeScriptといったJavaScriptを吐き出す言語の名前をしばしば聞きます（まだ使ったことはないです…。）が、Common LispにはParenscriptというものがあります。少しいじってみていたのですが、defun周りが気になったので少し遊んでみたという記事です。
次のように、ps環境下でdefunすると、javascriptの関数定義が出力されます。
(defun test-ps () (ps:ps (defun f1 (a b) (+ a b)) (f1 10 20))) (print (test-ps))
=> function f1(a, b) { return a + b; }; f1(10, 20);
ネストした環境下でdefunを書くというのもなんか気持ち悪いので…、外に出してみます。
; NG (defun f1 (a b) (+ a b)) (defun test-ps () (ps:ps (f1 10 20))) (print (test-ps))
=> f1(10, 20);
ダメでした。次、psマクロは結局のところ文字列を出力しているのでconcatenateしてみます。見栄えのため改行を補っています。
(defun f1_ () (ps:ps (defun f1 (a b) (+ a b)))) (defun test-ps () (concatenate 'string (f1_) " " (ps:ps (f1 10 20)))) (print (test-ps))
=> function f1(a, b) { return a + b; }; f1(10, 20);
出力は合いました。パターンが見えてきたらマクロ化するに限ります*1（defun+ps）。
(defun intern-ub (sym) (intern (format nil "~A_" (symbol-name sym)))) (defmacro defun+ps (name args &body body) (let ((name_ (intern-ub name))) `(defun ,name_ () (ps:ps (defun ,name ,args ,@body))))) (defun+ps f1 (a b) (+ a b)) (defun+ps f2 (a) (+ a (f1 a 20)))
それっぽくなってきました。
defunをもう一つ並べて同名のLisp関数も定義したら便利かもしれない、とおせっかいなことも考えました*2が、body部が必ずしもLisp環境でコンパイルできるわけではないはずなのでやめました。別名で提供するのはありかもしれません。
今度は一々concatenateするのが面倒なのでマクロ化します（with-import-ps-def）。
; (interleave '(1 2 3) "a") => (1 "a" 2 "a" 3 "a") (defun interleave (lst delim) (labels ((rec (result rest) (if (null rest) result (rec (append result (list (car rest) delim)) (cdr rest))))) (rec nil lst))) (defmacro with-import-ps-def (ps-lst &body body) `(concatenate 'string ,@(interleave (mapcar (lambda (elem) (list (intern-ub elem))) ps-lst) " ") (ps:ps ,@body))) (defun test-ps () (with-import-ps-def (f1 f2) (f1 10 20)))
=> function f1(a, b) { return a + b; }; function f2(a) { return a + f1(a, 20); }; f1(10, 20);
関数名を二度（定義とimport）書く必要があるのはいまいちですね…。これを減らそうとするとグローバルに環境を作っていかないとできなさそうです。さらに、JavaScript側での二重定義をどう避けるかと考えるとそう簡単ではないように思います。Parenscriptでマクロを定義するためのdefmacro+psが用意されている一方で、defun+psがないのはこういった辺り*3が原因なのかと思う次第です。
切れ切れになってしまったので、最後に動作するroswellスクリプトを。やめましたと言いつつ、おせっかい版のdefun+psです。main関数内でLisp関数としてf2を使ってみています。
続く？
マクロって楽しいですね Parenscriptいいですね。ドキュメントを見ると、ちょっと変換してみました、ではなくて本気でLispの世界を持ち込もうという意気込みが伝わってきます。とはいえ、Parenscriptを触っていると不満に思うところもあるので、その辺りをいじくり回した結果がいくつか記事になりそうです。
Parenscript関連記事
Lisp-Parenscript カテゴリーの記事一覧 - eshamster’s diary
Common Lispでナイーブベイズをナイーブに実装
精度を問わず簡単に使える分類器が欲しかったので、Common Lispでナイーブベイズ分類器cl-naive-bayesを作りました。
使い方は簡単です。まずは学習。学習結果を保持するlearned-storeを用意した後は、learn-a-document関数にこのstore，ドキュメント = 単語のリスト*1，カテゴリ（スパムメール判定であれば「スパム」or「非スパム」）の3つを渡すだけです。
(defparameter *store* (nbayes:make-learned-store)) ; (カテゴリ 単語のリスト) (defparameter *documents* (list '("A" ("a1" "a2" "a3" "a4" "ab")) '("A" ("a3" "a4" "a5" "a6")) '("B" ("b1" "b2" "b3" "b4" "ab")) '("C" ("c1" "c2" "c3")))) (dolist (doc *documents*) (nbayes:learn-a-document *store* (cadr doc) (car doc)))
次に分類ですが、学習したstoreと単語のリスト（ドキュメント）をsort-category-by-prob関数に渡すだけです。以下のように事後確率の高い順にソートして出力してくれます。事後確率も同時に取得したい場合は、sort-category-with-post-probを使います。
(nbayes:sort-category-by-prob *store* '("a1" "ab" "c1" "new")) => ("A" "C" "B") (nbayes:sort-category-with-post-prob *store* '("a1" "ab" "c1" "new")) => (("A" . 0.4211471) ("C" . 0.3527683) ("B" . 0.22608456))
解説の方針
ナイーブベイズ分類器自体についてはすでに良い解説があるので参考にしたリンクを張るにとどめ、作るには結局どうすんのさというところだけ書きます。ということでまずはリンクを。
- 解説とPythonによる実装例：ナイーブベイズを用いたテキスト分類 - 人工知能に関する断創録
- ベイズ確率自体などもう少し基礎的な話も：[WIP]単純ベイズ分類器がまったく単純じゃないので入門 | moxt
データ構造
上で紹介したサイトは、アルゴリズムの解説は大変分かりやすいのですが、データ構造に関わる情報が分散していて分かりづらかったように記憶しています。ということで、アルゴリズムの解説は置いてデータ構造だけ説明しようと思います。データ構造が分かればできたようなものだという人もいるのできっと問題ないでしょう。
学習データとテストデータ
まず学習や分類（テスト）の一単位はドキュメントです。例えば、スパムメール分類であれば一つのメールが一つのドキュメントにあたります。ナイーブベイズ分類器がこのドキュメントをどう認識するかというと、単なる単語の羅列として認識します。これがナイーブたる所以で、文脈やら順序やら何もかも無視して、誰かがドキュメントを単語の羅列に分解したものを受け取ります。
また、学習データとテストデータの差は、前者が教師情報にあたるカテゴリ（文字列）を持っているという部分だけです。
学習用のlearn-a-document関数と、分類用のsort-category-by-prob関数のシグネチャを見るとおおむね了解できると思います。storeは次に述べる学習データを保持している構造体です。
; シグネチャのみ ; 例：word-lst: '("I" "am" "a" "pen"), category: "spam" (defun learn-a-document (store word-lst category)) (defun sort-category-by-prob (store word-lst))
学習結果の保持
導出は上記のリンクを参照して欲しい*2のですが、データ構造を決める上で必要な式だけ取り出します。
簡単に説明します。doc, catと並ぶとdogとcatに見えて仕方ないのですが、documentとcategoryです。第1式の事後確率P(cat|doc)が求めたいものです。値が大きいほど与えられたドキュメント（例．メール）がそのカテゴリ（例．スパム or スパムじゃない）に属する確率が高いということで、これを全カテゴリについて計算して比較します。計算方法が右辺になりますが、カテゴリ分けのためには大小関係だけ分かればよいので、カテゴリに依存しないP(doc)は除いて事前確率P(cat)と尤度P(doc|cat)だけを計算します。
第2式の事前確率P(cat)は見たままですが、分子・分母に「学習における」と接頭辞をつけるとより分かりやすいでしょうか。第3式の尤度P(doc|cat)を求めるためには、見ての通りとにかくカテゴリにおける各単語の登場数さえ覚えておけばよいことが分かります。なお、の各要素は非常に小さい値になる場合が多いため、logをとって足し算として計算するのが普通のようです。cl-naive-bayesでも踏襲しています。
(defstruct learned-store (category-data-hash (make-hash-table :test #'equal)) (num-document 0) (num-word-kind 0)) (defstruct category-data (count 0) (sum-word-count 0) (word-count (make-hash-table :test #'equal)))
ということでこのようになりました。全体として必要なデータ（learned-store）は学習したドキュメントの総数（num-document）とカテゴリごとのデータ（category-data-hash）になります。カテゴリごとに持っておくデータ（category-data）は学習した回数（count）と各単語の出現回数（word-count）です。
今記述しなかった二つのデータはキャッシュ（計算で求められるデータ）で、learned-storeのnum-word-kindは学習した単語の種類数であり、category-dataのsum-word-countはカテゴリ内での全単語の登場数の和です。後者はともかく前者は上記の式にも出ていませんが、ラプラス・スムージング（Laplace Smoothing）に利用します。この目的は、そのカテゴリで未知の単語が出てきたときにP(doc|cat)が0になることを避けることです。偉そうな名前がついていますが、単に初めての単語も1回出たものとして計算するという代物です。同様にn回出た単語はn+1回出たと考えるので、第3式の分子には1を足します。これを学習した全種類の単語で行うため、分母には単語の種類数を足します。ここで足す値がnum-word-kindです。
ここまで分かればアルゴリズムはほぼ自明だと思います。学習ではカテゴリと単語リストの組を受け取って、learned-storeの適切なスロットをカウントアップします。実際の分類では、上記の式に従ってP(cat|doc)の大小関係を計算するだけです。注意が必要なのは、計算過程ではlogをとるということと、ラプラス・スムージングぐらいです。
ソース全体は以下の通りです。ハッシュ内にデータがあるかないかで処理が変わる部分が多いため、anaphoraが大活躍しています。
cl-naive-bayes/cl-naive-bayes.lisp at master · eshamster/cl-naive-bayes · GitHub
cl-naive-bayesの実装上の工夫
特にないです…も悲しいので小さいものを二つ。
事後確率の求め方
一般的なナイーブベイズ実装にならい、事後確率の分母を無視して分子の（logの）大小比較のみでソートをしています。上記リンク先のPython実装では疑似的に事後確率を求める方法として、logで分子を求めた後にそれぞれexpをとった和で割って正規化するという方法が紹介されています。が、expに渡す値が-1000などという値になっていると、0しか返って来ないため計算できません。下記使用例のスパム判定のように超ナイーブな使い方をするとこういう値が普通に出てきます。ということで計算上の簡単な工夫ですが、(log a, log b, log c)の状態からいきなりexpをとるのではなく、全体からlog aを引いて(log 1, log b/a, log c/a)としてからexpをとっています。
incf-plus
学習用の関数learn-a-documentで使っています。適当に命名したので何も伝わらないと思いますが、引数なしincfの拡張版で、数値に対してはincfと同じく（破壊的に）1を足す一方で、nilの場合はエラーとせず1を代入する点が異なります。目的は下記のように何度もgethashを使うのを避けることです。
; これを… (if (gethash word (category-data-word-count it)) (incf (gethash word (category-data-word-count it))) (setf (gethash word (category-data-word-count it)))) ; こうしたい (incf-plus (gethash word (category-data-word-count it)))
実装はOn Lispの汎変数の章を参考に、define-modify-macroを使いました。
なお、元々はanaphoraのsif（aifと異なり代入可能なitが提供される）を使おうとしていましたが、上記例の通りすでにit（anaphoraのsletによる）を使っているため、意図通りに動きませんでした。
試しに使ってみる
バグチェックも兼ねてスパム判定を試してみようとroswellスクリプトを起こしました（データを用意する部分はshellスクリプトに逃げました）。
cl-naive-bayes/judge-spam.ros at master · eshamster/cl-naive-bayes · GitHub
英文のスパムメール判別コーパス（http://spamassassin.apache.org/publiccorpus/）の2002年版easy_hamとspamを使います。メール本文をいかにして単語のリストに変換するかが腕の見せどころ…のはずですが、tokenize-mail関数ではヘッダのタグも何もかも空白・改行区切りでリストにして分類器にぶち込むゴミ実装になっています（例えば、"From:"なんかは全部のメールに出そうです…）。さすがにこれだと60～70%ぐらいで頭打ちになりそうなので、簡単なヘッダ解析とか品詞分類ぐらいはしないと…と思って事前に調べていたのですが、意外と95%ぐらいまで正解していたので満足してしまった次第です*3。ナイーブベイズ恐るべし。
一応グラフを。テストデータを後ろから3割で固定し、学習データを前からX割で変化させた場合の正解率（5%信頼区間つき）です*4。全データ数は、非スパムが2546, スパムが497です。
- メモ
できていないもの
- ダンプやリストア
- 実運用を考えると、DBに保管したりそこから復元したりという機能は必須でしょう。
- 全ダンプだけでなくて、DB更新用にlearn-a-documentに更新差分を吐かせるようなオプションも必要でしょうね。実装面倒そうですが…。
- 解析用の機能
- カテゴリごとの事後確率の高い単語ランキングなんて面白そうです。
- チューニング用の機能
- ポール・グレアムの「ベイジアンフィルタの改善 --- Better Bayesian Filtering」を見ると様々な工夫をして性能を上げていますが、そういった柔軟性をどこまで持たせるのかという部分です。
- 今のところそんなにガチガチの用途を考えていないのでやる気低です。
Let Over Lambdaのnlet-tailがよく分からなかったのでメモ
在庫切れになっていたLet Over Lambdaの訳本にオンデマンド版なるものが出ていることに気付いたので買って読んでいます。
- 作者: ダグホイト,Doug Hoyte,タイムインターメディアHOPプロジェクト
- 出版社/メーカー: エスアイビーアクセス
- 発売日: 2014/12/22
- メディア: 単行本
- この商品を含むブログを見る
電車で少しずつ読んでいますが、「4.4 macroletを使ったコードウォーク」に出てくるnlet-tailマクロがよく分からなかったので展開してみたメモです。なお、quicklispには同書で書かれたユーティリティ一式を備えた"let-over-lambda"が登録されているので、(ql:quicklisp :let-over-lambda)とすればすぐに試せます。
まずこの4.4節の目的は、マクロで受け取ったリスト内のシンボルをどう置き換えるかというところにあります。そんなもの、ちょっと再帰でネストしたリストを手繰ってシンボルを探すとか、sublis関数を使うとかで簡単にできるでしょ…と思えるのですが、例えばクォートされたシンボルを置き換えるのはまずいですし、letの左辺（？）を置き換えるのもまずいです。仕様上同様の考慮が必要なスペシャルフォームは25個もあるので、とてもじゃないが自力で正しくなんてできない、というのが提起されている問題です。
そこで、macroletを使うことでそれ、すなわちコードウォークをさせればよい。その例として末尾再帰最適化を明示的に行うnletマクロ、名付けてnlet-tailマクロを作る、とのことですが…
(defmacro! nlet-tail (n letargs &body body) (let ((gs (loop for i in letargs collect (gensym)))) `(macrolet ((,n ,gs `(progn (psetq ,@(apply #'nconc (mapcar #'list ',(mapcar #'car letargs) (list ,@gs)))) (go ,',g!n)))) (block ,g!b (let ,letargs (tagbody ,g!n (return-from ,g!b (progn ,@body))))))))
…すいません、分かりません。とりあえず以下を知りたいところです。
- ナニコレ
- macroletでコードウォークするってつまりどういうこと？
ということで、電車で脳をスタックオーバーフローさせるのはやめて家で展開してみました。展開する対象は同書でも例として挙げられている階乗計算関数の定義です。
(defun nlet-tail-fact (n) (let-over-lambda:nlet-tail fact ((n n) (acc 1)) (if (zerop n) acc (fact (1- n) (+ acc n)))))
定義部分のlet-over-lambda:nlet-tail以下を展開してみます。
; macroexpandしてみる (LET () (MACROLET ((FACT (#:G990 #:G991) `(PROGN (PSETQ ,@(APPLY #'NCONC (MAPCAR #'LIST '(N ACC) (LIST #:G990 #:G991)))) (GO ,'#:N988)))) (BLOCK #:B989 (LET ((N N) (ACC 1)) (TAGBODY #:N988 (RETURN-FROM #:B989 (PROGN (IF (ZEROP N) ACC (FACT (1- N) (+ ACC N)))))))))) ; 見づらいのでgensymで生成されたオブジェクトをそれらしい名前で書き換える (LET () (MACROLET ((FACT (n-value acc-value) `(PROGN (PSETQ ,@(APPLY #'NCONC (MAPCAR #'LIST '(N ACC) (LIST n-value acc-value)))) (GO ,'tag)))) (BLOCK blk (LET ((N N) (ACC 1)) (TAGBODY tag (RETURN-FROM blk (PROGN (IF (ZEROP N) ACC (FACT (1- N) (+ ACC N)))))))))) ; 手で最終行のFACTを展開（macroletは省略） (LET () (BLOCK blk (LET ((N N) (ACC 1)) (TAGBODY tag (RETURN-FROM blk (PROGN (IF (ZEROP N) ACC (PROGN (PSETQ N (1- N) ACC (+ ACC N)) (GO tag)))))))))
こうして展開してみると、確かに末尾再帰呼び出しをループ（このとき、goで飛ぶ手前で引数に当たるn, accをpsetqで更新）に展開していることが見てとれます。デフォルトではreturn-fromで抜けるようにして、続けたい場合はgo（goto）でreturn-fromの手前まで投げ返すのですね。乱暴な感じもしますが、マクロで隠してしまえば表にはきれいな構造しか見えないのでありだということでしょうか。ちょっと思考の幅が広がる感じがします。…ということで知りたいこと1番目の「ナニコレ」は分かりました。
次はmacroletでコードウォークってどういうことかという部分です。展開してみるまで勘違いしていたのですが、ここでの目的は任意の位置にあるシンボルを置き換えることではなく、一見関数シンボルに見せているもの（上記ではfact）を別の処理で置き換えるということでした*1。関数の位置にあるシンボルを認識して別の処理に変換する、かつクォートされたリストの先頭などの置き換えは避ける…という動作を冷静に考えると、マクロ展開の動作そのものです。そんなわけで、別に独自のコードウォークなんて書かなくても、マクロを使えば目的は達成できますよという話のようです。ここでdefmacroではなく、macroletを使うのは単純に無用な名前衝突を避けるためですね。
まだ4章までしか読めていませんが、Let Over Lambdaは面白い本ですね。不満があればなんであれ自ら書き換えるのがLisperの性質だということは納得しつつあったので、全部が全部驚くわけではないのですが。特に興味をひかれているのは第1章終わりの下記の一文です。
値割り当て可能なセルと古き良きラムダ式があれば、オブジェクトシステムは、よく言っても有効なこともある抽象化の手段に過ぎず、悪くすると特殊な場合であり余計なのである。
信奉する気はなかったにせよ、短いプログラマ人生の中でオブジェクト指向が大きい位置を占める言語（特にC#）との付き合いは長かったので、その原始的なところには何があり、便利にする過程で何をそぎ落としてしまったのか、というところは多分に興味があります。この先まだまだその源流である"let over lambda"の威力を見せつけてくれるとのことなので大変楽しみです。
*1:そのつもりで手前の文章を読み直してみると実際そう書いてありますね…
引数文字列をinternするアナフォリックマクロでハマったこと
CSVファイルを処理するために、引数の文字列をシンボル化して（intern）束縛するアナフォリックなマクロを書いていてハマったことのメモ。シンボルとパッケージの関係は段々と分かってきたつもりでしたが、まだまだハマるときはハマりますね。
悪い例
例のための例ですが、まずパッケージAで目的のマクロwith-interned-strを定義します。すぐ下の使用例を見ると分かる通り、第一引数の文字列（"abc"）をinternしてできあがったシンボル（ABC）に、第二引数の値（100）を束縛し、body内では変数のように扱えるという代物です。
次に、パッケージBではwith-interned-strを利用するマクロsome-macro*1を定義します。実際に下でsome-macroを試してみると、意図通りシンボルDEFに値が束縛されており、渡した200という値が出力されます。
よしよしと思って今度はパッケージCからsome-macroを呼び出してみると、PACK-B::DEFが束縛されていないと怒られてエラーになります。with-interned-strの引数strはパッケージCのコンパイル時にinternされる一方で、some-macroの(print def)のdefはパッケージBのコンパイル時にinternされているためです。つまり、前者はPACK-C::DEF（束縛あり）、後者はPACK-B::DEF（束縛なし）と全く違うシンボルなのでエラーになったということでした。
なお、このテストコードは余りにも意味のない例ですが、実際にはCSVのヘッダ名を渡して同名のシンボルに値を束縛して…というマクロを書いていました。
割と大丈夫な例
パッケージ間で共通して使えるシンボルというとキーワード（:str もしくは (intern "str" "KEYWORD")）が思い当たるのですが、値を束縛できないので今回は使えません。とりあえず両者が同じパッケージでinternされていることを保証できればいいので、body内に同名のシンボルを見つけたらstrをinternしたもので全て置き換えるという力技で解決してみました。
sublis関数でsymをsymで置き換えるという一見怪しげなことをしていますが、test関数にパッケージを無視してシンボル名のみを比較するequal-nameを指定しているため、これで目的の動作が得られます。この手のtestキーワードを受け取る関数について深く考えたことがありませんでしたが、こう見ると応用範囲は結構広そうです。
大丈夫でない部分があるので「割と」とつけましたが、気付いた問題だけ書いていきます。明示的にパッケージを指定したシンボルまで置き換えてしまうので、わざわざパッケージ名をつけて書いたのに上書きされてしまうという、分かり辛いバグを仕込む可能性があります。そうそう困らなさそうですし、いい解決策がすぐに思いつかなかったので妥協していますが何かいい解決法はあるのでしょうか…。
また、デフォルトの関数名やマクロ名とかぶると（特に後者の一部は）回避手段がないのでは…と思ったのですが、名前空間が分かれている恩恵なのか下のようなコードも問題なく動きました（他にマクロ"loop"やスペシャルフォーム"let"も大丈夫でした）。まだ理解不足できちんと説明できないのですが、use, importしているものは問題なさそうです。
(with-interned-str "print" 100 (print print))
原因不明でハマったこと（原因不明で直ったこと）
再現性はないですが、もともとハマったコードの方では実行後にSBCLの環境に何やらゴミが残ったらしく、リスタートしても該当のシンボル（上記の例でいえばPACK-B::DEF）がunboundだとエラーで怒られ続ける現象が起きました。上記のような解決方法が間違っていると思い試行錯誤していたので中々気付かなかったのですが、ちょうど気付いた辺りでなぜか直ったので結局なんだかよく分かりませんでした。
明示的に直すのであればunintenすれば良いのかもしれません。
*1:名前を考えるのが面倒になったわけではありますん
Common Lispで遅延評価を作って遊ぶ（4, 完） － 数列生成リードマクロ
今回の目的
第3回（その1、その2）では、作成した数列生成リードマクロでひとしきり遊んでみたわけですが、今回はそのリードマクロの話を書きます。なお、リードマクロそのものについて（浅く）理解した内容については別記事「リードマクロ入門、の10分の1歩ぐらい後か前 - eshamster’s diary」にまとめたので、この記事では淡々と書いていきます。
そろそろ遅延評価関係ないですが…。
作成したリードマクロの目標
目標は次のような数学的な数式の定義に近づけることでした。例によって"amp;"は読み飛ばしてください。
完成形はこんな感じです。
; 関数版でのフィボナッチ数列作成 CL-USER> (make-series '(0 1) (lambda (a n) (+ (lnth (- n 1) a) (lnth (- n 2) a)))) ; 関数版にリードマクロを被せてみた版 CL-USER> #<a[n] = 0, 1, (+ a[n-1] a[n-2])>
はじめからこの形を目指していたわけではなく、次のようにいまいちな部分を順に直していったところこのようになりました。
; スタート (make-series '(0 1) (lambda (a n) (+ (lnth (- n 1) a) (lnth (- n 2) a)))) ; 実装（遅延評価, lnth）が見えてるのはいまいち ; ついでにaとnの順番も数式に合わせる (make-series '(0 1) (lambda (a n) (+ #{a (- n 1)} #{a (- n 2)}))) ; (- n 1)は空白が多くて書きづらい、見づらい (make-series '(0 1) (lambda (a n) (+ #{a #[n-1]} #{a #[n-2]}))) ; なんか#が多くて思ったほど映えない… (make-series '(0 1) (lambda (a n) (+ #{a[n-1]} #{a[n-2]}))) ; 左辺(a n)と右辺a[n-1]で形が違って気持ち悪い ; lambdaキーワードごと変換（※今は動かないコード） (make-series '(0 1) #<a[n] = (+ #{a[n-1]} #{a[n-2]})>) ; 初期値の定義も入れてしまえばいいよね ; そうなるとmake-seriesもいらないか #<a[n] = 0, 1, (+ #{a[n-1]} #{a[n-2]})> ; これはなかなｋ…いや、なんか思ったほどでも… ; あ、やっぱり#が多い #<a[n] = 0, 1, (+ {a[n-1]} {a[n-2]})> ; 今度は{}がジャマな気がする… ; これだ（完成） #<a[n] = 0, 1, (+ a[n-1] a[n-2])>
最後の足し算はS式がむきだしです。a[n-1] + a[n-2]の実現が単に面倒だったということもありますが、S式そのままの方が柔軟に使えるだろうという選択の結果でもあります。第3回で色々遊べたので間違った選択ではなかったように思います。
[]リードマクロ
まずは#[n-1]のような中置記法もどきを可能にしている部分ですが…下記の通り謝罪を要求されるレベルのひどい実装だったりします。こんなでも以前見たように意外と不自由なく遊べましたし、もっとまじめな中置記法の実装はすでに例がある（シンタックスが無ければ作ればいいじゃない[PDF]）のでここは頑張りどころではないか、と思ったので放置しています…。
(defun [-reader (stream &rest rest) (declare (ignore rest)) (let ((lst nil) (*readtable* (copy-readtable *readtable*))) (set-separate-character #\-) (set-separate-character #\*) (set-separate-character #\+) (set-separate-character #\/) (set-macro-character #\] (get-macro-character #\))) (setf lst (read-delimited-list #\] stream t)) (case (length lst) (1 (car lst)) (3 (case (cadr lst) (#\- `(- ,(car lst) ,(caddr lst))) (#\+ `(+ ,(car lst) ,(caddr lst))) (#\/ `(/ ,(car lst) ,(caddr lst))) (#\* `(* ,(car lst) ,(caddr lst))))) (t (error 'simple-error))))) (defun set-separate-character (char) (set-macro-character char #'(lambda (s c) (declare (ignore s c)) char)))
一応解説。#[n]のように要素が一つの場合は、read-delimited-listで(n)を受け取ってnを返します。
要素が三つの場合。まず、set-separate-character関数を使って、-, +, *, /は同名のcharを返すようになっています。例えば、#[n-1]の場合はread-delimited-listから(n #\- 1)というリストが返されます。真ん中の"#\-"をcase文で見て(- n 1)と並べ替えて返します。…以上です。
実装的な部分を見ると、set-separate-characterと対応した処理が分離しているのが気持ち悪いところで、マクロを使ってもっときれいに書けそうですね。
{}リードマクロ
(lnth 1 a)を#{a 1}や#{a[1]}と書いたり、(lnth 1 (lnth (- n 2) b))を#{b[1][n-2]}と書いたりするためのリードマクロです。
(defun {-reader (stream &rest rest) (declare (ignore rest)) (let ((*readtable* (copy-readtable *readtable*)) (pair nil)) (set-macro-character #\} (get-macro-character #\))) (set-macro-character #\[ #'[-reader) (setf pair (read-delimited-list #\} stream t)) (labels ((recursive-lnth (lst) (if (null (cdr lst)) (car lst) `(lnth ,(car lst) ,(recursive-lnth (cdr lst)))))) (recursive-lnth (reverse pair)))))
初めて書いたリードマクロ（[]リードマクロや再帰なしバージョンが）だけあってやっていることは単純です。例えば、#{a 1}の場合、read-delimited-listが(a 1)というリストを返すので、並び替えて頭にlnthをつけて(lnth 1 a)とするだけです。あとはこれに再帰処理を加えて#{a 1 2}を(lnth 1 (lnth 2 a))とできるようにしたり、char文字'['に前述の"[-reader"を設定して#{a[1]}や#{a[n-1]}と書けるようにしたらできあがりです。
こういった再帰や他のリードマクロとの組み合わせが簡単にできるのは素敵です。
<>リードマクロ
未処理のTODOが残っていたりしますが…中身の割に長いコードが以下になります。
(defun <-reader (stream &rest rest) (declare (ignore rest)) (let ((*readtable* (copy-readtable *readtable*)) (buf) (a) (n)) (set-separate-character #\>) (set-separate-character #\=) (set-separate-character #\[) (set-separate-character #\]) (setf buf (read-delimited-list #\= stream t)) ; TODO: check #\[ #\] (setf a (car buf)) (setf n (caddr buf)) (set-macro-character #\[ #'(lambda (s c) (list #\[ (funcall #'[-reader s c)))) (set-separate-character #\,) (setf buf (read-delimited-list #\> stream t)) (labels ((sort-ref-series (buf) ; Basically this function traces the list recursively ; and only reconstructs the same list. ; But if finds (a (#\[ b)), sorts this to (lnth b a). (let ((res nil)) (dolist (elem buf) (if (listp elem) (let ((child (sort-ref-series elem))) (when (eq (car child) #\[) (setf child `(lnth ,(cadr child) ,(car res))) (setf res (cdr res))) (setf res (cons child res))) (setf res (cons elem res)))) (reverse res)))) (let* ((splitted (split-by-last buf #\,)) (init-list (remove #\, (car splitted))) (body-list (cadr splitted))) `(make-series ,(if (null init-list) nil `(list ,@(sort-ref-series init-list))) #'(lambda (,a ,n) (declare (ignorable ,a ,n)) ,@(sort-ref-series body-list))))))) (defun split-list (lst index) (let ((target (if (null index) 0 (1+ index)))) (list (subseq lst 0 target) (nthcdr target lst)))) (defun split-by-last (lst delimiter) (split-list lst (position delimiter lst :from-end t)))
まずは定義よりmacroexpandということで、フィボナッチ数列の展開例を。sort-ref-series関数でゴチャゴチャと処理はしていますが、"`(make-series..."に始まる出力部分が素直に出ています。なお、コード中のa, nと紛らわしいので、b[k]=...の形で書いています。
CL-USER> (macroexpand '#<b[k] = 0, 1, (+ b[k-1] b[k-2])>) (MAKE-SERIES (LIST 0 1) #'(LAMBDA (B K) (DECLARE (IGNORABLE B K)) (+ (LNTH (- K 1) B) (LNTH (- K 2) B))))
コード全体を見ると、"="の左辺を読むパート、右辺を読むパートで大きく2つに分かれます。
左辺パートの目的は、lambda式の引数に利用する配列名（aに束縛）とインデックス名（nに束縛）を取得することです。"(setf n (caddr buf))"の行までがこのパートになります。ここでは単に"="までの4要素をread-delimited-listからリスト、例えば"(a #[ n #])"として受け取って、第1要素を配列名として、第3要素をインデックス名として受け取っています*1。
右辺パートの目的は、make-seriesの引数として必要な、初期化リストとlambda式内の処理本体を取得することです。"["の処理やsort-ref-series関数周りはいったん飛ばして見てみます。まずは、read-delimited-listから(0 #\, 1 #\, (+ a[n-1] a[n-2])のようなカンマ区切り？のリスト*2を受け取ります。最終要素が処理本体、その手前が初期値リストになるので、この2つを"(splitted (split-by-last buf #\,)"で分離します*3。初期値側は"(init-list (remove #\, (car splitted))"として不要なカンマを削除して先頭に"list"をつけて完成です。本体側はそのままです、"(body-list (cadr splitted))"。
最後に、ここまで飛ばしてきたsort-ref-series関数ですが、目的は、例えば"a[n]"を"(lnth n a)"の形に変換することになります。当初は（read-delimited-list関数ではなく）read関数を直接使うことで、"["を見つけたら前を見て…ということを考えていたのですが、ストリームなので前方参照ができない*4ことに気づいて詰まりました。
そこで、いったんマーク付きで全部リストに出力してから、マークを読み取って一部を書き換えるという力業に出てみました。このマークをつけているのが"#\["のリーダマクロで、マークを読み取っているのがsort-ref-series関数です。前者は"[-reader"関数のリード結果に"#\["というゴミ…もといマークをつけています。後者は（ソースの怪しげな英文コメントにある通り）、基本的には受け取ったリストをそのまま返すだけですが、マーク、例えば"(a (#\[ n))"を発見するとその部分を"(lnth n a)"というリストに置き換えて返します*5。
実際、変換前のリストである(car body-list)をprintすると次のような結果が得られます。
(+ A (#\[ (- N 1)) A (#\[ (- N 2)))
ちなみに、このリードマクロを作ったときは何もいっぺんに作ったわけではなく、まずは左辺の処理を作って"(LAMBDA (A N))"だけ出力してみて、次に初期値（カンマ区切り）なしで内部の処理を読んでみて"(LAMBDA (A N)(+ (LNTH (- N 1) A) (LNTH (- N 2) A))))"を出力して、、、と順々に積み重ねて上の形になりました。
感想
深く考えたことがなかったですが、あんなものでも四則演算のリードマクロを書くと「だから多くの言語では変数名にハイフン許可していないのか」と気づいたりします（"#[a-b]"とした時に「a引くb」なのか「"a-b"という変数名」なのか一意に決まらない）。Cを勉強するとポインタレベルの動きに敏感になるように、Lispを触っているとコンパイラレベルの動きに敏感になるようです*6。
便利な文法を作ろうとすると実装の都合による制約というのが容易に入り込むという感想も持ちました（今回のようなサボり実装で悟ったようなことを言うと怒られそうですが）。問題は影響範囲が大きいことで、例えば#[]リードマクロの中ではどうあがいてもハイフンつきの変数名は許可されません。そういった実装の都合を最小化する意味で、S式で一貫しているLispの選択はありだと感じます。
余談ですが、こうした実装都合による制約で度肝を抜かれたのがRuby（バージョン2.0.0で確認）で、2変数以上の関数で引数にカッコをつけて呼び出す場合、関数とカッコの間にスペースがあると文法エラーをはくというものです。あえて「2変数以上」と書いたのはそのままの意味で、1変数のときはスペースの有無によらずエラーになりません。また、2変数以上でも関数定義部分ではスペースがあってもOKでした。まったく意味が分かりませんが、様々な便利文法を提供する過程でやむにやまれず諦めた部分だろうと想像すると多少納得がいきます。
また、通常の関数などと比べて完全性を確保するのが難しいと感じました。これは再帰性に起因するところだと思いますが、内部でどのようなS式でも受け入れてしまうので、何が動いて何が動かないかを予測することができなかったです（第三回の2次元数列なんてよく動いたなと他人事のような印象でした）。逆に、何もしなければS式として解釈されるので、全部作る必要がない点は実装の労力や柔軟性という面でよかったです。
シリーズ完
思いついたことは何でも書くという方針のため無駄に長かった「Common Lispで遅延評価を作って遊ぶ」シリーズですがこれで完です。終わると記事のネタがなくなるかもしれないので吸えるだけ吸い尽くしておこうという不純な動機もあったりしましたが、現状まだ2，3個はネタがありそうです。こう詰まらないものでも定期的にアウトプットしていける状態を維持したいものです。
シリーズリンク
- 第一回：Common Lispで遅延評価を作って遊ぶ（1） - eshamster’s diary
- 第二回：Common Lispで遅延評価を作って遊ぶ（2） － 数列生成マクロ - eshamster’s diary
- 第三回
- 付録：リードマクロ入門、の10分の1歩ぐらい後か前 - eshamster’s diary
- 第四回：Common Lispで遅延評価を作って遊ぶ － 数列生成リードマクロ - eshamster’s diary
*1:TODOにある通り最低限のエラー処理もサボってますが…
*2:実際には、最終要素はリーダマクロで処理済みのものになりますが
*3:最初に(remove #\, ...)してから分ければいいだけのような…と記事を書いてて思いました。なんかアホなことをした気がしてきました
*4:恐ろしいことに、リーダ自体の動作を上書きして前方参照を可能にしている方もいますが…：SBCLのリーダを上書きして"超リードマクロ"を実装 - 八発白中
*5:sort-ref-series関数はコメントの必要性を感じるレベルで汚い実装になっているので、もう少しきれいに書ければいいのですが…。リストを再帰的に探索して条件に合ったリストを置き換える汎用関数を書いたら少しはきれいになるでしょうか。
*6:参考：「あなたがLispを無視することができない理由 - 八発白中」での「Lispの進化（The Evolution of Lisp）」の引用
AngularJSでアコーディオンパネルを作成
目的
いわゆるアコーディオンパネルが欲しかったのですが、MEANスタックなんて言葉を聞いてちょっと興味があったので、AngularJSで作ってみました。これだっというサンプルが意外に見つからなかったので一応メモに残しておこうと思った次第です。要件はおおむね次の通りです。
- 複数の要素が存在
- 各要素の表題？部分をクリックすると開閉する
- ある要素を開いた時は、他の要素はすべて閉じる（常に一つの要素しか開かない）
やっていないこと
- 開閉アニメーション（CSSを少し書き換えるだけ、のはず）
- 自動スクロール（要調査）
サンプルコード
ポイントは以下の3つです。
- 双方向データバインディングによるパネルの自動生成
- ng-classを使った、条件指定によるclassの付け外し
- $indexによる選択位置の特定
一つ目。バージョン1.2から使える機能のようですが、ng-repeat-start, ng-repeat-end*1の組み合わせで複数要素（ここではddとdt）のバインディングができます。後はjs側で$scope.items配列にデータを放り込んでいけば順次dd, dtが追加されていきます。
二つ目。変化も含め見た目関連は極力CSSに…ということで、展開・折りたたみはクラスの付け外しによって行います。jQueryであればremoveClass, addClassとするところですが、ng-classを使って$scope.isSelected()関数の結果がfalseのときだけnot-selectedクラスをつけるようにします。ちなみに、あちこちで見かけたサンプルではクラス名をそのまま書いてあったのですが、手元ではシングルクォーテーションで囲わないとなぜか動きませんでした。かなりハマったのですがどういうことなんでしょう…。
三つ目。二つ目に書いた$scope.isSelected()関数でもしれっと使ってますが、html側では$indexで自身がitemsの何番目の要素から作られたかを取得することができます。これを利用して、$scope.toggleSelected()関数では$scope.selectedIdに選択されたインデックスを格納します（前回と同じ場合は-1を入れて未選択を表しています）。$scope.isSelected()ではこの格納されたインデックスと自身のインデックスが同じかを判定しています。
参考にしたサイト
- 1要素のアコーディオンパネル：開閉アニメーションが必要な場合はここを参考にすると（たぶん）追加できます
- ng-class関連
- $indexプロパティ他
感想
AngularJSはデータバインディングなど中々いいものでした。ただ、ブラックボックス感がものすごく強いので、どこにフレームワークの壁（それ以上進むには深い理解が必要な箇所）が転がっているのかという恐怖心が常につきまといますね。jQueryを触っていた時は、もう少し苦労する代わりにそういった恐怖心は余り感じませんでしたが。
余談
上記は素のhtmlで書いていますが、元は(CL-Markup)https://github.com/arielnetworks/cl-markupを使った以下のCommon Lispコードから生成しました。なお、生成後のhtmlはサンプル用に少し書き直したので1対1対応にはなっていません。
(defun test-angular-html () (with-markup-to-string (html5 :ng-app "testApp" (:head (:title "Test AngularJS") (:script :src "https://ajax.googleapis.com/ajax/libs/angularjs/1.2.27/angular.min.js" nil) (:script :src "js/test-angular.js" nil) (:link :rel "stylesheet" :type "text/css" :href "css/main.css")) (:body (:div (:a :href "/" "Top")) (:div :ng-controller "testController" "{{test}}" (:br) "selected-id = {{selectedId}}" (:br) (:button :ng-click "getTestData()" "Get test data") (:br) (:dl (:dt :ng-click "toggleSelected($index)" :ng-repeat-start "item in items" "{{item.name}}") (:dd :ng-class "{'not-selected': !isSelected($index)}" :ng-repeat-end nil "{{item.mail}}")))))))
eshamster/caveman-sample · GitHub
*1:念のため、ng-repeat自体はそれ以前からある機能
