2008年12月31日水曜日

【実践CL】5 関数


  • 前説

    • 「Lispの関数も、他の言語における関数と同じように、機能(functionality)を抽象化する基本的な仕組みを提供してくれるものだ。」加えて、データの抽象化という観点も重要に思える。

  • 5.1 新しい関数の定義

    • 要旨:defunの要素の一通りの説明。

  • 5.2 関数のパラメータリスト

    • 要旨:CLのパラメータリストは多機能。それによってプログラミングは随分楽になっている。
    • 要旨:常に入力が必要な変数は必須パラメータで書く。

  • 5.3 オプショナルパラメータ

    • 要旨:入力が必要じゃないときもある変数はオプショナルパラメータで書く。

  • 5.4 レストパラメータ

    • 要旨:可変個の入力を受け入れたいときはレストパラメータで書く。

  • 5.5 キーワードパラメータ

    • 要旨:パラメータが複数あって、入力時にそれらそれぞれを与えるかどうかが混沌としてる場合はキーワードパラメータで書く。

  • 5.6 異なる種類のパラメータの併用

    • 要旨:4種類使うなら、必須、オプショナル、レスト、キーワードの順。
    • 要旨:オプショナルとキーワードは同時に使うな。

  • 5.7 関数の戻り値

    • 要旨:defunが関数名でblockを用意してくれているので、return-from 関数名で関数の処理から脱出できる。

  • 5.8 データとしての関数または高階関数

    • 「関数をデータで扱える」というのはいくつかの意味を持っていると思う。まずファーストクラスとして扱えること、次に関数の記述自体がリストであること。

  • 5.9 無名関数

    • lambdaフォームは関数名の場所につかえるリストにすぎない。そして名前の変わりにその振舞を直接示している。
    • lambdaがマクロでもある、とHyperSpecにもあるが、これはちょっと理解しがたい。(lambda -> (function (lambda だとしたら、マクロ展開したときに無限ループになっちゃうのでは? CLtL1の解釈「funcallとかevalは、lambdaが冒頭のリストフォームを特別視する」でいいんじゃないかなぁ。
    • syntax sugar って構文糖でいいのかな? 構文糖衣が多数じゃないか?


前半は速めに進んで、後半の実践の章でまったりしたい。こつこつ。

【ELp入門】2 評価の練習


  • この本、翻訳はそんなによくない。ま、気にしない、まったりまったり。

  • 前説

    • Emacsでキーをタイプすると、関数が実行される。これがEmacsの動作機構。
    • キーに紐付けられている関数は、対話的関数とかコマンドと呼ぶ。
    • 式を評価する方法は、紹介済みのC-xC-eを基本に、他のものにも触れる。

  • 2.1 バッファ名
  • 2.2 バッファの取得

    • M-:って便利だなぁ。
    • buffer-name, buffer-file-name, current-buffer, switch-to-buffer, set-buffer, other-buffer, buffer-size, point, point-max, point-minなどなど。
    • まあ、これらはCLには無いわな。CLIMAXならあるかもだけど。


この章、短い。こつこつ。

【IMAP】ACLでIMAP

ACLのIMAPインターフェイスでIMAPを操作してみる。

CL-USER(2): (require :imap)
; Fast loading /Applications/AllegroCL64/code/IMAP.fasl
T
CL-USER(3): (require :smtp)
; Fast loading /Applications/AllegroCL64/code/SMTP.fasl
; Fast loading from bundle code/streamp.fasl.
; Fast loading /Applications/AllegroCL64/code/SASL.fasl
; Fast loading /Applications/AllegroCL64/code/OSI.fasl
; Fast loading from bundle code/fileutil.fasl.
;; Autoloading locale from #P"/Applications/AllegroCL64/locales/en_US"
; Autoloading for package "REGEXP":
; Fast loading from bundle code/regexp2-s.fasl.
;;; Installing regexp2-s patch, version 1.
; Autoloading for REGEXP::MAKE-VM-CLOSURE:
; Fast loading /Applications/AllegroCL64/code/regexp2.fasl
; Fast loading /Applications/AllegroCL64/code/YACC.fasl
; Fast loading from bundle code/rc4.fasl.
; Fast loading from bundle code/hmac.fasl.
; Fast loading from bundle code/sha1.fasl.
; Fast loading from bundle code/iodefs.fasl.
; Fast loading from bundle code/iordefs.fasl.
; Fast loading from bundle code/efmacs.fasl.
; Fast loading /Applications/AllegroCL64/code/MIME.fasl
;;; Installing mime patch, version 1.
T
CL-USER(4): (require :mime)
NIL
CL-USER(5): (require :rfc2822)
; Fast loading /Applications/AllegroCL64/code/RFC2822.fasl
;;; Installing rfc2822 patch, version 1.
; Fast loading from bundle code/acldns.fasl.
T
CL-USER(6): (use-package :net.post-office)
T
CL-USER(7): (setq mb (make-imap-connection "mail.mac.com"
:user "xxxxxxxxxxxxxx"
:password "yyyyyyyyyyyyyyyy"))
#
CL-USER(8): (select-mailbox mb "inbox")
T
CL-USER(9): (mailbox-message-count mb)
3
CL-USER(10): (setq body (fetch-parts mb 3 "body[]"))
((3
("FLAGS" (:\\SEEN :$NOTJUNK) "BODY[]" "Return-path:
Received: from smtpin135-bge351000 ([10.150.68.135])
by ms183.mac.com (Sun Java(tm) System Messaging Server 6.3-7.04 (built Sep 26
2008; 64bit)) with ESMTP id <0KCQ00CDK3UWUR10@ms183.mac.com> for
xxxxxxxxxxxxxx@me.com; Tue, 30 Dec 2008 20:16:08 -0800 (PST)
Original-recipient: rfc822;xxxxxxxxxxxxxx@me.com
Received: from rv-out-0506.google.com ([209.85.198.225])
by smtpin135.mac.com (Sun Java(tm) System Messaging Server 6.3-7.03 (built Aug
4 2008; 32bit)) with ESMTP id <0KCQ00KWA3U3H4E0@smtpin135.mac.com> for
xxxxxxxxxxxxxx@me.com (ORCPT xxxxxxxxxxxxxx@me.com); Tue,
30 Dec 2008 20:16:08 -0800 (PST)
X-Brightmail-Tracker: AAAAAgAAAUAAAAFU
Received: by rv-out-0506.google.com with SMTP id k40so5315646rvb.17 for
; Tue, 30 Dec 2008 20:16:08 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com;
s=gamma; h=domainkey-signature:received:received:message-id:date:from:to
:subject:mime-version:content-type;
bh=8dDsdMj/vZZL9PRpkSNUfojFFW/h1Az3Jku6kEgINls=;
b=Kpw6QRPqms9P52jKWlx3hohMEr/pfb49GuZ/TcQaWILOKy7bxWqbwkJMvPvCf+/Fjp
NIa4osARbT3Sw+b1VE3VK2Pl2Vk9bXCdz1UKewUFJigncGZgOnTWaD5BYyL1D53BZsub
jdAjlSdfea4xpkzCWGYHs2i7hN8bnUW/Locto=
DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma;
h=message-id:date:from:to:subject:mime-version:content-type;
b=LD5L76x33I1n41sNffoiQpeUCDB81Vp43e1NOmXTkLBOnJ+nmUO+FENEWbfJIE9xW5
HBuImoVxID1gtO68rTyr3Xez3n7AgRHR42CWIeCSUq1Iyz7bOzEvPWEq/YsIYy+8XJvT
J7rE/TgLjgQsC6tHayK7X/3PZ87ZLav8ECY/E=
Received: by 10.141.45.16 with SMTP id x16mr7619679rvj.7.1230696967987; Tue,
30 Dec 2008 20:16:07 -0800 (PST)
Received: by 10.141.115.4 with HTTP; Tue, 30 Dec 2008 20:16:07 -0800 (PST)
Message-id:
Date: Wed, 31 Dec 2008 13:16:07 +0900
From: aka
To: xxxxxxxxxxxxxx@me.com
Subject: =?ISO-2022-JP?B?GyRCRnxLXDhsJE43b0w+GyhC?=
MIME-version: 1.0
Content-type: multipart/alternative;
boundary=\"----=_Part_162342_20660604.1230696967980\"

------=_Part_162342_20660604.1230696967980
Content-Type: text/plain; charset=ISO-2022-JP
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

$BF|K\\8l$NK\\J8$G$9!#(B
$B$I$&8+$($k$N$+$J(B?

------=_Part_162342_20660604.1230696967980
Content-Type: text/html; charset=ISO-2022-JP
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

$BF|K\\8l$NK\\J8$G$9!#(B
$B$I$&8+$($k$N$+$J(B?


------=_Part_162342_20660604.1230696967980--
")))
CL-USER(11): (search-mailbox mb '(:text "test"))
(1 2 3)
CL-USER(12): (search-mailbox mb '(:text "日本語"))
NIL
CL-USER(13): (close-connection mb)
T
CL-USER(14):

おお、普通に動く。
しかし、なんとACLのMIMEインターフェイスは、object -> multipart変換機能はあるが、multipart -> object変換機能がまだ未実装のようだ。なんじゃいな。CL-MIMEのお世話になるのかな。

【IMAP】手動でIMAP

だいたいわかった。telnetでやってみる。

~$ telnet mail.mac.com 143
Trying 17.148.16.40...
Connected to mail.mac.com.
Escape character is '^]'.
* OK [CAPABILITY mmpn0694 IMAP4 IMAP4rev1 ACL QUOTA LITERAL+ NAMESPACE UIDPLUS CHILDREN BINARY UNSELECT SORT LANGUAGE IDLE XSENDER X-NETSCAPE XSERVERINFO X-SUN-SORT X-SUN-IMAP X-ANNOTATEMORE X-UNAUTHENTICATE XUM1 AUTH=PLAIN STARTTLS] Messaging Multiplexor (Sun Java(tm) System Messaging Server 6.3-6.03 (built Jun 5 2008))
1 LOGIN xxxxxxxxx yyyyyyyyyyyyy
1 OK User logged in
2 NAMESPACE
* NAMESPACE (("" "/")) NIL NIL
2 OK Completed
3 LIST "" *
* LIST (\NoInferiors) "/" INBOX
* LIST (\HasNoChildren) "/" "Apple Mail To Do"
* LIST (\HasNoChildren) "/" test
3 OK Completed
4 status INBOX (MESSAGES UNSEEN UIDNEXT)
* STATUS INBOX (MESSAGES 2 UIDNEXT 3 UNSEEN 1)
4 OK Completed
5 search BODY "test"
5 BAD Please select a mailbox first
6 select INBOX
* FLAGS (\Answered \Flagged \Draft \Deleted \Seen $NotJunk $Junk)
* OK [PERMANENTFLAGS (\Answered \Flagged \Draft \Deleted \Seen $NotJunk $Junk \*)]
* 2 EXISTS
* 0 RECENT
* OK [UNSEEN 2]
* OK [UIDVALIDITY 1230279002]
* OK [UIDNEXT 3]
6 OK [READ-WRITE] Completed
7 search BODY "test"
* SEARCH 1 2
7 OK Completed
8 fetch 2 full
* 2 FETCH (FLAGS ($NotJunk) INTERNALDATE "30-Dec-2008 04:47:03 -0800" RFC822.SIZE 1029 ENVELOPE ("Tue, 30 Dec 2008 21:46:57 +0900" "test dayo" (("aka" NIL "aka.cs.mail" "gmail.com")) (("aka" NIL "aka.cs.mail" "gmail.com")) (("aka" NIL "aka.cs.mail" "gmail.com")) ((NIL NIL "xxxxxxxxxxx" "me.com")) NIL NIL NIL "") BODY ("TEXT" "PLAIN" ("CHARSET" "US-ASCII" "FORMAT" "flowed") NIL NIL "7BIT" 17 2))
8 OK Completed
9 logout
* BYE LOGOUT received
9 OK Completed
Connection closed by foreign host.
~$

う、おもろい。S式だし。

2008年12月30日火曜日

【ELp入門】1 リスト処理


  • 1.1 Lispのリスト

    • うーん。強引な導入。
    • C-M-\ にてリージョンをインデント。

  • 1.2 プログラムの実行

    • GNU Emacsの内部にはlispインタープリタがあるんだ。なるほど。

  • 1.3 エラーメッセージの生成

    • 執筆時にはなかったようだが、今はデバッガが立ち上がる。qで抜けられる。

  • 1.4 シンボル名と関数定義

    • わかりやすい説明だ。

  • 1.5 Lispインタープリタ

    • シンボルについて、変数の前に関数をやるのはいい感じ。
    • バイトコンパイルすると実行が速くなる。

  • 1.6 評価

    • 副作用の説明。Elispは副作用がおおそうだ。。。

  • 1.7 変数

    • 変数に関数定義を束縛することもできる。

  • 1.8 引数

    • えっと、Emacs 22では、

      (concat "The " (+ 2 fill-column) " red foxes.")

      これはエラー。昔は大丈夫だったようだ。今はnumber-to-stringを使うのだろう。ちなみにCLだと、

      (concatenate 'string "abc" "def")

    • Elispにおいてもdefunの背後にlambdaがいるとすると(いないかもしれないが)、引数にlispオブジェクトを与えると、そのlispオブジェクトを評価した結果が、環境に登録されるということだろう。(elispが環境をもっているかどうはまだわからない)
    • messageってもしかして値を返さないのか??? と思ったら、文字列を返すのね。*scratch*便利。
    • messageってformatみたいなんだな。

  • 1.9 変数への値の設定

    • うーん。。。変数は難しい。ここの記述は確かに間違いではないのだが、変数をちゃんとわかっていないと、ちゃんと理解できない。
    • 変数は、シンボルによる実現と、環境による実現がある。変数への値の束縛については、CLではsetはシンボル専用、setqは両用、lambdaは環境の生成とともに環境用というのが基本だと思う。(ただし、elispに環境があるのかどうかはしらないので、環境が無いならばまた違うかもしれない)
    • CLでは「setqは、setの第一引数のquoteを省略できる版」ではない。elispではそうなのか? ためす。

      ;; CL
      CL-USER(19): (setq hoge 1)
      1
      CL-USER(20): (let ((hoge 10))
      (set 'hoge 2)
      (symbol-value 'hoge))
      2
      CL-USER(21): hoge
      2
      CL-USER(23): (setq hoge 1)
      1
      CL-USER(24): (let ((hoge 10))
      (setq hoge 2)
      (symbol-value 'hoge))
      1
      CL-USER(25):hoge
      1


      ;; EL (*scratch*)
      (setq hoge 1)
      1
      (let ((hoge 10))
      (set 'hoge 2)
      (symbol-value 'hoge))
      2
      hoge
      1
      (let ((hoge 10))
      (setq hoge 2)
      (symbol-value 'hoge))
      2
      hoge
      1

    • ええっと。あまりいい例じゃないけど、ELの方は、setにしろsetqにしろ、letのhogeをみてるんだなきっと。とするとsetqはsetの便利版でいいんだろね。


一章はけっこう長かった。
こつこつ。

【ELp入門】訳者まえがき・はじめに


  • 訳者まえがき

    • そうか、このころ(1995)はmuleはまだ統合されてなかったんだな。
    • 日本語文字列に関する振舞いは進化している。

      (length "abcあいう") ; => 6
      ;(chars-in-string "abcあいう") ; => error。関数がない。
      (string-width "abcあいう") ; => 9


  • はじめに

    • 要旨

      • Emacsは拡張可能なエディタである。
      • より正確には拡張可能な計算環境である。
      • Emacs Lispはそれ自体ひとつのプログラミング言語である。
      • 本書では、GNU Emacsを構成している実際のコードを眺める。
      • 本書は、プログラマでない人向けの初歩の入門書である。
      • GNU Emacs Lispリファレンスマニュアルとは姉妹編である。
      • Emacs LispはMacLispをベースにしている。



こつこつ。

【ELp入門】EmacsLispプログラミング入門を読む

Emacs方面の次の一冊は、EmacsLispプログラミング入門にした。ちょっと古い本だけどいいや。昔一度読んだような気がするがさだかではない。まったり行きたい。

【実践CL】4 シンタックスとセマンティックス


  • 4.1 何でこんなに括弧があるの?

    • M式の話。

  • 4.2 ブラックボックスをばらして中を見てみると

    • 「読取器は、どのようにして文字列がS式(s-expression)と呼ばれるLispのオブジェクトへと変換されるかを決める」これ、何か違和感があるな。まず、readerの重要要素はリーダーアルゴリズムとリードテーブルだろう。それらに従って文字列をLispオブジェクトに変換する。そうか、ここで言っているS式というのが何かというのがよくわからないのだ。そういえばS-expressionの正確な定義って何だ??
    • ちょっとしらべてみた。歴史的に言うと、マッカーシーがSymbolic expressionという用語を使っているようだ。ただし、ANSI CLにはS式という用語はないみたい。確かR5RSにもなかったはず。そして、S-expression自体は、Lispに閉じたものではなく汎用の表現形式として定義されているようだ。Rivest
    • なので、実践CLにおける、ここでのS式に対する言及は無視しておく。S式と言わずとも、Lispオブジェクト群という理解でいいのではないか。
    • readerが読む対象とする文字列は、リードテーブル次第で如何ようにもなりえる。なので、readerが読むものをS式ともいえない。また、CLのデフォルトであっても、例えば、'(a b)はS式ではないからそれをS式と呼ぶこともない。
    • ひとつ可能性があるのは、readerが読んだものをevalしないで印字形式に変換するとそれはS式なような気がする。すると、CLの実装として、readerがLispオブジェクトを生成するのではなく、その代わりにS式文字列を生成するようなものがあれば、そこではreaderがS式を生成すると言える。

  • 4.3 S式

    • 「数値は、そのまま数値だ」というのもわかりにくい。数値形式の文字列をreadすると、対応した数値のLispオブジェクトが生成される、ということだろう。

  • 4.4 LispフォームとしてのS式

    • ええっと、自己評価型オブジェクトの概念とR/W等価性とがごっちゃになっている。間違いなわけじゃないと思うが、今見返すと粗い説明だなぁ。

  • 4.5 関数呼び出し

    • 特になし。

  • 4.6 特殊オペレータ

    • quoteの説明のところもやはり不自然。「式を1つ取り、それをそのまま評価せずに返す」ではわかりにくいのでは? 「Lispオブジェクトを1つ取り、それをそのまま評価せずに返す」だろう。評価器への入力も出力もどちらも種別としてはLispオブジェクトのはずだ。そして、だからこそinとoutの間で「何もせずそのまま返す」ということが成り立つ。

  • 4.7 マクロ

    • (dolist (x foo) (print x))がマクロなのか関数なのかという不安について、xに着目せよ、と。callerがxを経由して値を与えるのではなく、xはこのフォームが指示する処理のなかで変数になっている、これは関数にはできなくて、マクロによってそういう処理に展開されるだろうという強い示唆だと。なるほど!

  • 4.8 真、偽、そして等しさ

    • 「いつでもEQLを使え」

  • 4.9 Lispコードの書式付け

    • C-cM-qがeliにはない。欲しいなぁ。


こつこつ。

【PAIP】23 Compiling Lisp (その2)


  • 23.1 A Properly Tail-Recursive Lisp Compiler
  • 関数の呼び出しシーケンスを変更する。
  • SAVEで継続ポイントをスタックに格納する。CALLJにて、関数を実行し、継続ポイントに飛ぶ(SAVEしたところ)。
  • うーん、CLでコンパイラを書く技法については勉強になるし、面白いんだけど、これをやることによってLispの理解が進むとはあまり思えない。力量が足りないからかなぁ。

こつこつ。

【L遊び】8 セル遊び

気を取り直して、最終章。

  • CLのrplaca,rplacdはsetcar,setcdrのようだ。
  • そっか、nconcとかのnはnuke(核(兵器))のことなんだ。
  • う、するとdelqのqは何?
  • CLと大きな違いは感じない。

お、リスト遊びが終わった。またしばらくしたら再帰したい。
さて、Emacs方面、次は何をやろうかなぁ。

2008年12月29日月曜日

【L遊び】7 繰り返し


  • 代入と関連付けてletを導入するのは違和感があるなぁ。
  • むぅ。sumの例を繰り返しで書くなら、whileじゃなくてdo系を使うべき。elispにdoが無いのかなぁ。
  • だめだ、このwhileとsetqの群れが気持悪くて耐えられない。「7.4 catchとthrow」まで飛ぶ。
  • この章、精神衛生上よろしくない。

えっと、再帰には再帰が適した話題があり、whileもしかり、doもしかり、loopもしかりだと思う。
効率の問題で再帰を繰り返しで書き直すというのはもちろんあるのだが、それは末尾再帰だとか他のことをも含めてやるべきだろう。

【IMAP】今夜わかる メールプロトコル

IMAPの概要を知るために、

今夜わかるメールプロトコル

を読んでるんだけど、この本とてもいい。
とても簡明にかかれていて著者の誠実さを感じる。

私は基礎をおろそかにしていたので、インターネットメールシステムのプレーヤは漠然と、

  • MTA
  • MDA
  • MUA

だと思ってた。しかしこの本を読んで、

  • MSA
  • MTA
  • MDA
  • メールボックス
  • MRA
  • MUA

であることを知った。これだけでもう値段分の価値があった。ここの認識の余さが確実な理解を妨げていたのだ。
もう少し理解が進んだらACLのIMAPインターフェイスでいろいろ試してみたい。IMAPではいろいろなデータがS式で表されているので、それも楽しみ。

こつこつ。

【L遊び】6 より柔らかに


  • 補助関数導入のメリットの一つに、補助関数にてデータ構造を隠蔽することによって、主関数への変更無しにデータ構造の変更に対応できる、というような記述がある。これ、そんなに適用できるケースが多いかなぁ。主関数は制御のみで、データの取扱い(アルゴリズム含む)が補助関数にいっちゃってるなら、そうなんだけど。ああ、ただあるデータをリストで実装するかベクタで実装するかというような、探求的にやっていく場合はこの隠蔽は有効だな。OOの隠蔽と一緒かな。
  • この章を読み終わって、何か違和感があるなぁ、と思ったら、関数の抽象化の話題なのにlambdaがでてこないからだ。なっとく。

こつこつ。

2008年12月28日日曜日

【L遊び】5 より深く


  • 入れ子になったリストの再帰をする関数たち。
  • この定石というの、今おもうとHtDPのレシピのはしりだったんだなぁ。
  • あと、The Little Schemerの雰囲気を感じるなぁ。
  • 再帰パズルは楽しい。

なかぱっぱ? CLとの有意な差は感じない。

しかし、一章以上は複数投稿にばらす、というのをルールにしているのだけれど、章の規模が小さい本だとどうも散弾銃的になってしまうのがいやな感じ。無意味に投稿数が増えていく。RSSを購読されている方がいるとしたら、迷惑なんじゃないだろうか。ちょっと考えていきたい。
こつこつ。

【L遊び】4 再帰


  • 自然数やリストの再帰の基本例題

CLとの違いは感じない。
はじめちょろちょろ。

【PAIP】23 Compiling Lisp

この章はきざんでいく。Par.5でワンボギーかな。


  • 前説
  • コンパイラが吐く言語は、仮想的なスタックマシーンへの命令とする。
  • うーん。レジスタなマシーンはパタヘネでやったからわかるんだけど、スタックマシーンは初体験。
  • 慎重に振舞いを確認してみる。

    (lambda () (if (= x y) (f (g x)) (h x y (h 1 2))))

    ARGS 0 ; move 0 arguments from stack to env (これなんのために?)
    GVAR X ; push a gloval variable's name [X]
    GVAR Y ; push a gloval variable's name [Y X]
    GVAR = ; push a gloval variable's name (function) [= Y X]
    ; =は判定結果をスタックにおいて返るのであろう。
    CALL 2 ; go to start of function(n args), saving return point [(result of (= x y))]
    FJUMP L1 ; go to label if top-of-stack is nil; pop stack [nil/non-nil] -> []
    GVAR X ; push a gloval variable's name [X]
    GVAR G ; push a gloval variable's name (function) [G X]
    CALL 1 ; go to start of function(n args), saving return point [(result of (g x))]
    GVAR F ; push a gloval variable's name (function) [F (result of (g x))]
    CALL 1 ; go to start of function(n args), saving return point [(result of (f (g x)))]
    JUMP L2 ; go to label (don't pop stack)
    L1: GVAR X ; [X]
    GVAR Y ; [Y X]
    CONST 1 ; [1 Y X]
    CONST 2 ; [2 1 Y X]
    GVAR H ; [H 2 1 Y X]
    CALL 2 ; [(result of (H 1 2)) Y X]
    GVAR H ; [H (result of (H 1 2)) Y X]
    CALL 3 ; [(result of (H X Y (H 1 2)))]
    L2: RETURN

  • なるほど。わかった。
  • コンパイラは、interpと同様の条件分岐構造にて、コードを生成していく処理を実行していく形式。

次回は、23.1 A properly Tail-Recursive Lisp Compiler。
こつこつ。

【L遊び】3 関数遊び


  • defun、cond、eq、変数、=、/=、<、<=、>、>=、and、orなど。
  • だいたいCLといっしょ。しかし変数って難しい概念なんだよなぁ、、、

こつこつ。

【L遊び】2 アトムとセル


  • おお! elispではシンボルで大文字と小文字を区別するんだ。
  • シンボルは、変数と関数とで別空間。ここはCLといっしょ。
  • をを! なんというか、tとnilなのであって、TとNILは単なるシンボルなんだ。
  • nilは空リストであり()であり'()であり。CLといっしょ。

  • あとは、セル、cons、car、cdr、リスト、アトム、リストのリスト、ドット対、評価、quoteなど。
  • 特殊形式(specia form)を、特殊関数とか関数などと呼ぶのはあまりよくないなぁ。。。

こつこつ。

【L遊び】1 落書き帳

PAIPでSchemeのコンパイラに入るにはちょっと頭が疲れている。だけどもうちょっと勉強したい、という気分。そこで三位一体のひとつElispの勉強をこの機会に始めようと思う。本は山本和彦さんの「リスト遊び」。昔一度勉強したことがあるので、二度目になるかなぁ。(山本さん自身は最近はHaskellに取り組まれている)

  • 第一章 落書き帳
  • バッファ、ミニバッファ、バッファローカル変数、グローバル変数、スクラッチバッファ、Lisp Interaction mode、各種評価方法など。

山本さんの語り口は、なんとゆうか慈愛にあふれているなぁ。

2008年12月27日土曜日

【実践CL】3 実践:簡単なデータベース

PCLの今回の学習では写経はしない。gigamonkeysからソースをダウンロードして、必要に応じてそれをいじっていくことにする。そこで、環境整備。ASDFのサイトを念のため確認。以下メモ。

  • 念のため、(require 'asdf)。
  • ASDF:*central-registry*に#P"/Users/aka/local/lib/cl/systems/"などを登録。
  • systems以下にpracticals.asdのsymlinkを置く。practicals.asdがdependしている各章のasdもsystemsにsymlinkを置く。
  • (asdf:oos 'asdf:load-op :practicals)を実行。すると
    Error: component :CL-PPCRE not found, required by #
    [condition type: MISSING-DEPENDENCY]
    と文句を言われる。これ去年も言われたなぁ。
  • CL-PPCREを本家からDL。pclのソースと似たような感じでasdfを配置。
  • (asdf:oos 'asdf:load-op :practicals)。
    mp3-browserでduplicate? なerrorがでる。とりあえずskipして通した後、再度(asdf:oos 'asdf:load-op :practicals)すると文句はでない。まあいいや。
  • 今回は3章なので、(asdf:oos 'asdf:load-op :simple-database)でよし。
  • 3章のpackage.lispを見るとsymbolsをexternalにしていないので、(in-package :com.gigamonkeys.simple-db)でやる。

さて、実践CL。

  • 前説

    • 要旨:小さな実例を示す。記述にはごまかしもあるが、気にするな。

  • 3.1 CDとレコード
  • 3.2 CDのファイリング
  • 3.3 データベースの中身を見てみる
  • 3.4 ユーザインタラクションを改善する
  • 3.5 データベースの保存と読み出し

    • 感想:ここまでについて。最初のチュートリアルが入出力ごりごりなのが、比類ないところ。

  • 3.6 データベースにクエリを投げる

    • 感想:うむ。lambdaによって周囲の文脈から意味がかわる関数を書ける、というのはやっぱりすごいな。
    • 感想:そして、最初のチュートリアルで高階関数がでてくるのもめずらしいのでは。

  • 3.7 既存のレコードを更新する -- もう1つのWHEREの使い道
  • 3.8 ムダを排除して勝利を収める

    • 感想:で、マクロについても同様。


こつこつ。

【実践CL】2 お気の済むまで:REPLツアー


  • 前説

    • 要旨:プログラミング環境を構築してちょっといじってみる。環境は、Lisp in a box (emacs+slime)とする。
    • 感想:私はemacs+eli+aclだけど、せっかくなのでLisp in a boxもやってみる。

  • 2.1 Lisp処理系を選ぶ

    • 要旨:CLは言語仕様が標準化されている。処理系はたくさんあって、自分で選ぶことになる。その点がPerlやVBやJavaなどと事情が違う。

  • 2.2 Lisp in a Boxで始めよう

    • 要旨:(Emacsのさわりを紹介)

  • 2.3 心を解き放て:対話的プログラミング

    • 要旨:REPLという対話的環境がLispシステムの入口。Lispの式をLispシステムとやりとりする。ここでいろいろ定義したり試したりシステムを探ったりできる。
    • 要旨:ソース編集とREPLを同時に扱える環境(SLIMEなど)がないとLispプログラミングはやってらんないであろう。
    • 感想:gigamonkeysからlisp in a boxのv0.7を取得。OSX10.4用ACL用。newlicenceでライセンスを取得してEmacs.appを起動。を動いた。lisp in a box の本家ではOSXのサポートが見当らない。これでいく。

  • 2.4 REPLを試す

    • 要旨:Lispの式 -> Reader -> Lispオブジェクト -> Evaluator -> Lispオブジェクト -> Printer -> 印字

  • 2.5 Lisp流の"Hello, World"

    • 要旨:(よくわからない、、、ちょっといじってみよう、という感じか)

  • 2.6 作業を保存する

    • 要旨:SLIMEの基本的な使い方。loadとcompile-file。
    • 感想:ああ、だめだ。日頃自分が使っている環境じゃないとイライラする。emacs+eli+aclに戻ることにする。。。


こつこつ。

【実践CL】1 序論:なぜLISPなのか?

慢性的CL勉強会

で、PCLをやっている。よい機会ととらえて、一年振りにPCLをみてみようと思う。
今回は訳書を読むので表題は実践CLにしとこう。原書はインターネットで公開されているが、訳書は違う。その点に配慮して書いていく。


  • 前説

  • 1.1 なぜLispなのか?

    • 要旨:CLは「プログラム可能なプログラミング言語」だ。そしてCLをつかった開発は迅速かつ軽快だ。

  • 1.2 はじまりの場所

    • 感想:DARPAの恩恵に預っている部分でどこなんだろ?
    • 要旨:(Lispの歴史をちょっと紹介)

  • 1.3 誰のための本か?

    • 要旨:この本はCLに興味がある人すべてのためのものであり、CLのパワーが何かを明示している。

  • コラム

    • 要旨:Scheme, Elisp, AutoLispとCLは別物だ。


こつこつ。

【PAIP】22 Scheme: An Uncommon Lisp (その2)


  • 22.4 Throw, Catch, and Call/cc
  • 末尾再帰によって、loopはすべて記述できる。gotoを排除できるし、言語もシンプルになるよ。
  • しかしloop以外にもnonlocalなexitをしたい局面もあるよ。
  • CLではcatchとthrowがあるよ。
  • Schemeではcall-with-current-continuation(call/cc)という汎用かつ強力なものがあるよ。
  • call/ccはprocedureだよ。

  • call/ccの引数はひとつ。引数をcomputationと呼ぶ。
  • computiationはprocedureであり、これの引数もひとつ。
  • call/ccの返却値は、computationの返却値。
  • ただし、computationの引数(ccと呼ぶ)もprocedureであり、それはcurrent continuation pointを表わしている。
  • なので、

    (+ 1 (call/cc (lambda (cc) (+ 20 30))))
    は、ccが
    (lambda (val) (+ 1 val))
    であり、これがcomputationに渡されるが、computationはccを使っていないので、元の式は、
    ((lambda (val) (+ 1 val)) (+ 20 30))
    となり、231が値となる。

    (+ 1 (call/cc (lambda (cc) (+ 20 (cc 300)))))
    は、ccが
    (lambda (val) (+ 1 val))
    であり、これがcomputaionに渡される。computationはccを使っているので、使っているところでccの処理が接ぎ木される。
    ((lambda (val) (+ 1 val)) 300)
    なので値は301。また、次と同値とも言える。
    ((lambda (val) (+ 1 val))
    (catch 'cc
    ((lambda (v) (+ 20 v))
    (throw 'cc 300))))

  • というのが基本。で、ccという形で残りの計算をprocedureとして扱えるので、いろいろできる、と。
  • 特徴的なのは、catch, throwは動的エクステントだが、call/ccの継続は不定エクステントということ。

  • call/ccで、自動バックトラッキングを実装できるよ。おお、すごい。

  • 22.5 An Interpreter Supporting Call/cc
  • CPSでinterpをごりごり書き直す。

うーん。もともとSchemeを知っていたからなのかわからないが、インタプリタを書くことによってどれくらいLispに詳しくなるのかわからんなぁ。もちろんCLでインタプリタを書く方法には詳しくなるんだけど。
こつこつ。

2008年12月26日金曜日

【PAIP】22 Scheme: An Uncommon Lisp


  • Schemeの紹介をちょろちょろ。

  • 22.1 A Scheme Interprete
  • 簡易インタプリタ -> マクロ対応インタプリタ -> 末尾再帰インタプリタ -> 継続対応インタプリタ、の順で作っていくよ。
  • まず、簡易インタプリタ。
  • うむー、新しい知見はなし。今までやってきたことにすぎない。

  • 22.2 Syntactic Extension with Macros
  • Schemeにはマクロはないよ。えっと、この本がかかれたのは1990〜1992、するとそのときのSchemeはR4RSかな。のぞいてみると、Appendixで拡張として軽く触れらている程度だな。
  • さて、しかしderived expressionsを作るのにmacroは有効。そこでmacroを作るんだけど、Schemeの外(CL)につくる方針とするよ。
  • そしてCLのmacroを使っちゃうよ。
  • macroでspecial formを作っていくのは、言語が肥大化してもインタプリタやコンパイラをシンプルにしておくのに有効だよ。

  • 22.3 A Properly Tail-Recursive Interpreter
  • ここまでのインタプリタは、ホスト環境であるCLが末尾再帰最適化に対応していれば、末尾再帰最適化となるが、そうじゃなければそうならない。Schemeは末尾再帰最適化することが仕様でもとめられているので、それを実装する。
  • スタックオーバーフローしないためのポイントは2つ。ifとprocedure call。

次回は、22.4 Throw, Catch, and Call/cc から。おお、継続だ、懐しい。
こつこつ。

2008年12月25日木曜日

【PAIP】これからの進め方

PAIPもしどろもどろながら、500Pまで来た。
ここでちょうどPART IIIがおしまい。PAIPを読む前と、PAIPをここまで読んだ今では、気分的には随分視野がひろがった感じがする。

さて、順序どおりでいけばPART IVで先進的なAIプログラミングをやることになるのだが、どうやらそれは二周目にやった方がよさそうだ。PART IIIまでを確かにした上でやった方が断然楽しめるはず。

というわけで、PART V THE REST OF LISP に進むことにする。

現時点では、AIよりもCL習得の方が目的なので、やっぱり早くPART Vをやりたいという気持もある。

次回は、Chapter 22 Scheme: An Uncommon Lisp。

【PAIP】14 Knowledge Representation and Reasoning (その2)


  • 14.4 Problems with Prologs
  • Prologの主たる課題は、曖昧さをもつ事実を表現できないこと。
  • 具体的には、連言(and)は表現できるが、選言(or)と否定(not)とを表現できない。

  • 14.5 Problems with Predicate Calculus's Expressiveness
  • 一階述語論理の限界と高階による解決。しかし高階にしちゃうと記述量が、、、ということ。

  • 14.6 Problems with Completeness
  • ううむ。この節、completenessについての話らしいのだが、論理学の完全(completeness)とどう関係があるのかがわからない。とりあえず、気にしない、気にしない。

  • 14.7 Problems with Efficiency: Indexing
  • 事実が足されるたびに、述語をrecompileするわけにはいかない。そこに性能の課題あり。

  • 残りの節では、Efficiency, Completeness, Expressivenessの順に処方をしめしていく。

  • 14.8 A Solution to the Indexing Problem
  • インデックス問題の解決。
  • コンパイラをやってないので、ここは割愛。

  • 14.9 A Solution to the Completeness Problem
  • 完全性(ここでは処理が終わる、ということ)についての問題解決。

  • 14.10 Solutions to the Expressiveness Problems
  • 処方箋は次の3つ。

    • 高階の述語論理(制限付き)
    • フレームシンタックス
    • 可能世界による選言や否定の取扱い。

  • フレームを初めて具体的に扱った! 話には良くでてきてSlotありのObjectということは知ってたんだけど、それを具体的に扱う機会がなかったんだよね、、、

この章は、CL色よりもAI色の方が強かった。
ついついAIMAの知識表現のところも読んでしまった。AIMAは1990以降の話もあり、やはり私にとってはPAIPの続編みたいだ。
こつこつ。

2008年12月24日水曜日

【PAIP】14 Knowledge Representation and Reasoning


  • 1960年代のAIは探索技術に集中していたよ。
  • 定理証明がテーマだったよ。
  • 定理証明というのは、公理と定理を指定すると、その定理の証明を生成するもの(もしくはその真偽を判定する)。
  • うまい推論機構があれば、あらゆる定理を生成(もしくはその真偽を判定)できると考えていたよ。
  • しかしNP困難な問題については、どんなに賢い推論機構をもってしても歯がたたないと気づいたよ。

  • で、エキスパートシステムがでてきたよ。
  • これは、困難な問題を解決する鍵となるのは、その問題をそれより簡単な問題に帰着させるspecial-case rulesをどう獲得するか、という考えだよ。
  • エキスパートシステムをやってみると、推論機構よりも、役に立つ知識をもってるかどうかが問題解決には有効、となったよ。
  • ま、それはそうだろう。
  • なので、課題は、いかに知識を得るか、ということと、いかに知識を表現するかということになったよ。

  • で、また課題発生。
  • あるシステムに必要な「知識」というものは、確定しているものじゃないんだ、ということだよ。
  • で、知識表現、というものの研究が進んでいったよ。また表現した知識の取扱い方法の研究が進んでいったよ。
  • そこでの課題は、表現力と効率のトレードオフだったよ。これは並び立たないよ。

  • で、悪いニュース。
  • 1980年代の研究によって、意味のある表現力をもった効率的な表現(言語)というのが存在しないことがわかったよ。常に、その言語で解く問題の最悪のケースでは、莫大な時間をようすることがわかったよ。

  • で、1990年代。
  • 最悪のケースで遅いのはしょうがないけど、大抵の場合は速いぞ、という知識表現と推論というものに研究は向っていったよ。

  • なる。

  • 14.1 A Taxonomy of Representation Languages
  • 研究した結果、知識表現の言語は4つのグループにわかれるよ。Logical Formulae, Networks, Objects, Procedures。

  • 14.2 Predicate Calculus and its Problems
  • うーん、深い! 面白い!

  • 14.3 A Logical Language: Prolog
  • うわ。Prologめった打ち。。。


とりあえず、ここまで。ぼちぼち。

NIKON UP

昨日、NIKONのUPの原宿アンテナショップにいってきた。

NIKON UP

つけているとすごく重々しくなって恥しいんじゃないかと思っていたが、街中で装着もありかなと一瞬思せるくらいのデキではあった。ただ、私は目が弱いので、目の疲れが早そう。電池の持ちが映像だと2Hというのもちょっとつらい。コンピューティングにうまい使い道がないかなとおもってみてきたけど、ちょいと難しいかな。

学びのエクササイズ 認知言語学

昨日は街中をぶらぶらしつつ本を読んだ。

学びのエクササイズ 認知言語学

を一気読み。面白かった!
OOの抽象ドメインモデル、DSLなどとの関連が浮き出ている。
また認知言語学の背後にあるのは圏論。圏論の雰囲気もつかめた。

気分転換にお勧めの一冊。

【PAIP】13 Object-Oriented Programming (その2)


  • 13.7 CLOS: The Common Lisp Object System
  • CLOSの基本の紹介。

  • 13.8 A CLOS Example: Searching Tools
  • また探索かぁ、、、
  • CLOSがもっとも適しているのは、「型がいくつかあって、それらが似たような振舞を共有している」ときだ。
  • たとえば、探索とか。section6.4で、breadth-first、depth-first、best-first、tree-first、graph-basedなどがあった。
  • 手続き型では、これはたくさんの関数ができてしまう。
  • section6.4では、その問題を高階関数を使うことでその複雑さ(困難)を回避した。

  • 一番初めにつくるクラスが problem というのが、PAIPらしいというかNorvigらしいというか。

  • 13.9 Is CLOS Object-Oriented?
  • CLOSのdefmethodは、Prologの関係定義というかパターンマッチングによる関数定義と酷似しているよ。
  • うぉ、ほんとだ。。。

  • 13.10 Advantages of Object-Oriented Programming
  • 特になし。

  • 13.11 History and References
  • 他の章にくらべて、ずいぶん長い。
  • ま、お話なので割愛。

なんとかぼやぼやと459Pまで到達。
次は、14 Knowledge Representation and Reasoning。これはAIではかなり本陣では???

2008年12月22日月曜日

【PAIP】13 Object-Oriented Programming


  • プログラミングの黎明期はまず命令型プログラミング・スタイルだったよ。アセンブラとか。
  • そこで、大域状態というのが厄介でありプログラムがどんどん複雑になる、ということにプログラマは気づいていった。
  • そのうち、サブルーチンという考え方がでてきたよ。それらはアルゴリズミックとか手続き型プログラミング・スタイルと呼ばれたよ。FORTRANとかCとかLisp(setfを使う場合)とか。
  • サブルーチンは、問題を小さな問題に分解する手法であり、プログラムの複雑さを低減させたよ。しかし、大域状態に依存していたので、問題分解という意味では完全ではなかったよ。
  • そこで、受け取ったものだけに依存して、同じ入力に関しては同じ出力を常に返すという関数プログラミング・スタイルがでてきたよ。FPとかLisp (setfを使わない場合)とか。
  • こういう風に、プログラミング・スタイルは大域状態への非依存に向ってかわってきた。
  • しかし、ある種の問題を解くには、大域状態というものに依存した方が自然な場合もあるよ。
  • オブジェクト指向プログラミングというのは、大域状態に対する違った処方箋なのだよ。
  • 大域状態というのを細切れに小さくしつつ、管理可能にする方法なんだよ。

  • なるほど。

  • (ついでに) 宣言的言語というのは、ELIZAやSTUDENTのように、"what to do"を表現するものだよ("how to do"ではなく)。これらはルールベースプログラミングと呼ぶよ。
  • 宣言的プログラミングの一種が論理プログラミングだよ。Prologとか。

  • 13.1 Object-Oriented Programming
  • "Object-orientation = Objects + Classes + Inheritance" (Peter Wegner 1987)

  • 13.2 Objects
  • メモリ上にあるデータは全部Objectと言えばObject。整数の3もObject。
  • しかしObject指向というときのObjectは、もう少し大きいデータを想定していることが多いよ。
  • クロージャをつかうことによって、メソッド経由以外では状態にアクセスできないようにする、こうやってObjectというものを実現できる。

  • 13.3 Generic Functions
  • Generic Functionの実装って、なんというか、空洞化したSIベンダみたいなもんだな。

  • 13.4 Classes
  • define-classなどを実装。特になし。

  • 13.5 Delegation
  • 13.4の実装にてメソッド処理の移譲をやってみる。継承の概念の準備かな。

  • 13.6 Inheritance
  • ああ、ここのマトリックスは重要。昔、自分でOOについて考えたときも、このマトリックスを使って理解した。
  • 横軸がデータ型(classes)で、縦軸が関数(messages)のときに、
  • 縦(column)単位でまとめるのがOOのやり方よ。
  • 横(row)単位でまとめるのが古典的手続き型のやり方よ。
  • 升目ひとつずつバラで取り扱うのがデータ駆動型またはジェネリック型のやり方よ。
  • これ、自分で考えたときは誰だからの論文がベースなんだけど、縦軸指向がOOで、横軸指向がADTであると。ADTは抽象データ型で、MLとか関数型言語の重要な部分。で、どっちがいいかは扱う問題次第だね、ということ。

ふーむ。とりあえずここまで。
次回は、CLOS:The Common Lisp Object System から。
ぼちぼち。

2008年12月21日日曜日

【PAIP】11 Logic Programming

Prologのイメージがつかめてきた。

  • データベースである。
  • ユニフィケーション。
  • 自動バックトラッキング。

これらがある種の問題を解くのに力を発揮する。力を発揮する、というのは、問題を記述しさえすれば、あとはPrologが解を探索してくれる、ということ。

CLによるPrologの実装については、あまりこまかく追えていない。これ、着実に理解しようとしたら、今までの章をもう一度復習しなおした方がよさそうなので、それはやめた。まずはイメージをとらえる。そして二周目に問題含めてしっかりやる。

というわけで、これのcompilerを実装する12章を今やっても無意味だろう。
13 Object-Oriented Programming に飛ぶことにする。

【PAIP】探す、ということ

PAIPをやっているなかで、ぼやぼや感じていること。

プログラミングの本質の一つは、「探す」ということではないか。探す、というと探索(Search)ということで、プログラミングの中でアルゴリズムが比較的整備されている分野、程度に思っていた。しかし、PAIPで古典AI系のプログラムがとどのつまり「探す」ということに終始しているのを見るにつけ、何かそれ以上のことに思えてきた。

例えば、文字列を変換する、ということは、入力された文字列をもとに、出力すべき文字列を探して、それを出力するということだ。
例えば、数値計算をする、ということは、入力である数値から、出力すべき数値を探して、それを出力するということだ。
そもそも、問題を解決する、ということは、入力である状況情報から、解空間を探索して、解を提示する、ということだ。
解空間をどのように定義して、探索をどのようにスマートにおこなうか、がプログラミング。これはとても抽象的な話であり、それの卑近な例がデータ構造とアルゴリズムである。

数値計算を例に少し考えを進める。
数値計算の内容が解析的に判明している場合は、探すという色合いは低くなり、解析的に明確になっている手順で解を計算することができる。
数値計算の内容が解析的に判明していない場合は、探すという色合いが強く、近似や漸近的な手法を用いた手順で解を計算することができる。

この「探す」ということは関数プログラミングと関連が深いように思う。
というのは、解空間を考えたとき、探すということは、入力と解空間の写像をどうしますか? ということになるからだ。入力と解空間の連鎖を考えるとき、それは関数適用の連続であり、思考は関数的であると思う。

そのような問題分析の結果、それをプログラミング言語でかきくだすときに、関数指向で書くのが自然である。それが関数プログラミング。なので、関数的に問題を分析していないのに、関数型プログラミング言語で関数プログラミングする、というのは無理がある。

もちろん、プログラミングの本質は「探す」ということだけではないだろう。だけど、とても重要に感じる。
他の本質は何か、ということも気になる。

ふと思ったのが、ここに書いたのは、今の自分にとっての本質かもしれない、ということだ。
今の自分の世界観にとって、この観点がピースとしてはまる、ということ。今の自分の世界観は、すでに集合論や計算理論やCLの複数の本の学習をやった上でのものだからだ。なので、本当の本質は、すでに既得となっているそれらの概念の中にあるのかもしれない。しかし、本質って何だ? というと、真実が無いのと同じように、客観的な本質など存在しないだろうから、いたしかたないと考えよう。

ちょっと見晴しがよくなった。
さあPAIP再開。

【IMAP】IMAPをちょっとだけ調べてみる

メールはほとんどIMAPを使っているんだけど、仕組みをさっぱり理解していないので、メール生活の工夫ができないという状況。POPだったら、fetchmail + procmailでローカルでやりたいようにやります、で終わりなんだけど。IMAPはサーバ上でいろいろやるべし、だと思うので。なので、少しだけIMAPの仕組みを探ってみる。

2008年12月10日水曜日

【PAIP】10 Low-Level Efficiency Issues (その3)

10.5 Use The Right Data Structureのつづき。

  • Tables
  • 基本的なことの説明。
  • トライ木(trie)。
  • 無閉路有向グラフ(dag)。
  • うーん。initial readtableそのものにset-macro-characterしちゃった後に*readtable*を元に戻す方法がわからない。。。

なんとか347Pまで到達。
次はとうとうProlog山だ!!
じわじわ。

【PAIP】10 Low-Level Efficiency Issues (その2)


  • 10.5 Use the Right Data Structures
  • キーとなるデータ構造については、徹底的に効率にこだわるべし。
  • 効率のあげ方は環境に依存する部分もあるが、ユニバーサルな手法もあるよ。
  • ここでは3つのケーススタディをやる。

  • Variables
  • ランタイムのデータ構造にVariablesが必要になることがある。(unification with backward chainingとか)
  • そのVariablesをどう実装するか。

    • ?頭のシンボルを使う。
    • ?頭のキーワードシンボルを使う。(かなり速い)
      #.マクロって知らんかった。
    • structureを使う。(シンボルより遅い)
    • もっとも速いのは、負数を使う。(パターン内の表現で負数を使えなくなるが)


  • Queues
  • listでやる。( O(N^2) )
  • (contents . last) pair 方式。
  • (last . contents) pair 方式。(これ、頭いいな。。。)

うむー、あと3Pなんだけど、時間が、、、きざんでいこう。こつこつ。

2008年12月9日火曜日

【PAIP】10 Low-Level Efficiency Issues


  • 10.1 Use Declarations
  • 宣言によるコンパイラの振舞いの違い。新しい知見は無いが、こういう話は面白く感じる。

  • 10.2 Avoid Generic Functions
  • 表題のとおり。半ページしかない。

  • 10.3 Avoid Complex Argument Lists
  • えっと、まず、効率化を考えるときはdisassembleをいろいろしてみて、コンパイラの振舞いをしることが重要そうだ。
  • そしてこの節では、関数の引数リストは結構ハイコストよ、ということ。
  • keyword parameterがもっともコストが高い。しかしkeyword parameterを使いたいときもある。そういうときは、keywordパラメータをもったものはフロントエンドとして、処理本体は別関数にするなどの手法があるよ。

  • 10.4 Avoid Unnecessary Consing
  • 要点をピックアップ

    • nondestructiveではなくdestructiveな関数を使って対処。
    • appendは非効率的。accumulatorを使って書き直せる。経験豊かなLisperはこういうのに慣れてる。
    • GC機構によって何が速いかはかわってくる。場合によっては、nreverseよりもreverseの方が速い。timeせよ。
    • ※P330〜P331のvectorの例は、aclでは、:adjustable tをつけないとエラーになる。
    • *uniq-cons-table*をつくって、consをreuseする。(ここまでするのか)
    • 多値で返すということは、consなどの構造を作らないので節約になる。
    • リソース(プール)を作る。



とりあえず、ここまで。平日に少し進めた。。。
次回は、10.5 Use the Right Data Structures から。

2008年12月8日月曜日

【PAIP】9 Efficiency Issues (その4)


  • 9.5 Instrumentation: Deciding What to Optimize
  • LispはRADに適した言語だよ。
  • だから動くものは手早くできるよ。
  • その後、効率を改善する、というのはいいアイデアだよ。
  • そのとき、どこを改善するかを見極めるのがポイントだよ。
  • それぞれの関数が何回呼ばれているのかは最小限必要だよ。それを関数のプロファイリングと呼ぶよ。
  • たいていのLispはプロファイリング機構はビルトインでもってるよ。まずはそれを使いなさいな。
  • ここでやってみせるのは、あんたのLispでそれが欠落している場合のためと、関数をいじくるやり方を見せるのが目的よ。

  • なるほど。

  • ちなみに、aclにはあるのかな? と調べてみる。あった。
    Runtime analyzer

  • こういう感じでシンボルを使えちゃうのが、CLっぽいなぁ。

    (defun profile1 (fn-name)
    "Make the function count how often it is called"
    ;; First save away the old, unprofiled function
    ;; Then make the name be a new function that increments
    ;; a counter and then calls the original function
    (let ((fn (symbol-function fn-name)))
    (setf (get fn-name 'unprofiled-fn) fn)
    (setf (get fn-name 'profile-count) 0)
    (setf (symbol-function fn-name)
    (profiled-fn fn-name fn))
    fn-name))


  • 9.6 A Case Study in Efficiency: The SIMPLIFY Program
  • 9.5で作ったProfilerをつかいながら、9.4までの4つの観点でSIMPLIFYをチューニングしていく。
  • テストデータを用意して、その正解をチューニング前のアプリを使って計算して、それらの組をテストケースとしてしまう。テストの半自動生成。面白い。仕様通りかはわからないが、チューニングの過程でズレがないことはわかる。
  • 最終的に130倍の性能がでるのは圧巻。


ああ,ついに300ページ越え!! 314P!
これでCLのよい書き振りってこんなんよ、というのはわかっていると思っていいはずだ!

今後の山予想。。。

  • 11,12 :Prolog山
  • 13    :OO山
  • 14    :知識表現&推論山
  • 15〜21 :本山 (エキスパートシステム〜自然言語処理)
  • 22〜25 :Lisp仕上げ山 (Schemeのインタプリタとコンパイラを作成?)

高い。。。途方もなく高く感じる。。。こつこつ。

【PAIP】9 Efficiency Issues (その3)

きざみ中。Par 6か。

  • 9.3 Delaying Computation
  • ん、おかしい。Norvigは、
    (functionp (last '(theta iota kappa lambda))) ;=> T
    というが、これはaclではnilである。HyperSpecをみてみると、
    (functionp '(lambda (x) (* x x))) ;=> false
    (functionp #'(lambda (x) (* x x))) ;=> true
    ということなので、aclが正しいのだろう。
  • まあ、Closureを使ってlazyというお話。

  • 9.4 Indexing Data
  • 半ページのみ。新しい知見は無い。

休みの日はPAIPができる。 幸せだ。。。

2008年12月7日日曜日

Googleグループに入ってみた

えっと、Web2.0?のようなものがあまり得意ではないのですが、ちょっとチャレンジしてみました。


  • Gmailのアカウントをつくる。
  • Googleグループに参加してみる。
    caddr グループ


なんせどちらも初めてなので、慣れるまでずいぶん時間がかかりそうな気がします。
地道にいこうと思います。

【PAIP】9 Efficiency Issues (その2)


  • 9.1 Caching Results of Rrevious Computations: Memoization
  • そっか、Memoizationって、メモ化されてない関数を受け取って、そのメモ化バージョンを返す高階関数として定義できるんだな。なるほど。

  • 9.2 Compiling One Language into Another
  • インタプリタ:「プログラム」を表しているなんらかのデータ構造を評価するもの。
  • コンパイラ :「プログラム」を表しているなんらかのデータ構造を別の言語のプログラムに変換するもの。
  • なるほど。どんな言語で書かれたものであってもソースコードというのはデータ構造なんだよね、インタプリタやコンパイラから見れば。当たり前だけど新鮮。
  • そこにメタの概念を持ち込んで、「コンパイラから見たソースコードという意味でのデータ構造」と「ソースコードの中での、プログラム=アルゴリズム+データ構造という意味でのデータ構造」を同じにしてしまおう、とするとLispが出てくるんだろうな。

こつこつ。

【PAIP】9 Efficiency Issues

お話し主体。
言語によらず、アルゴリズムをスピードアップする手法は次の4つである。

  • Caching : 計算結果をとっておいて再利用する。
  • Compiling : ランタイムに実行するものごとを少くする。
  • Delaying : 計算のある部分が不要かもしれない場合は、その計算を延期する。
  • Indexing : データ構造から素早く情報を取り出すためにインデックスをつける。

この章は、この順番で説明していく。こつこつ。

【PAIP】8 Symbolic Mathematics: A Simplification Program


  • rule-based-translatorとpat-matchの応用。だいぶ慣れてきたので、要点のみ記載。
  • rule-based-translatorとpat-matchはかなり強力だな。この本で紹介されている初期のAIのプログラムが簡単に書けている。
  • はじめに代数のSimplificationをやって、微分へ。微分もSimplificationの演算と捉えて実装。
  • 不定積分はフック的な関数を登録できるようにして実装。

  • 数式の微分演算を記号的にとりあつかうことがLispの発想の源泉であったと。そうだったのか。。。
  • それのみならず、MacLispの仕様には、記号数式処理システムMACSYMAを作るということの影響が大きいとな。そのため、多くのLisp本にて微分演算が例として挙げられている、とな。なるほど。


最後の方ぐだぐだになったが、それは二周目の課題としよう。
なんとか261Pまで到達。ついにPART III TOOLS AND TECHNIQUESだ。次回はChapter 9 Efficiency Issues。

こつこつ。

【PAIP】7 STUDENT: Solving Algebra Word Problems

第7章のねらいはなんだろう。STUDENTという歴史的な一品を鑑賞するってことなのかな??
とりあえず進む。ソース主体な章なので、コメント方式で。例によって、日本語のコメントは私。それ以外はNorvig。ただしソースは写経なので間違えてたらごめんなさい。


;;; 7.1 Translating English into Equations

;;; STUDENTの仕様
;;;
;;; 1. 入力を句に分解する。句は等式を表すものとする。
;;; 2. 句を等号で結ばれたペアに変換する。
;;; 3. 2の句をさらに分解して、数と変数を要素とする四則演算となるようにする。
;;; 4. rule-based translatorを用いて英語の句を数式に変換する。
;;; 5. 4の数式群について変数の値を求める。
;;; 6. 5の結果を出力する。


(defstruct (rule (:type list)) pattern response)

(defstruct (exp (:type list)
(:constructor mkexp (lhs op rhs)))
op lhs rhs)

(defun exp-p (x) (consp x))
;; conspだけでexp-pとしちゃっていいの?

(defun exp-args (x) (rest x))

(pat-match-abbrev '?x* '(?* ?x))
(pat-match-abbrev '?y* '(?* ?y))

(defparameter *student-rules* (mapcar #'expand-pat-match-abbrev
'(((?x* |.|) ?x)
((?x* |.| ?y*) (?x ?y))
((if ?x* |,| then ?y*) (?x ?y))
((if ?x* then ?y*) (?x ?y))
((if ?x* |,| ?y*) (?x ?y))
((if ?x* |,| and ?y*) (?x ?y))
((?x* |,| and ?y*) (?x ?y))
((find ?x* and ?y*) ((= to-find-1 ?x) (= to-find-2 ?y)))
((find ?x*) (= to-find ?x))
((?x* equals ?y*) (= ?x ?y))
((?x* same as ?y*) (= ?x ?y))
((?x* = ?y*) (= ?x ?y))
((?x* is equal to ?y*) (= ?x ?y))
((?x* is ?y*) (= ?x ?y))
((?x* - ?y*) (- ?x ?y))
((?x* minus ?y*) (- ?x ?y))
((difference between ?x* and ?y*) (- ?y ?x))
((difference ?x* and ?y*) (- ?y ?x))
((?x* + ?y*) (+ ?x ?y))
((?x* plus ?y*) (+ ?x ?y))
((sum ?x* and ?y*) (+ ?x ?y))
((product ?x* and ?y*) (* ?x ?y))
((?x* * ?y*) (* ?x ?y))
((?x* / ?y*) (/ ?x ?y))
((?x* per ?y*) (/ ?x ?y))
((?x* divided by ?y*) (/ ?x ?y))
((half ?x*) (/ ?x 2))
((one half ?x*) (/ ?x 2))
((twice ?x*) (* 2 ?x))
((square ?x*) (* ?x ?x))
((?x* % less than ?y*) (* ?y (/ (- 100 ?x) 100)))
((?x* % more than ?y*) (* ?y (/ (+ 100 ?x) 100)))
((?x* % ?y*) (* (/ ?x 100) ?y)))))

(defun student (words)
"Solve certain Algebra Word Problems."
(solve-equations
(create-list-of-equations
(tranlate-to-expression (remove-if #'noise-word-p words)))))
;; words : 例 (If z is 3 |,| what is twice z)


(defun translate-to-expression (words)
"Translate an English phrase into an equation or expression."
(or (rule-based-translator
words *student-rules*
:rule-if #'rule-pattern :rule-then #'rule-response
:action #'(lambda (bindings response)
(sublis (mapcar #'translate-pair bindings)
response)))
(make-variable words)))
;; words : 例 (If z is 3 |,| what is twice z)
;;
;; rule-based-translator の引数仕様は、次のよう。
;; INPUT RULES &KEY (MATCHER (quote PAT-MATCH)) (RULE-IF (function FIRST)) (RULE-THEN (function REST)) (ACTION (function SUBLIS)))
;; INPUT RULESは字句通り。
;; matcherはpat-match。
;; :rule-ifと:rule-thenの、#'rule-patternと#'rule-responseはELIZAのものである、としておく。
;; :actionは、(funcall action result (funcall rule-then rule))であり、マッチしたときにbindingsとrule-thenを
;; 使って、どう変換しますか、ということだった。ここでは#'tranlate-pairを使うのが特徴。
;;
;; rule-based-translatorがfailしたときは、make-variableを呼ぶ。

(defun translate-pair (pair)
"Translate the value part of the pair into an equation or expression."
(cons (binding-var pair)
(translate-to-expression (binding-val pair))))
;; ここ、再帰になっている。
;; pair : bindingsの中の1要素。例 '(var . val)
;; valがまだ変換可能なものかもしれないので、それを実施。
;; 結果としては、another pairを返すだけ。ただし、valはもう分解可能な構造を含まないものになっている。


(defun create-list-of-equations (exp)
"Separate out equations embeded in nested parens."
(cond ((null exp) nil)
((atom (first exp)) (list exp))
(t (append (create-list-of-equations (first exp))
(create-list-of-equations (rest exp))))))
;; 動作例で理解する。
#+test (create-list-of-equations nil) ;-> nil
#+test (create-list-of-equations 'a) ;-> error
#+test (create-list-of-equations '(a)) ;-> '((A))
#+test (create-list-of-equations '(a b)) ;-> '((A B))
#+test (create-list-of-equations '(a (b))) ;-> '((A (B)))
#+test (create-list-of-equations '((a) b)) ;-> '(((A) (B)))
#+test (create-list-of-equations
'((a) (b c) ((d e) f))) ;-> '((A) (B C) (D E) (F))

(defun make-variable (words)
"Create a variable name based on the given list of words"
;; The list of words will already have noise words removed
(first words))
;; これはtranslate-to-expressionの中で呼ばれている。
;; しかし、これが意味があるのは、translate-pairのなかでtranslate-to-expressionを読んでいるところだろう。
;; translate-pairの中で、valが分解不可能なときに、そのval(words)の第一要素を変数名として代表させる、ということ。


(defun noise-word-p (word)
"Is this a low-content word that can be safely ignored?"
(member word '(a an the this number of $)))
;; word : 例の各要素 (If z is 3 |,| what is twice z)


;;; 7.2 Solving Algebraic Equations

(defun solve-equations (equations)
"Print the equations and their solution"
(print-equations "The equations to be solved are:" equations)
(print-equations "The solution is:" (solve equations nil)))

(defun solve (equations known)
"Solve a system of equations by constraint propagation."
;; Try to solve for one equation, and substitute its value into
;; the others. If that doesn't work, return what is known.
(or (some #'(lambda (equation)
(let ((x (one-unknown equation)))
(when x
(let ((answer (solve-arithmetic
(isolate equation x))))
(solve (subst (exp-rhs answer) (exp-lhs answer)
(remove equation equations))
(cons answer known))))))
equations)
known))

(defun isolate (e x)
"Isolate the lone x in e on the left-hand side of e."
;; This assumes there is exactly one x in e,
;; and that e is an equation.
(cond ((eq (exp-lhs e) x)
;; Case I: X = A -> X = n
e)
((in-exp x (exp-rhs e))
;; Case II: A = f(X) -> f(X) = A
(isolate (mkexp (exp-rhs e) '= (exp-lhs e)) x))
((in-exp x (exp-lhs (exp-lhs e)))
;; Case III: f(X)*A = B -> f(X) = B/A
(isolate (mkexp (exp-lhs (exp-lhs e)) '=
(mkexp (exp-rhs e)
(inverse-op (exp-op (exp-lhs e)))
(exp-rhs (exp-lhs e)))) x))
((commutative-p (exp-op (exp-lhs e)))
;; Case IV: A*f(X) = B -> f(X) = B/A
(isolate (mkexp (exp-rhs (exp-lhs e)) '=
(mkexp (exp-rhs e)
(inverse-op (exp-op (exp-lhs e)))
(exp-lhs (exp-lhs e)))) x))
(t ;; Case V: A/f(X) = B -> f(X) = A/B
(isolate (mkexp (exp-rhs (exp-lhs e)) '=
(mkexp (exp-lhs (exp-lhs e))
(exp-op (exp-lhs e))
(exp-rhs e))) x))))
;; このNorvigのコメントの書き方、わかりやすいな。


(defun print-equations (header equations)
"Print a list of equations."
(format t "~%~a~{~% ~{ ~a~}~}~%" header
(mapcar #'prefix->infix equations)))

(defconstant operators-and-inverses
'((+ -) (- +) (* /) (/ *) (= =)))

(defun inverse-op (op)
(second (assoc op operators-and-inverses)))

(defun unknown-p (exp)
(symbolp exp))

(defun in-exp (x exp)
"True if x appears anywhere in exp"
(or (eq x exp)
(and (exp-p exp)
(or (in-exp x (exp-lhs exp)) (in-exp x (exp-rhs exp))))))

(defun no-unknown (exp)
"Returns true if there are no unknowns in exp."
(cond ((unknown-p exp) nil) ;=1=
((atom exp) t) ;=2=
((no-unknown (exp-lhs exp)) (no-unknown (exp-rhs exp))) ;=3=
(t nil))) ;=4=
;; =1= : シンボルならnil。
;; =2= : シンボルじゃないatomならt。
;; =3= : ここにきたということはconsということ。で、左辺がno-unknownかcheck。
;; no-unknownなら右辺のno-unknown check結果を返却。
;; =4= : 左辺がno-unknownじゃないということ。なのでnil。


(defun one-unknown (exp)
"Returns the single unknown in exp, if there is exactly one."
(cond ((unknown-p exp) exp) ;=1=
((atom exp) nil) ;=2=
((no-unknown (exp-lhs exp)) (one-unknown (exp-rhs exp))) ;=3=
((no-unknown (exp-rhs exp)) (one-unknown (exp-lhs exp))) ;=4=
(t nil))) ;=5=
;; =1= : シンボルならそれを返せばよし。
;; =2= : シンボル以外のatomなら、no unknownなので、nil。
;; =3= : 左辺がno unknownなら、右辺がone unknownかどうかの結果を返す。
;; =4= : =3=の左右をいれかえた処理。
;; =5= : 左辺にも右辺にもunknownがあるので、nil。


(defun commutative-p (op)
"Is operator commutative?"
(member op '(+ * =)))


(defun solve-arithmetic (equation)
"Do the arithmetic for the right-hand side."
;; This assumes that the right-hand side is in the right form.
(mkexp (exp-lhs equation) '= (eval (exp-rhs equation))))


(defun binary-exp-p (x)
(and (exp-p x) (= (length (exp-args x)) 2)))


(defun prefix->infix (exp)
"Translate prefix to infix expressions."
(if (atom exp) exp ;=1=
(mapcar #'prefix->infix ;=2=
(if (binary-exp-p exp) ;=3=
(list (exp-lhs exp) (exp-op exp) (exp-rhs exp)) ;=4=
exp)))) ;=5=
;; 自分自身の中で、自分をmapcarで読んで再帰している。。。
;; =1= : atomならそのまま返して終了
;; =2= : atomじゃないならexp(式)はリストであって、
;; =3= : リストの要素たちに自分をmapcarするだけど、そのリストは加工したもので、
;; =4= : 要素がbinary-expならば、infixに変換したものがmapcar対象であり、
;; =5= : 要素がbinary-expでないならば(おそらくunary)、そのまま、というようなリスト。



;;ためしてみる。
;;CL-USER(22): (solve-equations '((= (+ 3 4) (* (- 5 (+ 2 x)) 7))
;; (= (+ (* 3 x) y) 12)))
;;
;;The equations to be solved are:
;; (3 + 4) = ((5 - (2 + X)) * 7)
;; ((3 * X) + Y) = 12
;; 0[4]: (SOLVE ((= (+ 3 4) (* (- 5 (+ 2 X)) 7)) (= (+ (* 3 X) Y) 12)) NIL)
;; 1[4]: (ISOLATE (= (+ 3 4) (* (- 5 (+ 2 X)) 7)) X)
;; 2[4]: (ISOLATE (= (* (- 5 (+ 2 X)) 7) (+ 3 4)) X)
;; 3[4]: (ISOLATE (= (- 5 (+ 2 X)) (/ (+ 3 4) 7)) X)
;; 4[4]: (ISOLATE (= (+ 2 X) (- 5 (/ (+ 3 4) 7))) X)
;; 5[4]: (ISOLATE (= X (- (- 5 (/ (+ 3 4) 7)) 2)) X)
;; 5[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 4[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 3[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 2[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 1[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 1[4]: (SOLVE ((= (+ (* 3 2) Y) 12)) ((= X 2)))
;; 2[4]: (ISOLATE (= (+ (* 3 2) Y) 12) Y)
;; 3[4]: (ISOLATE (= Y (- 12 (* 3 2))) Y)
;; 3[4]: returned (= Y (- 12 (* 3 2)))
;; 2[4]: returned (= Y (- 12 (* 3 2)))
;; 2[4]: (SOLVE NIL ((= Y 6) (= X 2)))
;; 2[4]: returned ((= Y 6) (= X 2))
;; 1[4]: returned ((= Y 6) (= X 2))
;; 0[4]: returned ((= Y 6) (= X 2))
;;
;;The solution is:
;; Y = 6
;; X = 2
;;NIL
;;CL-USER(23):
;;
;;
;;
;; studentが間違える例
;;
;;CL-USER(27): (student '(The daily cost of living for a group is the overhead cost plus
;; the running cost for each person times the number of people in
;; the group |.| This cost for one group equals $ 100 |,|
;; and the number of people in the group is 40 |.|
;; If the overhead cost is 10 times the running cost |,|
;; find the overhead and running cost for each person |.|))
;;
;;The equations to be solved are:
;; DAILY = (OVERHEAD + RUNNING)
;; COST = 100
;; PEOPLE = 40
;; OVERHEAD = 10
;; TO-FIND-1 = OVERHEAD
;; TO-FIND-2 = RUNNING
;; 0[4]: (SOLVE ((= DAILY (+ OVERHEAD RUNNING)) (= COST 100) (= PEOPLE 40) (= OVERHEAD 10) (= TO-FIND-1 OVERHEAD) (= TO-FIND-2 RUNNING)) NIL)
;; 1[4]: (ISOLATE (= COST 100) COST)
;; 1[4]: returned (= COST 100)
;; 1[4]: (SOLVE ((= DAILY (+ OVERHEAD RUNNING)) (= PEOPLE 40) (= OVERHEAD 10) (= TO-FIND-1 OVERHEAD) (= TO-FIND-2 RUNNING)) ((= COST 100)))
;; 2[4]: (ISOLATE (= PEOPLE 40) PEOPLE)
;; 2[4]: returned (= PEOPLE 40)
;; 2[4]: (SOLVE ((= DAILY (+ OVERHEAD RUNNING)) (= OVERHEAD 10) (= TO-FIND-1 OVERHEAD) (= TO-FIND-2 RUNNING)) ((= PEOPLE 40) (= COST 100)))
;; 3[4]: (ISOLATE (= OVERHEAD 10) OVERHEAD)
;; 3[4]: returned (= OVERHEAD 10)
;; 3[4]: (SOLVE ((= DAILY (+ 10 RUNNING)) (= TO-FIND-1 10) (= TO-FIND-2 RUNNING)) ((= OVERHEAD 10) (= PEOPLE 40) (= COST 100)))
;; 4[4]: (ISOLATE (= TO-FIND-1 10) TO-FIND-1)
;; 4[4]: returned (= TO-FIND-1 10)
;; 4[4]: (SOLVE ((= DAILY (+ 10 RUNNING)) (= TO-FIND-2 RUNNING)) ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100)))
;; 4[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 3[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 2[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 1[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 0[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;;
;;The solution is:
;; TO-FIND-1 = 10
;; OVERHEAD = 10
;; PEOPLE = 40
;; COST = 100
;;NIL
;;CL-USER(28):

ただいま237Pまで到達。次回は第8章 Symbolic Mathematics: A Simplification Program。こつこつ。。。

2008年12月5日金曜日

aclにリモートからemacsで接続 [done]

できた。

http://www.franz.com/support/documentation/8.1/doc/operators/excl/new-start-emacs-lisp-interface.htm

でいける。手順としては、

まずlispをはしらせているホストのREPLで、

(start-emacs-lisp-interface t 1 9999 "/tmp/eli")

などとする。私はscreenをつかう人なので、screen上でやってデタッチ。
すると/tmp/eliファイルができる。

この/tmp/eliファイルをemacsをはしらせているホストのどこかにおく。
例えば、/tmp/eliとして置く。その後*scratch*にて、

(fi:start-interface-via-file "hoge" "*remote-lisp*" "/tmp/eli")

を評価する。hogeのところはIPアドレスまたはホスト名をいれる。
以上で完了。

NFSがつかえるなら、マウントして指定するだけでもよい。

2008年12月3日水曜日

aclにリモートからemacsで接続

いろいろ探ってみたが、ぱっと簡単な方法はないかも?
今のところ可能性があるのは、emacs lisp interfaceをファイルでやって、そのファイルをNFSで共有するというスタイル。ほんとにこんなことしなくちゃいかんのかな? eliじゃなくてslimeならできるのかな、、、eliに慣れちゃったのでそれもできれば避けたい。継続調査。

2008年12月1日月曜日

【PAIP】6 Building Software Tools (その5)

最後のほうぐだぐだになったが、なんとか、

  • 6.4 A set of searching tools (残り)
  • 6.5 GPS as Search
  • 6.6 History and References

がおわった。現在なんとか218Pまで到達。
この本やっぱりごついな。先も長い。でもこれをちゃんとやればプログラマになれたと思えると思える。

こつこつ、しかない。

【PAIP】6 Building Software Tools (その4)

6.4 A set of searching toolsの続き。

(defstruct (city (:type list)) name long lat)

(defparameter *cities*
'((Atlanda 84.23 33.45) (Los-Angeles 118.15 34.03)
(Boston 71.05 42.21) (Memphis 90.03 35.09)
(Chicago 87.37 45.50) (New-York 73.58 40.47)
(Denver 105.00 39.45) (Oklahoma-City 97.28 35.26)
(Eugene 123.05 44.03) (Pittsburgh 79.57 40.27)
(Flagstaff 111.41 35.13) (Quebec 71.11 46.49)
(Grand-Jct 108.37 39.05) (Reno 119.49 39.30)
(Houston 105.00 34.00) (San-Francisco 122.26 37.47)
(Indianapolis 86.10 39.46) (Tampa 82.27 27.57)
(Jacksonville 81.40 30.22) (Victoria 123.21 48.25)
(Kansas-City 94.35 39.06) (Wilmington 77.57 34.14)))

(defun neighbors (city)
"Find all cities within 1000 kilometers."
(find-all-if #'(lambda (c)
(and (not (eq c city))
(< (air-distance c city) 1000.0)))
*cities*))

(defun city (name)
"Find the city with this name."
(assoc name *cities*))
;; そうか、assocはdotted-pair対象じゃなくてもいいんだ。確認、
#+test
(assoc 'hoge '((hoge 1 2) (piyo 3 4)))

(defun trip (start dest)
"Search for a way from the start to dest."
(beam-search start (is dest) #'neighbors
#'(lambda (c) (air-distance c dest))
1))

#+test
(trip (city 'san-francisco) (city 'boston)) ; => error
;; air-distanceの定義がまだだから。


;;; Search Paths

(defstruct (path (:print-function print-path))
state (previous nil) (cost-so-far 0) (total-cost 0))
;;
;; データ構造だけみても何だかわからん。結局どう使わ
;; れるかがそれの説明。だとするとデータ構造の詳しい
;; 定義というのはそれの使われ方も書いてあるというこ
;; とになる。するとそこには関数の定義も含まれている
;; ような。
;; state : 探索の状態空間。
;; 空路探索アプリにおいては、city構造体が入る。
;; tripで初めにできる。start引数で値を指定する。
;; path-saver内にてsuccessorsに対応させて増産。
;; previous : 今拡張しようとしている部分パス
;; cost-so-far : previousにおけるcost
;; total-cost : ゴールまでの予測


(defun trip (start dest &optional (beam-width 1))
"Search for the best path from the start to dest."
(beam-search
(make-path :state start)
(is dest :key #'path-state)
(path-saver #'neighbors #'air-distance
#'(lambda (c) (air-distance c dest)))
#'path-total-cost
beam-width))

(defconstant earth-diameter 12765.0
"Diameter of planet earth in kilometers.")

(defun air-distance (city1 city2)
"The great circle distance between two cities."
(let ((d (distance (xyz-coords city1) (xyz-coords city2))))
;; d is the straight-line chord between the two cities.
;; The length of the subtending arc is given by:
(* earth-diameter (asin (/ d 2)))))

(defun xyz-coords (city)
"Returns the x,y,z coordinates of a point on a sphere.
The center is (0 0 0) and the north pole is (0 0 1)."
(let ((psi (deg->radians (city-lat city)))
(phi (deg->radians (city-long city))))
(list (* (cos psi) (cos phi))
(* (cos psi) (sin phi))
(sin psi))))

(defun distance (point1 point2)
"The Euclidian distance between two points.
The points are coordinates in n-dimensional space."
(sqrt (reduce #'+ (mapcar #'(lambda (a b) (expt (- a b) 2))
point1 point2))))

(defun deg->radians (deg)
"Convert degrees and minutes to radians."
(* (+ (truncate deg) (* (rem deg 1) 100/60)) pi 1/180))

(defun is (value &key (key #'identity) (test #'eql))
"Returns a predicate that tests for a given value."
#'(lambda (path) (funcall test value (funcall key path))))

(defun path-saver (successors cost-fn cost-left-fn)
#'(lambda (old-path)
(let ((old-state (path-state old-path)))
(mapcar
#'(lambda (new-state)
(let ((old-cost
(+ (path-cost-so-far old-path)
(funcall cost-fn old-state new-state))))
(make-path
:state new-state
:previous old-path
:cost-so-far old-cost
:total-cost (+ old-cost (funcall cost-left-fn
new-state)))))
(funcall successors old-state)))))

(defun print-path (path &optional (stream t) depth)
(declare (ignore depth))
(format stream "#"
(path-state path) (path-total-cost path)))

(defun show-city-path (path &optional (stream t))
"Show the length of a path, and the cities along it."
(format stream "#"
(path-total-cost path)
(reverse (map-path #'city-name path)))
(values))

(defun map-path (fn path)
"Call fn on each state in the path, collecting results."
(if (null path)
nil
(cons (funcall fn (path-state path))
(map-path fn (path-previous path)))))

#+test
(show-city-path (trip (city 'san-francisco) (city 'boston) 1))
;; => #

#+test
(show-city-path (trip (city 'boston) (city 'san-francisco) 1))
;; => #

#+test
(show-city-path (trip (city 'boston) (city 'san-francisco) 3))
;; => #

Guessing versus Guaranteeing a Good Solutionの前まで完了。こつこつ。

【PAIP】6 Building Software Tools (その3)


  • 6.3 A Rule-Based Translator Tool
  • ここはあっさり。

  • 6.4 A Set of Searching Tools
  • prependって、先頭にくっつけるって意味なんだ。手元の英和辞書に出てなかった。
  • あとはコードとコメントで。「日本語のコメントと#+test」以外はNorvig。

    ;;; 6.4 A Set of searching tools

    (defun tree-search (states goal-p successors combiner)
    "Find a state that satisfies goal-p. Start with states,
    and search according to successors and combiner."
    (dbg :search "~&:: Search: ~a" states)
    (cond ((null states) fail) ; =1=
    ((funcall goal-p (first states)) (first states)) ; =2=
    (t (tree-search ; =3=
    (funcall combiner ; =4=
    (funcall successors (first states))
    (rest states)) ; =5=
    goal-p successors combiner))))
    ;; =1= : statesが空ならfail。
    ;; =2= : (first states)がゴールなら終了。
    ;; =3= : 再帰。
    ;; =4= : 次に探索すべきstates作り。given combinerが作る。
    ;; =5= : (first states)の後続と(rest states)が引数。


    (defun depth-first-search (start goal-p successors)
    "Search new states first until goal is reached."
    (tree-search (list start) goal-p successors #'append))
    ;; combinerが#'appendなので、
    ;; tree-searchの再帰におけるstatesは、
    ;; (funcall successors (first states)) (rest states)
    ;; の順になる。なので、(first states)の後続をどんどん
    ;; 進んでいく。ゆえにdepth-first。


    (defun binary-tree (x) (list (* 2 x) (+ 1 (* 2 x))))
    ;; 動きを理解する。
    ;; 入力 -> 出力
    ;; 1 -> (2 3)
    ;; 2 -> (4 5)
    ;; 3 -> (6 7)
    ;; 4 -> (8 9)
    ;; 5 -> (10 11)
    ;; テスト用のきれいなbinary treeだな。

    (defun is (value) #'(lambda (x) (eql x value)))

    #+test
    (my-debug :search)
    #+test
    (depth-first-search 1 (is 12) #'binary-tree)

    (defun prepend (x y) "Prepend y to start of x" (append y x))

    (defun breadth-first-search (start goal-p successors)
    "Search old states first until goal is reached."
    (tree-search (list start) goal-p successors #'prepend))
    ;; combinerが#'prependなので、
    ;; tree-searchの再帰におけるstatesは、
    ;; (rest states) (funcall successors (first states))
    ;; の順になる。なので、given statesをひととおりチェック
    ;; してから(first states)の後続の検査となる。ゆえにbreadth-first。

    #+test
    (breadth-first-search 1 (is 12) 'binary-tree)

    (defun finite-binary-tree (n)
    "Return a successor function that generate a binary tree
    with n nodes."
    #'(lambda (x)
    (remove-if #'(lambda (child) (> child n))
    (binary-tree x))))
    ;; 試して動作を理解する。
    #+test
    (setf fn (finite-binary-tree 3))
    (funcall fn 1) ; => (2 3)
    (funcall fn 2) ; => nil
    (setf fn (finite-binary-tree 4))
    (funcall fn 1) ; => (1 2)
    (funcall fn 2) ; => (4)
    ;; そうか先のきれいなbinary treeにおいては、
    ;; nodeの値がnode総数と同じだからこれでいいんだ。

    (depth-first-search 1 (is 12) (finite-binary-tree 15))


    ;;; Guiding the Search

    (defun diff (num)
    "Return the function that finds the difference from num."
    #'(lambda (x) (abs (- x num))))

    (defun sorter (cost-fn)
    "Return a combinator function that sorts according to cost-fn."
    #'(lambda (new old)
    (sort (append new old) #'< :key cost-fn)))

    (defun best-first-search (start goal-p successors cost-fn)
    "Search lowest cost states first until goal is reached."
    (tree-search (list start) goal-p successors (sorter cost-fn)))

    #+test
    (best-first-search 1 (is 12) #'binary-tree (diff 12))

    (defun price-is-right (price)
    "Return a function that measures the difference from price,
    but gives a big peralty for going over price."
    #'(lambda (x) (if (> x price)
    most-positive-fixnum
    (- price x))))

    #+test
    (best-first-search 1 (is 12) #'binary-tree (price-is-right 12))

    (defun beam-search (start goal-p successors cost-fn beam-width)
    "Search highest scoring states first until goal is reached,
    but never consider more than beam-width states at a time."
    (tree-search (list start) goal-p successors
    #'(lambda (old new)
    (let ((sorted (funcall (sorter cost-fn) old new)))
    (if (> beam-width (length sorted))
    sorted
    (subseq sorted 0 beam-width))))))

    #+test
    (beam-search 1 (is 12) #'binary-tree (price-is-right 12) 2)

    #+test
    (beam-search 1 (is 12) #'binary-tree (diff 12) 2)


とりあえずここまで。こつこつ。

2008年11月30日日曜日

【PAIP】6 Building Software Tools (その2)

引き続き、6.2 A pattern-matching tool。

  • 6.2 A pattern-matching tool
  • おお、pattern/actionペアをテーブルにいれて拡張性を担保するプログラミングスタイルを、data-driven programmingと言うのか。正直知らんかった。
  • "In this case, the keys to the table will be symbols (like ?*), and it is fine if the representation of the table is distributed across memory. Thus, property lists are an appropriate choice." なるほど。こういう風に判断するのか。
  • あとはソースを追う。例によって日本語のコメントは私、その他はNorvig。

    ;;; 6.2 A Pattern-Matching Tool

    ;;; これらはgeneralized single patの例
    #+test
    (pat-match '(x = (?is ?n numberp)) '(x = 34)) ; => ((?n . 34))

    #+test
    (pat-match '(x = (?is ?n numberp)) '(x = x)) ; => nil

    #+test
    (pat-match '(?x (?or < = >) ?y) '(3 < 4)) ; => ((?Y . 4) (?X . 3))

    #+test
    (pat-match '(x = (?and (?is ?n numberp) (?is ?n oddp)))
    '(x = 3)) ; => ((?N . 3))

    #+test
    (pat-match '(?x /= (?not ?x)) '(3 /= 4)) ; => ((?X . 3))

    #+test
    (pat-match '(?x > ?y (?if (> ?x ?y))) '(4 > 3)) ; => ((?Y . 3) (?X . 4))


    (defun pat-match (pattern input &optional (bindings no-bindings))
    "Match pattern against input in the context of the bindings"
    (cond ((eq bindings fail) fail)
    ((variable-p pattern)
    (match-variable pattern input bindings))
    ((eql pattern input) bindings)
    ((segment-pattern-p pattern)
    (segment-matcher pattern input bindings)) ; segment-match -> segment-matcher
    ((single-pattern-p pattern) ; ***
    (single-matcher pattern input bindings)) ; ***
    ((and (consp pattern) (consp input))
    (pat-match (rest pattern) (rest input)
    (pat-match (first pattern) (first input)
    bindings)))
    (t fail)))
    ;; pat-match ver.6
    ;; *** の節を追加。


    (defconstant fail nil "Indicates pat-match failure")

    (defconstant no-bindings '((t . t))
    "Indicates pat-match success, with no variables.")

    (defun variable-p (x)
    "Is x a variable (a symbol beginning with '?')?"
    (and (symbolp x) (equal (char (symbol-name x) 0) #\?)))

    (defun get-binding (var bindings)
    "Find a (variable . value) pair in a binding list."
    (assoc var bindings))

    (defun binding-var (binding)
    "Get the variable part of a single binding."
    (car binding))

    (defun binding-val (binding)
    "Get the value part of a single binding."
    (cdr binding))

    (defun make-binding (var val) (cons var val))

    (defun lookup (var bindings)
    "Get the value part (for var) from a binding list."
    (binding-val (get-binding var bindings)))

    (defun extend-bindings (var val bindings)
    "Add a (var . value) pair to a binding list."
    (cons (cons var val)
    ;; Once we add a "real" binding,
    ;; we can get rid of the dummy no-bindings
    (if (eq bindings no-bindings)
    nil
    bindings)))

    (defun match-variable (var input bindings)
    "Does VAR match input? Uses (or updates) and returns bindings."
    (let ((binding (get-binding var bindings)))
    (cond ((not binding) (extend-bindings var input bindings))
    ((equal input (binding-val binding)) bindings)
    (t fail))))

    (setf (get '?is 'single-match) 'match-is)
    (setf (get '?or 'single-match) 'match-or)
    (setf (get '?and 'single-match) 'match-and)
    (setf (get '?not 'single-match) 'match-not)
    (setf (get '?* 'segment-match) 'segment-match)
    (setf (get '?+ 'segment-match) 'segment-match+)
    (setf (get '?? 'segment-match) 'segment-match?)
    (setf (get '?if 'segment-match) 'match-if)

    (defun segment-pattern-p (pattern)
    "Is this a segment-matching pattern like ((?* var) . pat)?"
    (and (consp pattern) (consp (first pattern))
    (symbolp (first (first pattern)))
    (segment-match-fn (first (first pattern)))))

    (defun single-pattern-p (pattern)
    "Is this a single-matching pattern?
    E.g. (?is x predicate) (?and . patterns) (?or . patterns)."
    (and (consp pattern)
    (single-match-fn (first pattern))))

    (defun segment-matcher (pattern input bindings)
    "Call the right function for this kind of segment pattern."
    (funcall (segment-match-fn (first (first pattern)))
    pattern input bindings))

    (defun single-matcher (pattern input bindings)
    "Call the right function for this kind of single pattern."
    (funcall (single-match-fn (first pattern))
    (rest pattern) input bindings))

    (defun segment-match-fn (x)
    "Get the segment-match function for x,
    if it is a symbol that has one."
    (when (symbolp x) (get x 'segment-match)))

    (defun single-match-fn (x)
    "Get the single-match function for x,
    if it is a symbol that has one."
    (when (symbolp x) (get x 'single-match)))

    (defun match-is (var-and-pred input bindings)
    "Succeed and bind var if the input satisfies pred,
    where var-and-pred is the list (var pred)."
    (let* ((var (first var-and-pred))
    (pred (second var-and-pred))
    (new-bindings (pat-match var input bindings))) ; =1=
    (if (or (eq new-bindings fail)
    (not (funcall pred input))) ; =2=
    fail
    new-bindings)))
    ;; =1= : まず、varでpat-matchしちゃう。
    ;; =2= : =1=がfailするか、inputがpredでないならば、もともとのbindingsを返却。
    ;; ここで、なぜpredの対象がinputでいいんだろ???
    ;; =3= : =1=が成功したら、new-bindingsを返却。


    (defun match-and (patterns input bindings)
    "Succeed if all the patterns match the input."
    (cond ((eq bindings fail) fail)
    ((null patterns) bindings) ; =1=
    (t (match-and (rest patterns) input ; =2=
    (pat-match (first patterns) input
    bindings)))))
    ;; =1= : 再帰の終了条件。patternsがnilならbindingsを返して終了。
    ;; =2= : patternsのfirstでpat-matchしたbindingsでpatternsのrestをpatternsとして再帰。

    (defun match-or (patterns input bindings)
    "Succeed if any one of the patterns match the input."
    (if (null patterns)
    fail ; =1=
    (let ((new-bindings (pat-match (first patterns) ; =2=
    input bindings)))
    (if (eq new-bindings fail)
    (match-or (rest patterns) input bindings) ; =3=
    new-bindings)))) ; =4=
    ;; =1= : 再帰の終了条件。pattensがnilならfail。
    ;; =2= : patternsのfirstがpat-matchするかをnew-bindingsへ。
    ;; =3= : =2=がfailしたらpatternsのrestで再帰。
    ;; =4= : =2=が成功なら、new-bindingsを返却。


    (defun match-not (patterns input bindings)
    "Succeed if none of the patterns match the input.
    This will never bind any variables."
    (if (match-or patterns input bindings)
    fail
    bindings))

    (defun segment-match (pattern input bindings &optional (start 0))
    "Match the segment pattern ((?* var) . pat) against input."
    (let ((var (second (first pattern)))
    (pat (rest pattern)))
    (if (null pat)
    (match-variable var input bindings)
    ;; We assume that pat starts with a constant
    ;; In other words, a pattern can't have 2 consecutive vars
    (let ((pos (first-match-pos (first pat) input start))) ; =3.1=
    (if (null pos)
    fail
    (let ((b2 (pat-match pat (subseq input pos)
    (match-variable var (subseq input 0 pos)
    bindings))))
    ;; If this match failed, try another longer one
    (if (eq b2 fail)
    (segment-match pattern input bindings (+ pos 1))
    b2)))))))
    ;; segment-match ver.3
    ;; 変更点のみ記載。
    ;; =3.1= position -> first-match-pos

    (defun first-match-pos (pat1 input start)
    "Find the first position that pat1 could possibly match input,
    starting at position start. If pat1 is non-constant, then just
    return start."
    (cond ((and (atom pat1) (not (variable-p pat1))) ; =1=
    (position pat1 input :start start :test #'equal))
    ((< start (length input)) start) ; =2=
    (t nil))) ; =3=
    ;; =1= : 以前のsegment-matchと同じ処理
    ;; =2= : =1=の条件が合致しない場合は何らかの変数的なものなので、startがinputより長くなってなければstartをそのまま返す。
    ;; =3= : startがinputより長いのでこれはposは無い。よってnil。

    (defun segment-match+ (pattern input bindings)
    "Match one or more elements of input."
    (segment-match pattern input bindings 1))

    (defun segment-match? (pattern input bindings)
    "Match zero or one element of input."
    (let ((var (second (first pattern)))
    (pat (rest pattern)))
    (or (pat-match (cons var pat) input bindings) ; =1=
    (pat-match pat input bindings)))) ; =2=
    ;; =1= : 1つマッチする場合の処理。??を外したvarを、残余なpatにconsしたpatternにてマッチするか。
    ;; =2= : 0個マッチする場合の処理。残余なpatをpatternにしててマッチするか。
    ;; =1=, =2= いずれも失敗したらnil。


    (defun match-if (pattern input bindings)
    "Test an arbitrary expression involving variables.
    The pattern looks like ((?if code) . rest)."
    (and (progv (mapcar #'car bindings) ; =1=
    (mapcar #'cdr bindings)
    (eval (second (first pattern))))
    (pat-match (rest pattern) input bindings))) ; =2=
    ;; =1= : おお! progvだ!
    ;; そうかprogvだとこういう形で変数と値の束縛構成もlisp formでできるんだ。そこがletとの大きな違いだったのか。
    ;; ここでprogvを使うのは、evalに束縛を効かせるためかな。
    ;; そしてそれがevalの結果、tかnilかと。
    ;; =2= : それがtなら(rest patterns)についてpat-matchする、と。

    #+test
    (pat-match '(?x ?op ?y is ?z (?if (eql (?op ?x ?y) ?z)))
    '(3 + 4 is 7)) ; => error
    ;; これは間違いじゃないか???

    #+test
    (pat-match '(?x ?op ?y is ?z (?if (eql (funcall ?op ?x ?y) ?z)))
    '(3 + 4 is 7))
    ;; 正しくはこうじゃないといけないのでは?
    ;; Norvigのerrataをみてみると、、、やはり!!
    ;; http://norvig.com/paip-errata.html

    #+test
    (pat-match '(?x ?op ?y (?if (funcall ?op ?x ?y)))
    '(3 > 4))

    (defun pat-match-abbrev (symbol expansion)
    "Define symbol as a macro standing for a pat-match pattern."
    (setf (get symbol 'expand-pat-match-abbrev)
    (expand-pat-match-abbrev expansion)))

    (defun expand-pat-match-abbrev (pat)
    "Expand out all pattern matching abbreviations in pat."
    (cond ((and (symbolp pat) (get pat 'expand-pat-match-abbrev)))
    ((atom pat) pat)
    (t (cons (expand-pat-match-abbrev (first pat))
    (expand-pat-match-abbrev (rest pat))))))

    #+test
    (pat-match-abbrev '?x* '(?* ?x)) ; => (?* ?X)

    #+test
    (pat-match-abbrev '?y* '(?* ?y)) ; => (?* ?Y)

    #+test
    (setf axyd (expand-pat-match-abbrev '(a ?x* ?y* d))) ; => (A (?* ?X) (?* ?Y) D)

    #+test
    (pat-match axyd '(a b c d)) ; => ((?Y B C) (?X))


今回はここまで。おもしろかった!
やっぱり流し読みよりも、ちゃんとやった方がおもしろい。
こつこつ。

2008年11月29日土曜日

【PAIP】6 Building Software Tools

今週はビジネススキルアップセミナーのようなものにごりごり出席しなければならなかった。これはこれでためになる。が!プログラミングの勉強は停滞した。でも総合力は前進できたと思うのでポジティブにとらえたい。さて、PAIP。

  • 6.1 An Interactive Interpreter Tool
  • REPL構造をツール化

  • 6.2 A Pattern-Matching Tool
  • Elizaのpat-matchをツール化
  • ツール化にあたってかなりの機能追加。こうなるとlistの正規表現マッチャという範囲をこえてるな。というのは、字面だけではなく、numberpだとかoddpだとか、objectとしての意味を問うているから。

  • ここはちょっと丁寧にやりたい気分。ソースとコメントでやる。ソースはPeter Norvigのもの、日本語のコメントは私のもの。
  • まずElizaのpat-matchを復習。

    (defun pat-match (pattern input)
    "Does pattern match input? Any variable can match anything."
    (if (variable-p pattern)
    t
    (if (or (atom pattern) (atom input))
    (eql pattern input)
    (and (pat-match (first pattern) (first input))
    (pat-match (rest pattern) (rest input))))))
    ;; pat-match ver.1
    ;; マッチしたかどうかをT/NILで返すだけ。
    ;; ツリー再帰的

    (defun variable-p (x)
    "Is x a variable (a symbol beginning with '?')?"
    (and (symbolp x) (equal (char (symbol-name x) 0) #\?)))

    #+test
    (pat-match '(I need a ?X) '(I need a vacation)) ; => T
    #+test
    (pat-match '(I need a ?X) '(I really need a vacation)) ; => NIL

    (sublis '((?X . vacation))
    '(what would it mean to you if you got a ?X ?))
    ; => (WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)

    ;; sublisは、パターンマッチとして得られた変数と値の
    ;; 組みをつかって別のリストを変換するのに使える。

    (defun pat-match (pattern input)
    "Does pattern match input? WARNING: buggy version."
    (if (variable-p pattern)
    (list (cons pattern input))
    (if (or (atom pattern) (atom input))
    (eql pattern input) ; =1=
    (append (pat-match (first pattern) (first input))
    (pat-match (rest pattern) (rest input))))))
    ;; pat-match ver.2 buggy version
    ;; '((?X . vacation))のような、マッチ結果のa-listを返すようにしようとしている。
    ;; しかし、
    #+test
    (pat-match '(I need a ?X) '(I need a vacation))
    ;; とするとエラーとなる。=1=のところTを返すだけで、それがappendの引数になるから。

    (defconstant fail nil "Indicates pat-match failure")

    (defconstant no-bindings '((t . t))
    "Indicates pat-match success, with no variables.")

    (defun get-binding (var bindings)
    "Find a (variable . value) pair in a binding list."
    (assoc var bindings))

    (defun binding-val (binding)
    "Get the value part of a single binding."
    (cdr binding))

    (defun lookup (var bindings)
    "Get the value part (for var) from a binding list."
    (binding-val (get-binding var bindings)))

    (defun extend-bindings (var val bindings)
    "Add a (var . value) pair to a binding list."
    (cons (cons var val) bindings))

    (defun pat-match (pattern input &optional (bindings no-bindings))
    "Match pattern against input in the context of the bindings"
    (cond ((eq bindings fail) fail) ; =1=
    ((variable-p pattern) ; =2=
    (match-variable pattern input bindings))
    ((eql pattern input) bindings) ; =3=
    ((and (consp pattern) (consp input)) ; =4=
    (pat-match (rest pattern) (rest input)
    (pat-match (first pattern) (first input)
    bindings)))
    (t fail))) ; =5=
    ;; pat-match ver.3
    ;; bindingsを返す。
    ;; bindingsは、マッチした場合は、変数と値のalist。マッチに失敗した場合はFAIL。マッチしたけど変数がないときはNO-BINDINGS。
    ;;
    ;; =1= : bindingsがfail(nil) -> とにかくfailを返す。fail確定。
    ;; =2= : variable -> match-variableへ
    ;; =3= : variableじゃなくて、eqlで等価なもの -> それはそれでよくて継続していく。
    ;; =4= : 以上にあてはまらなく両者ともconsp -> 再帰。ただしfirstをさきにやって、そのbindingsをrestで使う。
    ;; =5= : ここまできたらもうfail。


    (defun match-variable (var input bindings)
    "Does VAR match input? Uses (or updates) and returns bindings."
    (let ((binding (get-binding var bindings)))
    (cond ((not binding) (extend-bindings var input bindings))
    ((equal input (binding-val binding)) bindings)
    (t fail))))
    ;; pat-matchの副関数
    ;; manage-bindingsとかの名前の方がしっくりくるような?

    (defun extend-bindings (var val bindings)
    "Add a (var . value) pair to a binding list."
    (cons (cons var val)
    ;; Once we add a "real" binding,
    ;; we can get rid of the dummy no-bindings
    (if (eq bindings no-bindings)
    nil
    bindings)))

    #+test
    (pat-match '(i need a ?x) '(i need a vacation)) ; => ((?X . VACATION))

    #+test
    (sublis (pat-match '(i need a ?X) '(i need a vacation))
    '(what would it mean to you if you got a ?X ?))
    ; => (WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)

    #+test
    (pat-match '(i need a ?X) '(i really need a vacation)) ; => NIL

    #+test
    (pat-match '(this is easy) '(this is easy)) ; => ((T . T))

    #+test
    (pat-match '(?X is ?X) '((2 + 2) is 4)) ; => NIL

    #+test
    (pat-match '(?X is ?X) '((2 + 2) is (2 + 2))) ; => ((?X 2 + 2))

    #+test
    (pat-match '(?P need . ?X) '(i need a long vacation)) ; => ((?X A LONG VACATION) (?P . I))
    ;; これの動作分析。
    ;; pat-matchの=4=はfirst restなので、dotted-pairでももちろん動作する。
    ;; ただし、patternに関しては、それが最後の要素となる。
    ;; inputが同様のdotted-listなら、通常の動作と変わらない。
    ;; inputが通常のリストの場合、その要素のマッチ対象はリストになるのでその要素は変数じゃないとマッチしない。
    ;; 変数だった場合は、その変数の値はリストとなる。


    ;;; 5.3 Segment Pattern Matching

    (defun pat-match (pattern input &optional (bindings no-bindings))
    "Match pattern against input in the context of the bindings"
    (cond ((eq bindings fail) fail) ; =1=
    ((variable-p pattern) ; =2=
    (match-variable pattern input bindings))
    ((eql pattern input) bindings) ; =3=
    ((segment-pattern-p pattern) ; =6=
    (segment-match pattern input bindings))
    ((and (consp pattern) (consp input)) ;= 4=
    (pat-match (rest pattern) (rest input)
    (pat-match (first pattern) (first input)
    bindings)))
    (t fail))) ; =5=
    ;; pat-match ver.4
    ;; ?*を導入して0を含む任意個の要素の連続とマッチすることを可能とする。
    ;; =1= : 無変更。
    ;; =2= : 無変更。
    ;; =3= : 無変更。
    ;; =6= : 新設。patternがsegment-patternの場合 -> segment-matchへ
    ;; =4= : 無変更。
    ;; =5= : 無変更。

    #+test
    (pat-match '((?* ?p) need (?* ?x))
    '(Mr Hulot and I need a vacation)) ; => ((?P MR HULOT AND I) (?X A VACATION))

    #+test
    (pat-match '((?* ?p) need (?* ?x))
    '(need a vacation)) ; => ((?P) (?X A VACATION))

    #+test
    (pat-match '((?* ?x) is a (?* ?y)) '(what he is is a fool)) ; => ((?X WHAT HE IS) (?Y FOOL))

    #+test
    (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) ; => NIL
    ;; なぜこれがNILになるか。
    ;; pat-match :
    ;; まず第一のセグメントについて、=6=でsegment-matchに入る
    ;; segment-match :
    ;; ?x (1 2) でいけるか、となる。
    ;; そのとき、問題はsegment-matchの=5=によって、(pat-match pat (subseq input pos) bindings)となる。
    ;; すなわちpat (a b (?* ?x)) input (a b a b 1 2 a b)がマッチしますか?ということ。これはマッチする。
    ;; なので、=7=にいくが、しかしそのときの?Xのbindingsは(a b 1 2 a b)なので=7=がfailしておしまい。
    ;; 問題は=7=をどうするか、だ。


    (defun segment-match (pattern input bindings &optional (start 0))
    "Match the segment pattern ((?* var) . pat) against input."
    (let ((var (second (first pattern)))
    (pat (rest pattern)))
    (if (null pat)
    (match-variable var input bindings)
    ;; We assume that pat starts with a constant
    ;; In other words, a pattern can't have 2 consecutive vars
    (let ((pos (position (first pat) input
    :start start :test #'equal)))
    (if (null pos)
    fail
    (let ((b2 (pat-match pat (subseq input pos)
    (match-variable var (subseq input 0 pos)
    bindings)))) ; =8=
    ;; If this match failed, try another longer one
    (if (eq b2 fail)
    (segment-match pattern input bindings (+ pos 1)) ; =9=
    b2))))))) ; =10=
    ;; segment-match ver.2
    ;; 変更点のみ記載。
    ;; =8= : b2をしらべる際のbindingsに、varの現状のbinding案をいれてしまう。なので、先の例で=7=でunmatchしていたのはこの時点でfailする。
    ;; =9= : b2が失敗した場合。varのマッチ範囲を広げて再帰。
    ;; =10= : b2が成功した場合。これが答なので返すのみ。

    #+test
    (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) ; => ((?X 1 2 A B))

  • ここまではちゃんと理解できたと思う。

とりあえず一区切り。次は、6.2節を丁寧にやる。
こつこつ。

2008年11月25日火曜日

【PAIP】5 ELIZA: Dialog with a Machine (その2)

5.3 Segment Pattern Matchingから。

  • 5.3 Segment Pattern Matching
  • リストを処理していく関数というのは、なんというか、リストの要素を語とする有限オートマトンを処理していくみたいな感じなんだな。
  • で、condなどによる分岐は非決定性みたいだったり。
  • これでパターンマッチャーができた。リストの正規表現機構を自前でつくったような感じだな。

  • 5.4 The ELIZA Program: A Rule-Based Translator
  • パターンマッチ、という手法と、ルールベーストランスレータ、という手法。この章はこれらの説明につきる感じ。
  • これ、かっこいいなぁ。

    (defun use-eliza-rules (input)
    "Find some rule with which to transform the input."
    (some #'(lambda (rule)
    (let ((result (pat-match (rule-pattern rule) input)))
    (if (not (eq result fail))
    (sublis (switch-viewpoint result)
    (random-elt (rule-responses rule))))))
    *eliza-rule*))


おお、これで5章まで終わった。現在174P。めざせ200P越え。
次回は、Chapter 6 Building Software tools。

2008年11月24日月曜日

頭だけじゃなくて、体も鍛える

業務繁忙にてなかなかCLの勉強が進まない。時間管理を向上させていくのが大事とは思うが、そもそも、もっと体力をつけたほうがよいように思えてきた。そこで、この3連休を利用して、多少運動を始めてみた。いきなり筋肉痛だが、やはり体調がよくなるし、頭もよく動くように思う。

今週一週間、仕事しながらどういう風に運動を折り込めるかをちょこちょこ試してみようと思う。それでいい形があれば継続していきたい。

Time Machine 復活

Macの外付けストレージであまりいい思い出がない。

最近でいうと、Mac Proを購入したときに、Lacieの2TBを2台入れた。2台入れたのは信用してないからだ。ひとつは2ヶ月くらいで壊れた。もうひとつは、6ヶ月くらいで壊れた。。。

その後、バックアップを3ヶ月くらい取ってなくて、実は不安があった。本体がRAID5なので、まあそう簡単には破綻しないと思うのだがバックアップが無いというのはやはり。

で、しょうがなくWestern DigitalのMy Book Studio Edition II (2TB)を購入してきて、今Time Machineがバックアップ中。本当はこれ、RAID1で動かしたかったが、本体が700GBちょいあるので、Time Machineの履歴が薄くなるのが心配になり、RAID0で走らせることにした。後日もう一台追加すれば万全か。

バックアップがあるとやっぱり安心。

【PAIP】5 ELIZA: Dialog with a Machine

ELIZA。名前は聞いたことはあるが、自分でつくったことはなかった。歴史的一品を作ってみるのもまた一興。

  • Part I はパターンマッチングの多芸多才ぶりとその限界をしめすのも目的であるよ。
  • Eliza(イライザ)の名前はPygmalionから。 (Pygmalion:wikipedia)
  • 最初の開発者はMITのJoseph Weizenbaum。(1966)
  • ELIZAはRogerian 精神分析家をエミュレートしている。(Rogerian:wikipedia)

  • 5.1 Describing and Specifying ELIZA
  • 5.2 Pattern Matching
  • ふむ。パターンマッチには、変数という概念があり、変数を管理しようとすると、bindingsという概念が有効になる。symbolとa-listがあるので、CLではbindingsの実装が簡単、という道筋なのかな。

次回は、5.3 Segment Pattern Matchingから。こつこつ。

2008年11月23日日曜日

【PAIP】4 GPS: The General Problem Solver (その4)


  • 4.14 Blocks World Domain
  • 4.15 Stage 5 Repeated: Analysis of Version 2
  • 4.16 The Not Looking after You Don't Leap Problem
  • 4.17 The Lack of Descriptive Power Problem
  • 4.18 The Perfect Information Problem
  • 4.19 The Interacting Goals Problem
  • 4.20 The Ends of GPS
  • 4.21 History and References

4.14以降は、CLというよりGPS中心のお話。たくさん節があるが、それぞれ短いのでページ数としては少い。昨日まで仕事で多忙を極め、リハビリ的にゆるく写経した。GPSをもう一回自分なりに整理した方がいいかなぁ、と考えたが、まずは通読として、先へ進むことにする。

2008年11月19日水曜日

【PAIP】4 GPS: The General Problem Solver (その3)

うひ〜 仕事が忙しい!

  • 4.12 The New Domain Problem: Monkey and Bananas
  • これがAI?という気持もするが、たしかにmeans-ends analysisな問題を解いてるよなぁ、とも思う。

  • 4.13 The Maze Searching Domain
  • う、make-maze-opがエラーになる。調べてみると、GPS Ver.2の写経ミスだった。昨日の投稿を修正しなきゃ。

こつこつ。

2008年11月18日火曜日

【PAIP】4 GPS: The General Problem Solver (その2)

4.11 のVersion 2の写経まで終わっている。Version 2のポイントを自分なりにメモしながら理解する。
Norvig.orgをみると、コードのライツが定義してあって、条件さえまもれば改変公開が可能なようだ。なので、コードも載せちゃう。


;;;; お断り:日本語を含むコメントはakaがつけたものです。debugとundebugの名前をそれぞれmy-debugとmy-undebugに改変しました。


;;; GPS Version 2

(defvar *ops* nil "A list of available operators.")
;; Version 1 からそのまま
;; メモ:
;; 問題領域で使用できるoperatorのリスト。例は次のとおり。
;;(#S(OP :ACTION ASK-PHONE-NUMBER
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST ((EXECUTING ASK-PHONE-NUMBER) KNOW-PHONE-NUMBER)
;; :DEL-LIST NIL)
;; #S(OP :ACTION DRIVE-SON-TO-SCHOOL
;; :PRECONDS (SON-AT-HOME CAR-WORKS)
;; :ADD-LIST ((EXECUTING DRIVE-SON-TO-SCHOOL) SON-AT-SCHOOL)
;; :DEL-LIST (SON-AT-HOME))
;; #S(OP :ACTION SHOP-INSTALLS-BATTERY
;; :PRECONDS (CAR-NEEDS-BATTERY SHOP-KNOWS-PROBLEM SHOP-HAS-MONEY)
;; :ADD-LIST ((EXECUTING SHOP-INSTALLS-BATTERY) CAR-WORKS)
;; :DEL-LIST NIL)
;; #S(OP :ACTION TELL-SHOP-PROBLEM
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST ((EXECUTING TELL-SHOP-PROBLEM) SHOP-KNOWS-PROBLEM)
;; :DEL-LIST NIL)
;; #S(OP :ACTION TELEPHONE-SHOP :PRECONDS (KNOW-PHONE-NUMBER) :ADD-LIST ((EXECUTING TELEPHONE-SHOP) IN-COMMUNICATION-WITH-SHOP) :DEL-LIST NIL)
;; #S(OP :ACTION LOOK-UP-NUMBER :PRECONDS (HAVE-PHONE-BOOK) :ADD-LIST ((EXECUTING LOOK-UP-NUMBER) KNOW-PHONE-NUMBER) :DEL-LIST NIL)
;; #S(OP :ACTION GIVE-SHOP-MONEY :PRECONDS (HAVE-MONEY) :ADD-LIST ((EXECUTING GIVE-SHOP-MONEY) SHOP-HAS-MONEY) :DEL-LIST (HAVE-MONEY)))

;; (defvar *state* nil "The current state: a list of conditions.")
;; Version 2では廃止。
;; stateはspecial variableではなくlexical variableとして関数の引数で渡されていく。


(defstruct op "An operation"
(action nil)
(preconds nil)
(add-list nil)
(del-list nil))
;; Version 1 からそのまま
;; ただし、Version 1では単にmake-opしたのがstructure opだったが、
;; Version 2ではconvert-opされたものがstructure opである。
;; 例は
;; #S(OP :ACTION DRIVE-SON-TO-SCHOOL
;; :PRECONDS (SON-AT-HOME CAR-WORKS)
;; :ADD-LIST ((EXECUTING DRIVE-SON-TO-SCHOOL) SON-AT-SCHOOL)
;; :DEL-LIST (SON-AT-HOME))

(defun executing-p (x)
"Is x of the form: (executing ...) ?"
(starts-with x 'executing))
;; Version 2 で新設

(defun starts-with (list x)
"Is this a list whose first element is x?"
(and (consp list) (eql (first list))))
;; Version 2 で新設

(defun convert-op (op)
"Make op conform to the (EXECUTING op) convention."
(unless (some #'executing-p (op-add-list op))
(push (list 'executing (op-action op)) (op-add-list op)))
op)
;; Version 2 で新設
;; convert-op理解のためのメモ
;; someの値はt or nil。(some #'oddp '(1 2)) => T, (some #'oddp '(2 4)) => NIL
;; executing-pのものがひとつもなければ、opに副作用してopを返す。
;; ひとつもなければ、という条件があるので、convert-opを複数回実行しても大丈夫。
;; (op-add-list op)はもともとは、'(KNOW-PHONE-NUMBER)とか。
;; この関数によって、それが'((EXECUTING ASK-PHONE-NUMBER) KNOW-PHONE-NUMBER)となる。
;; #S(OP :ACTION ASK-PHONE-NUMBER
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST (KNOW-PHONE-NUMBER)
;; :DEL-LIST NIL)
;; #S(OP :ACTION ASK-PHONE-NUMBER
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST ((EXECUTING ASK-PHONE-NUMBER) KNOW-PHONE-NUMBER)
;; :DEL-LIST NIL)
;; という変換ということ。


(defun op (action &key preconds add-list del-list)
"Make a new operator that obeys the (EXECUTION op) convention."
(convert-op
(make-op :action action :preconds preconds
:add-list add-list :del-list del-list)))
;; Version 2 で新設
;; structure op の生成関数

(defun GPS (state goals &optional (*ops* *ops*))
"General Problem Solover: from state, achieve goals using *ops*."
(remove-if #'atom (achive-all (cons '(start) state) goals nil)))
;; Version 2で変更
;; special variables版。こちらの方が簡明。
;; goal-stack: ここでnilとして開始する。

(defun GPS (state goals &optional (ops *ops*))
"General Problem Solover: from state, achieve goals using *ops*."
(let ((old-ops *ops*))
(setf *ops* ops)
(let ((result (remove-if #'atom
(achive-all (cons '(start) state) goals nil))))
(setf *ops* old-ops)
result)))
;; Version 2で変更
;; special variablesを使わずに同様の効果を自分で作った版。
;; goal-stack: ここでnilとして開始する。
;; '(start)をconsしているのはstateがnilで入った場合の防御。

(defun apply-op (state goal op goal-stack)
"Return a new, transformed state if op is applicable."
(dbg-indent :gps (length goal-stack) "Consider: ~a" (op-action op))
(let ((state2 (achive-all state (op-preconds op)
(cons goal goal-stack)))) ; =1=
(unless (null state2)
;; Return an updated state
(dbg-indent :gps (length goal-stack) "Action: ~a" (op-action op))
(append (remove-if #'(lambda (x)
(member-equal x (op-del-list op)))
state2)
(op-add-list op)))))
;; Version 2で変更
;; state goal goal-stack がgivenな状態で、指定されたopを適用する。
;; このopはこのひとつのgoalを満たす(add-listにふくむ)ものであることをこの関数は想定している。
;; 適用不可能であれば、NILを返し、適用可能であれば適用後のstateを返す。
;; 動作:
;; state2について
;; そのopのprecondsをgoalとして、achive-allしたもの。
;; ここでachive-allはachiveを呼び、achiveはapply-opを呼ぶので再帰になっている。
;; state2がNILならおしまい。
;; NILじゃなければ、そのときgoalをgoal-stackにいれてよい。なので、=1=のconsがある。
;;
;; unless内部について
;; remove-ifでopのdel-listに含まれるconditionsをstate2から削除。
;; 前行のものとopのadd-listに含まれるconditionsをappendしたものが新しいstate。


(defun appropriate-p (goal op)
"An op is appropriate to a goal if it is in its add list."
(member-equal goal (op-add-list op)))
;; Version 2で変更

(defun achive-all (state goals goal-stack)
"Achive each goal, and make sure they still hold at the end."
(let ((current-state state))
(if (and (every #'(lambda (g)
(setf current-state
(achive current-state g goal-stack)))
goals)
(subsetp goals current-state :test #'equal))
current-state)))
;; Version 2 で新設
;; current-stateまたはNILを返す。
;; goal-stack: ここではachiveに渡すだけ。
;; 動作:
;; stateを局所current-stateにする理由がわからない。
;; goalsに含まれるgoalを順番にachiveにかける。achiveが返す


(defun achive (state goal goal-stack)
"A goal is achived if it already holds,
or if there is an appropriate op for it that is applicable."
(dbg-indent :gps (length goal-stack) "Goal:~a" goal)
(cond ((member-equal goal state) state) ; =1=
((member-equal goal goal-stack) nil) ;=2=
(t (some #'(lambda (op) (apply-op state goal op goal-stack)) ; =3=
(find-all goal *ops* :test #'appropriate-p)))))
;; Version 2で変更
;; 動作:
;; =1=: goalがすでにstateにあるなら、何もしなくてよい。stateを返す。
;; =2=: goalがすでにgoal-stackにあるなら、ループしている。NILを返す(終了)。
;; =3=:
;; goalを含むopをfind-allでlistにする。
;; そのlistの要素にlambdaを適用する。
;; このlambdaの中身は、apply-opなので、そのgoalを達成できる場合、新しいstatusを返す。そうでなければnilを返す。
;; someなので、goalを達成できるopがあればT、なければNILをachiveの値として返す。

(defun member-equal (item list)
(member item list :test #'equal))
;; Version 2 で新設

(defun use (oplist)
"Use oplist as the default list of operators."
;; Return something useful, but not too verbose:
;; the number fo operators.
(length (setf *ops* oplist)))
;; Version 2 で新設



;;; Test

;; ops作成
(defparameter *school-ops*
(list
(make-op :action 'drive-son-to-school
:preconds '(son-at-home car-works)
:add-list '(son-at-school)
:del-list '(son-at-home))
(make-op :action 'shop-installs-battery
:preconds '(car-needs-battery shop-knows-problem shop-has-money)
:add-list '(car-works))
(make-op :action 'tell-shop-problem
:preconds '(in-communication-with-shop)
:add-list '(shop-knows-problem))
(make-op :action 'telephone-shop
:preconds '(know-phone-number)
:add-list '(in-communication-with-shop))
(make-op :action 'look-up-number
:preconds '(have-phone-book)
:add-list '(know-phone-number))
(make-op :action 'give-shop-money
:preconds '(have-money)
:add-list '(shop-has-money)
:del-list '(have-money))))

;; 既存のデータをVersion 2用に変換
(mapc #'convert-op *school-ops*)

;; 関数opも使ってみる。
(push (op 'ask-phone-number
:preconds '(in-communication-with-shop)
:add-list '(know-phone-number))
*school-ops*)

(use *school-ops*)
*ops*

(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school))
;;->
;;((START) (EXECUTING LOOK-UP-NUMBER) (EXECUTING TELEPHONE-SHOP) (EXECUTING TELL-SHOP-PROBLEM) (EXECUTING GIVE-SHOP-MONEY)
;; (EXECUTING SHOP-INSTALLS-BATTERY) (EXECUTING DRIVE-SON-TO-SCHOOL))

(my-debug :gps)

(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school))
;;->
;;Goal:SON-AT-SCHOOL
;;Consider: DRIVE-SON-TO-SCHOOL
;; Goal:SON-AT-HOME
;; Goal:CAR-WORKS
;; Consider: SHOP-INSTALLS-BATTERY
;; Goal:CAR-NEEDS-BATTERY
;; Goal:SHOP-KNOWS-PROBLEM
;; Consider: TELL-SHOP-PROBLEM
;; Goal:IN-COMMUNICATION-WITH-SHOP
;; Consider: TELEPHONE-SHOP
;; Goal:KNOW-PHONE-NUMBER
;; Consider: ASK-PHONE-NUMBER
;; Goal:IN-COMMUNICATION-WITH-SHOP
;; Consider: LOOK-UP-NUMBER
;; Goal:HAVE-PHONE-BOOK
;; Action: LOOK-UP-NUMBER
;; Action: TELEPHONE-SHOP
;; Action: TELL-SHOP-PROBLEM
;; Goal:SHOP-HAS-MONEY
;; Consider: GIVE-SHOP-MONEY
;; Goal:HAVE-MONEY
;; Action: GIVE-SHOP-MONEY
;; Action: SHOP-INSTALLS-BATTERY
;;Action: DRIVE-SON-TO-SCHOOL
;;((START) (EXECUTING LOOK-UP-NUMBER) (EXECUTING TELEPHONE-SHOP) (EXECUTING TELL-SHOP-PROBLEM) (EXECUTING GIVE-SHOP-MONEY)
;; (EXECUTING SHOP-INSTALLS-BATTERY) (EXECUTING DRIVE-SON-TO-SCHOOL))

(my-undebug)

(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(have-money son-at-school))
;;-> NIL

(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school have-money))
;; -> NIL

(gps '(son-at-home car-needs-battery have-money)
'(son-at-school))
;; -> NIL

(gps '(son-at-home) '(son-at-home))
;; -> ((START))


うーむ。まだもやもやしているな。とりあえずこの後の展開はGPSをいろいろな問題に適用していくようなので、もやもやを抱えたまま進んでみる。
こつこつ。

2008年11月17日月曜日

【PAIP】4 GPS: The General Problem Solver

4章の趣旨は、

"Chapter 4 presents the reconstruction of GPS, the General Problem Solver. The Implementation follows the STRIPS approach."

とのこと。ざっとみてみると、AIプロジェクトの進め方の例となっているみたい。そういう意味で、後続の章の基礎となりそうだから、丁寧にやろう。


  • IPL (wikipedia)

  • AIプログラミングの5ステップ(境界は流動的)

    • Describe
    • Specify
    • Implement
    • Test
    • Debug and analyze

  • ふむ。今でいうと、プロセス構成としては平凡かな。いや、TestのいくつかはSpecifyの際に書いとくというのが、最近か。

  • 4.1 Stage 1: Description
  • means-ends analysis (wikipedia)。

  • 4.2 Stage 2: Specification
  • 特になし。

  • 4.3 Stage 3: Implementation
  • アルゴリズムが集合論とマッチしているときは、CLでもListをSetとして扱ってそのまま実装しちゃうのがいい感じ。
  • シンボルのハイフンネーミングはよくない。son-at-homeは(son at home)のほうがよい。なぜかというと、語彙が増えたとき、ハイフンネーミングだとシンボル数が無用に増えるから。なるほど。

  • 4.4 Stage 4: Test
  • 特になし。

  • 4.5 Stage 5: Analysis, or "We Lied about the G"
  • 昔ながらのプログラミングは、仕様を満たすというのが目的だが、AIプログラミングは、新しい問題領域を開拓することが目的なこともある。なので仕様は曖昧であり、バグの概念も曖昧である。
  • AIプログラミングはそもそもアジャイル、ということか。
  • ここからの節はStage 5。

  • 4.6 The Running Around the Block Problem
  • "driving from home to school"というオペレータは表現が簡単。ここで簡単、というのはprecondsやadd-listやdel-listを構成できるということ。
  • では、"running around the block"というようなのはどうだろう。これはdrivingと同じようには表現できない。drivingのときは、どこに居る、とかをprecondsとかにできたがrunningはできない。そうするとそれを表現するために"got some exercise"とかを考えなければいけない。
  • この問題は後程扱う。

  • 4.7 The Clobbered Sibling Goal Problem
  • 「身内のgoalを使っちゃう」問題。
  • 先程作ったGPSでは、goalが複数あるときにうまく機能しないことがある。goalsについて検査を進めていくときに、pass済みのgoal条件であるシンボルを、後続のgoalの実現のために消費してしまうケースがあるということ。
  • この問題の発見者?はGerald Sussman。SICPの人だな。いろいろ繋っているなぁ。
  • achieve-allで解決できる。

  • 4.8 The Leaping before You Look Problem
  • 「見るまえに飛べ」問題。
  • 複数goalがある場合。例えば一つ目のgoalは達成できるが、二つ目はnilの場合。今のGPSのつくりだと、一つ目を達成する行動をしてしまって、二つ目を調べたところでnilとなる。
  • 目的全体が達成できないならば、行動しない方がよい。計画してから行動する、というように変更しなければならない。

  • 4.9 The Recursive Subgoal Problem
  • 「どうどうめぐり」問題。
  • subgoalsの組み合わせによっては無限ループが発生しうる。
  • GPSにはループ検知機構が必要。

  • 4.10 The Lack of Intermediate Information Problem
  • nilになった場合の過程がわからない。デバッグ出力が無いのがよろしくない、という問題。
  • dbgという関数をつくり、出力先として*debug-io*を使う。

  • 4.11 GPS Version 2: A More General Problem Solver
  • (mapc #'convert-op *school-ops*) でデータを一発で書き換えるという進め方、すごい。こういうことができるように使い熟していかねば。
  • とりあえず、Version 2の写経まで。

シプサを途中までやってあるので、なんとか、GPSを計算理論上の文脈で捉えつつ読み進めることができている。
こつこつ。