Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-03-31


ArcでL-99 (P50 ハフマン符号化)

| 20:35 | ArcでL-99 (P50 ハフマン符号化) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P50 ハフマン符号化) - わだばLisperになる

算術と符号化篇の最後である、今回のお題は、ハフマン符号化です。

出現頻度の高いものには、より短い符号を与えることにより圧縮を実現する符号化のようで、LHAや、JPEG等の圧縮で用いられているそうです。

(huffman-table '(a b c d e f g g g g g e))
;=> ((g "1") (f "011") (c "0101") (d "0100") (a "0011") (b "0010") (e "000"))

;; ----
(def freq (lst)
  (let h (table)
    (each item lst 
      (if (h item)
          (++ (h item))
          (= (h item) 1)))
    (tablist h)))

;(freq '(a b c d e f g g g g g e))
;=> ((a 1) (d 1) (b 1) (e 2) (c 1) (f 1) (g 5))

(def huffman-tree (lst)
  ((afn (lst)
     (if single.lst caar.lst
         'else
         (let ((ai an) (bi bn) . rest) (sort (fn ((_ a) (_ b)) (< a b)) 
                                             lst)
           (self `(((,ai ,bi) ,(+ an bn))
                   ,@rest)))))
   freq.lst))

;(huffman-tree '(a b c d e f g g g g g e))
;=> (g ((f (b c)) ((a d) e)))

;;動作状況
;-> ((a d) 2), (b 1), (c 1), (f 1), (e 2), (g 5)
;-> ((b c) 2), (f 1), ((a d) 2), (e 2), (g 5)
;-> ((f (b c)) 3), ((a d) 2), (e 2), (g 5)
;-> (((a d) e) 4), ((f (b c)) 3), (g 5)
;-> (((f (b c)) ((a d) e)) 7), (g 5)
;-> ((g ((f (b c)) ((a d) e))) 12)
;=> (g ((f (b c)) ((a d) e)))

(def huffman-code-tree (lst)
  ((afn (tree (o code ""))
     (if (no alist.tree) `(,tree ,code)
         no.tree ()
         'else
         `(,(self car.tree (+ code "1"))
           ,(self cadr.tree (+ code "0")))))
   (huffman-tree lst)))

;(huffman-code-tree '(a b c d e f g g g g g e))
;=> ((g "1") (((f "011") ((c "0101") (d "0100"))) (((a "0011") (b "0010")) (e "000"))))

(def huffman-table (lst)
  (pair:flat:huffman-code-tree lst))
  • 符号化と復号化を試してみる。

"% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs"

という75文字の文字列の場合、下記のenhuffmanでは、326ビットになります。

元の文字列が1文字あたり6ビット(64種類の文字が可能)だとすると、450ビットなので、元より100ビット位圧縮されている、という解釈で良いんでしょうか?(´▽`*)…。

(withs (lst (coerce "% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs" 'cons)
        tab (huffman-table lst))
  (let code (enhuffman lst tab)
    (prn "\nencode:\n" (string lst) " => " code)
    (prn "\ndecode:\n" code " => " (string (dehuffman code tab)))
    nil))
;==>>
;encode:
;% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs => 10001000000111010010010001001110110100110101011011000101101100010000101101010000101000101111000010000101000101101010100011000011111100001000010010010001001110110100110000100111001010001111100011001101100000111111100000101001001101000110000111111000001001101111101110010011110011010011101001000110011011000001111111000011000101
;
;decode:
;10001000000111010010010001001110110100110101011011000101101100010000101101010000101000101111000010000101000101101010100011000011111100001000010010010001001110110100110000100111001010001111100011001101100000111111100000101001001101000110000111111000001001101111101110010011110011010011101001000110011011000001111111000011000101 => % huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs
;nil

; ----
(def exch-key/val (lst)
  (map (fn ((a b)) (list b a))
       lst))

;(exch-key/val (huffman-table '(a b c d e f g g g g g e)))
;=> (("1" g) ("011" f) ("0101" c) ("0100" d) ("0011" a) ("0010" b) ("000" e))

(def enhuffman (lst tab)
  (let h (listtab tab)
    (apply + (map [h _] lst))))

;(let lst '(a b c d e f g g g g g e)
;  (let tab (huffman-table lst)
;    (enhuffman lst tab)))
;=> "001100100101010000001111111000"

(def dehuffman (code tab)
  (with (h (listtab (exch-key/val tab)) res () cur "")
    (each c code
      (zap + cur (string c))
      (awhen (h cur)
        (push it res)
        (= cur "")))
    rev.res))

;(let lst '(a b c d e f g g g g g e)
;  (let tab (huffman-table lst)
;    (let code "001100100101010000001111111000"
;      (dehuffman code tab))))
;=> (a d b c e f g g g g g e)

発作性Hackathon / arc-compatを作りたい (11)

| 01:00 | 発作性Hackathon / arc-compatを作りたい (11) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (11) - わだばLisperになる

ぼけーっとリスト関係の関数をちまちま作成していたら、24時を過ぎてしまいました。

全然進んでないけど、一応、ASDFで読めるとこまで纏めて終了!

12時間で約70個の関数マクロを定義しただけでした(´▽`*)…。

数が多いので、これはコツコツ作って行くのがよろしいタイプのものかもしれません。

別に一人でちまちま書いて12時間というのは普通だと思いますが、一人Hackathonと宣言して実行してみると感じるこの孤独感と疎外感。

人間とは不思議なものです…。

2008-03-30


発作性Hackathon / arc-compatを作りたい (10)

| 23:18 | 発作性Hackathon / arc-compatを作りたい (10) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (10) - わだばLisperになる

完全にバテて来た。リスト関係の関数をちまちま作成。

最初にリスト関係を完成させれば良かった…ような気がする…。

発作性Hackathon / arc-compatを作りたい (9)

| 21:15 | 発作性Hackathon / arc-compatを作りたい (9) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (9) - わだばLisperになる

リスト関係の関数に着手。

ぼーっとし過ぎてきたので、食事をすることにした。

発作性Hackathon / arc-compatを作りたい (8)

| 20:44 | 発作性Hackathon / arc-compatを作りたい (8) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (8) - わだばLisperになる

繰り返し構文途中まで完了。

ASDFで今迄作成した分が読み込めることを確認。

段々ぼーっとしてきた。

発作性Hackathon / arc-compatを作りたい (7)

| 18:22 | 発作性Hackathon / arc-compatを作りたい (7) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (7) - わだばLisperになる

基本的な変数束縛のところが完了。

さすがに、12時間で完了というのは甘かった様子。

発作性Hackathon / arc-compatを作りたい (6)

| 16:59 | 発作性Hackathon / arc-compatを作りたい (6) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (6) - わだばLisperになる

全然進まない…。代入構文やっつけで終了。全然駄目な気がする。やっぱり移植とはいえ色々難しいもんなんだなあ。

疲れてきた。

発作性Hackathon / arc-compatを作りたい (5)

| 15:28 | 発作性Hackathon / arc-compatを作りたい (5) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (5) - わだばLisperになる

とりあえず、構造化代入問題は置いておいて、アナフォリック系一端完了。

aifをArc版ifにするかどうかも保留。

途中、トイレでトイレットペーパーが無いというHackathonには全然関係の無いトラブルに遭遇。

発作性Hackathon / arc-compatを作りたい (4)

| 14:55 | 発作性Hackathon / arc-compatを作りたい (4) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (4) - わだばLisperになる

全然進まない(笑)

Arcでは、全面的に変数の束縛等は、構造化代入(束縛?)可能なのですが、それをどうしたら良いかで躓いております。

一人のHackathonで、更に実況中継を自分でするということは、更に孤独感を演出するということがなんとなく分かってまいりました。

発作性Hackathon / arc-compatを作りたい (3)

| 13:26 | 発作性Hackathon / arc-compatを作りたい (3) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (3) - わだばLisperになる

参考にする資料としては、

が詳細な解説があるので非常に参考になる。

それと、Arcの元ネタとしては、On Lispや、ANSI Common Lisp等の書籍の中に沢山書いてあるので、それを移植(というか纏めるだけ)

あとは、上記2つから漏れたものも公開されているので、それも参照する。

Google Codeにアップしてみた。

マクロ部門終了。

全然進まないなあ(笑)

発作性Hackathon / arc-compatを作りたい (2)

| 12:18 | 発作性Hackathon / arc-compatを作りたい (2) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (2) - わだばLisperになる

何をしたら良いか良く分からないが、とりあえず、ASDFインストールできるようにasdファイルを作成。

パッケージ名は、nicknameとしてarc

発作性Hackathon / arc-compatを作りたい (1)

| 11:57 | 発作性Hackathon / arc-compatを作りたい (1) - わだばLisperになる を含むブックマーク はてなブックマーク - 発作性Hackathon / arc-compatを作りたい (1) - わだばLisperになる

最近Hackathonという言葉を良く聞きますが、みんなで集ってわいわいがやがやとコーディングするというのは、非常に楽しそうです。

自分も参加してみたいなあと思うのですが、なかなか自分が参加できそうなものがありません。

でも、参加してみたい。ということで、のび太メソッド(会社に雇ってもらえないため自分で会社を起こす)で、一人でわいわいがやがやHackathonしてみることにしました。

12時開始で、24時終了です。

お題は、Common LispにArc互換のパッケージ、arc-compatを作るというものです。

もともと、Arcは、Paul Graham氏のお手製マクロの集合体のようなものなので、元ネタはCommon Lispで書かれていて、それを集めてちょっと修正すれば完成するんじゃないかなあと、比較的簡単に考えています。

ということで、ノープランで開始!!

このブログで一人で実況中継して行きますが、半ばスパムのようなことになるやもしれず、RSSリーダーで読んで頂いている方には申し訳ないことになるやもしれません。

2008-03-29

ArcでL-99 (P49 グレイ・コード)

| 13:19 | ArcでL-99 (P49 グレイ・コード) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P49 グレイ・コード) - わだばLisperになる

グレイ・コードとは、一度に1ビットしか変化しないような二進符号のことだそうです。

去年Common Lispで解答を作成したときには、2進数を右シフトしてXORを取るという方法で解答しましたが、メモ化してみるという課題もあるので、今回は再帰で。

メモ化で効率はどう変化するかということですが、Arcには、defmemoというメモ化してくれるマクロがあるので安直にそれを利用。

キャッシュが効くと速くなります。

(gray 4)
;=> ("0000" "0001" "0011" "0010" "0110" "0111" "0101" "0100"
     "1100" "1101" "1111" "1110" "1010" "1011" "1001" "1000")

(def gray (n)
  (if (is 1 n)
      '("0" "1")
      (let g (gray (- n 1))
        (+ (map [+ "0" _] g)
           (map [+ "1" _] rev.g)))))

;; メモ化版
(defmemo graym (n)
  (if (is 1 n)
      '("0" "1")
      (let g (graym (- n 1))
        (+ (map [+ "0" _] g)
           (map [+ "1" _] rev.g)))))
(graym 12)(gray 12)
1time: 159 msec.time: 265 msec.
2time: 0 msec. time: 327 msec.
3time: 0 msec.time: 206 msec.

2008-03-28

名前付き〜

| 19:56 | 名前付き〜 - わだばLisperになる を含むブックマーク はてなブックマーク - 名前付き〜 - わだばLisperになる

BLTで思い出したけれども、以前ブロック構造についてのエントリを書いた後で(LET、LAMBDA、PROGN色々 - わだばLisperになる - cadr group)、色々な名前付きスペシャルフォームが、単一のblockスペシャルフォームに纏められた、という流れがあったことが分かった。(後期MacLISPのメーリングリストの内容やLispマシンのマニュアルから)

きっとそのうち忘れ去るので、メモ。

具体的な流れとしては、

;; 名前付きスペシャルフォーム
(prog george ((i 0) (j 0))
 ...
 (return-from george))

(do-named george ((i 0) (j 0))
  ((< 10 i)))
 ...
  (return-from george))
  1. ネストしたprogや、do等で任意のところへ脱出するため、progや、doが名前を付けられるように改良された。併せて、return-from登場。(1979年とかその辺)
  2. 名前付きフォームが乱立しはじめる。
  3. そこでblock導入(Common Lisp登場と同時期)(1983年とかその辺)
  4. 名前付きスペシャルフォーム滅びる

全然関係ないけれど、Lispマシンのマニュアル等ではブロックの名前として何故かgeorgeが多い。

Common Lispの基本ブロック

| 19:21 | Common Lispの基本ブロック - わだばLisperになる を含むブックマーク はてなブックマーク - Common Lispの基本ブロック - わだばLisperになる

Common Lispの基本ブロック構造は、サンドイッチ風にBLTとゴロ合せで覚えるというのはどうだろう。

(block nil
  (let ()
    (tagbody
     ...)))

となるので。

どの処理系でも大抵、マクロの中身はこのBlock、Let、Tagbodyの順番にネストしている。

QiでL-99 (P18 リストの範囲切り出し)

| 12:02 | QiでL-99 (P18 リストの範囲切り出し) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P18 リストの範囲切り出し) - わだばLisperになる

なんだか、ごちゃごちゃしてしまった…。

(slice [a b c d e f g h i j k] 3 7)
\=>[c d e f g]
\

(define slice 
  List Start End -> [ ] where (> Start End)
  List Start End -> (slice* List [ ] 1 Start End))

(define slice* 
  [ ] Acc _ _ _ -> (reverse Acc)
  [H | T] Acc End Start End -> (slice* [ ] [H | Acc] End Start End)
  [H | T] Acc Pos Start End 
   -> (slice* T [H | Acc] (1+ Pos) Start End) where (<= Start Pos)
  [_ | T] Acc Pos Start End 
   -> (slice* T Acc (1+ Pos) Start End))

\ 前回定義したsplitを使用したもの \
(define slice 
  List Start End -> [ ] where (> Start End)
  List Start End -> (let S (1- Start)
		      (head (split (head (tail (split List S))) 
				   (- End S)))))

GOOでL-99 (P04 リストの長さ)

| 11:43 | GOOでL-99 (P04 リストの長さ) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P04 リストの長さ) - わだばLisperになる

lengthを書くというお題です。

折角の総称関数なので、flatクラス(ベクタのようなクラス)とリストで書いてみました。

defがちょっと面白くて、ブロックを抜けるまで有効な局所変数を宣言します。

今のArcには実装されていませんが、当初Arcが=で実現しようとしていたものですね。

普通のletもあり、letは、defを使用したマクロになっています。

forは汎用のコレクションを取れる繰り返し用のマクロです。

(my-len '(1 2 3 4))
(my-len #(1 2 3 4))
(my-len "1234")
;=> 4

(dm my-len (u|<lst>)
  (if (nul? u)
      0
      (+ 1 (my-len (tail u)))))

(dm my-len (u|<flat>)
  (def cnt 0)
  (for ((x u)) 
      (incf cnt))
  cnt)

;(len '(1 2 3 4))
;;=> 4

2008-03-27


GOOでL-99 (P03 リストのK番目の要素を取り出す)

| 17:08 | GOOでL-99 (P03 リストのK番目の要素を取り出す) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P03 リストのK番目の要素を取り出す) - わだばLisperになる

GOOはLISP1なのですが、LISP1では、変数名に、関数名と同じものを使うと関数がシャドウされてしまうので、なんだか気持ち悪かったり不便だったりします。

GOOでは、通常のLISPでいうlistは、lstで、エイリアスとして、listも使える、という感じなので、listもlstも変数名として使うには気持ち悪いので、uを使うことにしてみました。

uは、LISP 1.5の時代には、リスト用の変数名としてメジャーだったようです。その流れなのか、スタンフォード大学では、Uや、Vなどが好んで使われていました。

repは、Schemeでいう名前付きletです。

;(element-at '(a b c d e) 3)
;=> c

(dm element-at ((u <lst>) (k <int>))
  (rep loop ((u u) (cnt 1))
    (if (or (= k cnt) (nul? u))
        (head u)
        (loop (tail u) (1+ cnt)))))

;(elt '(a b c d e) 2)
;=> c

妙なダグ名

| 16:38 | 妙なダグ名 - わだばLisperになる を含むブックマーク はてなブックマーク - 妙なダグ名 - わだばLisperになる

Common Lispのような伝統的なLispには、GOTOがある。

飛び先のタグ名には色々な個性があったりするが、一般的には、Lとか、L1とか、Aとか、againとかが多い。

人工知能では有名なSHRDLUはテリー・ウィノグラード氏によりMacLISPで書かれたが、ウィノグラード氏が変り者なのか、妙なタグ名が多いことを今日コードを眺めていて発見した。

(DEFPROP PRINTC
         (LAMBDA (L) (PROG (TEST) 
                           (TERPRI)
                      =>   (COND ((NULL L) (RETURN NIL)))
                           (SETQ TEST (EVAL (CAR L)))
                           (COND ((EQ TEST '<TAB>))
                                 (T (PRINC TEST) (PRINC '/ )))
                           (SETQ L (CDR L))
                           (GO =>)))
         FEXPR) 

さすがに、=>を使うという発想はなかった。

他には、GOが多い。恐らく(GO GO)と書きたかっただけなのではないだろうか。

CLOSでL-99 (P17 指定した位置でリストを分割)

| 15:15 | CLOSでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる

うーん、Qiと同じく、もっとすっきり書けそうな気がするんだけども…。

(split '(1 2 3 4 5 6 7) 3)
;=> ((1 2 3) (4 5 6 7))

(defgeneric split (lst n)
  (:documentation 
   "P17 (*) Split a list into two parts; the length of the first part is given.")
  (:method (lst n) (split1 lst () n)))

(defmethod split1 ((lst null) acc n)
  `(,(reverse acc) ,lst))

(defmethod split1 ((lst cons) acc n)
  (if (> 1 n)
      `(,(reverse acc) ,lst)
      (destructuring-bind (head &rest tail) lst
        (split1 tail (cons head acc) (1- n))))))

QiでL-99 (P17 指定した位置でリストを分割)

| 14:58 | QiでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる

もっと綺麗に書けそうなんだけれども…。

(split [a b c d e f g h i k] 3)
\=> [[a b c] [d e f g h i k]]
\

(define split 
  Lst N -> (split* Lst [ ] N))

(define split* 
  Lst Acc Cnt -> [(reverse Acc) | [Lst]] where (or (empty? Lst) (> 1 Cnt))
  [H | T] Acc Cnt -> (split* T [H | Acc] (1- Cnt)))

一時変数の名前

| 14:48 | 一時変数の名前 - わだばLisperになる を含むブックマーク はてなブックマーク - 一時変数の名前 - わだばLisperになる

変数の名付けにも文化的な側面はあり、例えば、UNIX文化では一時変数はtmpと名付けられることが多いと思う。

では、Lisp界ではどうだったかというと、MacLISPや、Lispマシンではtemという名前が多く、tmpは皆無。

2008-03-26

ArcでL-99 (P48 真偽値表 その3)

| 20:31 | ArcでL-99 (P48 真偽値表 その3) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P48 真偽値表 その3) - わだばLisperになる

Common Lispで作成したものを移植。

大したことはしていないのに、なんだか長〜くなりました。

(table/c (A B C)
  A *and (B *or C) *equ A *and B *or A *and C)
;=> nil, nil, nil => t
;   nil, nil, t => t
;   nil, t, nil => t
;   nil, t, t => t
;   t, nil, nil => t
;   t, nil, t => t
;   t, t, nil => t
;   t, t, t => t

(set *operator-precedence-list* '(*and *nand *or *nor *impl *equ *xor))

(mac table/c (args . expr)
  (let argl (len args)
    `(each ,args (make-truth-table ,argl)
       (prall (list ,@args))
       (pr " => " ,(to-prefix/c expr *operator-precedence-list*) "\n"))))

(def nth-truth (size num (o true t) (o false nil))
  ((afn (cnt acc)
     (if (is 0 cnt)
         rev.acc
         (let cnt (- cnt 1)
           (self cnt
                 (cons (if (odd:trunc (/ num (expt 2 cnt))) true false) 
                       acc)))))
   size () ))

(def make-truth-table (size (o true t) (o false nil))
  ((afn (cnt acc)
     (if (is cnt (expt 2 size))
         rev.acc
         (self (+ cnt 1) 
               (cons (nth-truth size cnt true false)
                     acc))))
   0 () ))

;; 前回定義のconjunct-not-exprが必要
(def to-prefix/c (expr precedence)
  ((afn (expr)
     (if atom.expr expr
         ;; 
         (and acons.expr (is 'no car.expr))
         (if (acons cadr.expr)
             `(no ,(self cadr.expr))
             expr)
         ;; 
         (atom car.expr)
         (let (a pred b) expr
           `(,pred ,a ,self.b))
         ;; 
         'else 
         (let (a pred b) expr
           `(,pred ,self.a ,self.b))))
   (car:set-operator-predence conjunct-not-expr.expr precedence)))

(def conjunct-infix-expr (pred expr)
  (if atom.expr expr
      ;; 
      (is pred cadr.expr)
      (let (a pred b . rest) expr
        `((,(conjunct-infix-expr pred a)
           ,pred
           ,(conjunct-infix-expr pred b))
          ,@(conjunct-infix-expr pred rest)))
      ;; 
      (atom car.expr)
      (cons car.expr (conjunct-infix-expr pred cdr.expr))
      ;; 
      (is 3 (len car.expr))
      (cons car.expr (conjunct-infix-expr pred cdr.expr))
      ;; 
      'else
      (cons (conjunct-infix-expr pred car.expr)
            (conjunct-infix-expr pred cdr.expr))))

(def set-operator-predence (expr precedence)
  ((afn (lst res)
     (if no.lst
         res
         (self cdr.lst (conjunct-infix-expr car.lst res))))
   precedence expr))
;    

Common LispでL-99 (P48 真偽値表 その3)

| 15:55 | Common LispでL-99 (P48 真偽値表 その3) - わだばLisperになる を含むブックマーク はてなブックマーク - Common LispでL-99 (P48 真偽値表 その3) - わだばLisperになる

P48もCommon Lispで挑戦していたときには中間記法での表現はスルーしていたので、再挑戦。

P47で引数を2つに決め打ちにしていましたが、元のPrologの解答を眺めると、どうやら、自分で作った演算子に自分で優先順位を設定させることが問題の本意のようです。(Prologでは設定する機能があるため)

このあたりは、L-99を眺めていてもちょっと分からないですね(;´Д`)

ということで、演算子の優先順位を設定できるようにして、かつ、任意の個数の変数を取れるように拡張しました。

優先順位は、not, (and, nand), (or, nor), (impl equ xor)の順のみたいです。

table/cは使われる変数を宣言して、各変数にtかnilのが束縛され、そのすべての組み合わせを繰り返す、という仕様しました。

あと一踏ん張りが足らない出来となりました…。

(table/c (a b c)
  A and/2 (B or/2 C) equ/2 A and/2 B or/2 A and/2 C)
;=> T, T, T => T
;   T, T, NIL => T
;   T, NIL, T => T
;   T, NIL, NIL => T
;   NIL, T, T => T
;   NIL, T, NIL => T
;   NIL, NIL, T => T
;   NIL, NIL, NIL => T

(defparameter *OPERATOR-PRECEDENCE-LIST*
  '(and/2 nand/2 or/2 nor/2 impl/2 equ/2 xor/2)
  "オペレータの優先順位リスト: 先頭になるほど優先順位が高い")

(defmacro TABLE/C ((&rest args) &body expr)
  (let ((g (gensym))
        (len (length args)))
    `(DOLIST (,g (make-truth-table ,len))
       (DESTRUCTURING-BIND ,args ,g
         (FORMAT T "~{~A~^, ~} => ~A~%" ,g 
                 ,(to-prefix/c expr *operator-precedence-list*))))))

(defun MAKE-TRUTH-TABLE (size &optional (true t) (false nil))
  (loop :for i :below (expt 2 size)
        :collect (mapcar (lambda (x) (if (char= #\1 x) true false))
                         (coerce (format nil "~V,'0,B" size i) 'list))))

(defun CONJUNCT-INFIX-EXPR (pred expr)
  (cond ((atom expr) expr)
        ((eq pred (cadr expr))
         (destructuring-bind (a pred b &rest rest) expr
           `((,(CONJUNCT-INFIX-EXPR pred a)
               ,pred
               ,(CONJUNCT-INFIX-EXPR pred b))
             ,@(CONJUNCT-INFIX-EXPR pred rest))))
        ((atom (car expr))
         (cons (car expr) (CONJUNCT-INFIX-EXPR pred (cdr expr))))
        ;; 不要な入れ子を防ぐ
        ((= 3 (length (car expr)))
         (cons (car expr)
               (CONJUNCT-INFIX-EXPR pred (cdr expr))))
        ('T (cons (CONJUNCT-INFIX-EXPR pred (car expr))
                  (CONJUNCT-INFIX-EXPR pred (cdr expr))))))

(defun SET-OPERATOR-PREDENCE (expr precedence)
  (reduce (lambda (res x) (conjunct-infix-expr x res))
          precedence 
          :initial-value expr))

;; P47で定義したCONJUNCT-NOT-EXPRが必要
(defun TO-PREFIX/C (expr precedence)
  (labels ((frob (expr)
             (cond ((atom expr) expr)
                   ((and (consp expr) (eq 'not (car expr))) 
                    (if (consp (cadr expr))
                        `(not ,(frob (cadr expr)))
                        expr))
                   ((atom (car expr))
                    (destructuring-bind (a pred b) expr
                      `(,pred ,a ,(frob b))))
                   ('T (destructuring-bind (a pred b) expr
                         `(,pred ,(frob a) ,(frob b)))))))
    ;; 謎のcar (要素が一つのリストが結果になるため)
    (frob (car (set-operator-predence (conjunct-not-expr expr) 
                                      precedence)))))

;(to-prefix/c '(A and/2 (B or/2 C) equ/2 A and/2 B or/2 A and/2 C) 
;             *operator-precedence-list*)
;=> (EQU/2 (AND/2 A (OR/2 B C)) (OR/2 (AND/2 A B) (AND/2 A C)))

2008-03-25

CLOSでL-99 (P16 周期Nで要素を間引く)

| 19:39 | CLOSでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる

まったくもってCLOSの勉強にはなっていないのですが、ややこしい総称関数の引数の書法くらいは覚えられるかも知れない(笑)

(drop '(a b c d e f g h i k) 3)
;=> (A B D E G H K)

(defgeneric DROP (lst n)
  (:documentation 
   "P17 (*) Split a list into two parts; the length of the first part is given.")
  (:method (lst n) (drop1 lst n n)))

(defmethod DROP1 ((lst null) n cnt)
  () )

(defmethod DROP1 ((lst cons) n (cnt (eql 1)))
  (DROP1 (cdr lst) n n))

(defmethod DROP1 ((lst cons) n cnt)
  (destructuring-bind (head . tail) lst
    (cons head (DROP1 tail n (1- cnt)))))

QiでL-99 (P16 周期Nで要素を間引く)

| 19:16 | QiでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる

いくらなんでも、L-99ばっかりやり過ぎな気がしてきた(笑)

\(drop [a b c d e f g h i k] 3)
\=> [a b d e g h k]

(define drop
  X N -> (drop* X N 1))

(define drop* 
  [ ] _ _ -> [ ]
  [H | T] N Cnt -> (drop* T N 1) where (= N Cnt)
  [H | T] N Cnt -> [H | (drop* T N (1+ Cnt))])

Common LispでL-99 (P47 真偽値表 その2)

| 18:40 | Common LispでL-99 (P47 真偽値表 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - Common LispでL-99 (P47 真偽値表 その2) - わだばLisperになる

Common Lispで挑戦していたときには、中間記法に直すのが面倒臭くて、解答を作ってなかったことに気付いたので、Common Lisp版も作成。

いまいちtableの引数の扱いが不明。この辺は、PrologとLispの違いという感じもしたり、しなかったり。

(table/b ((A t) (B nil))
  A and (A or not B))
;=> T : T => T
;   T : NIL => T
;   NIL : T => NIL
;   NIL : NIL => NIL

(defmacro TABLE/B ((a b) &body expr)
  `(LET (,a ,b)
     (DOLIST (X (PERM (LIST ,(car a) ,(car b))))
       (DESTRUCTURING-BIND (A B) x
         (FORMAT T "~A : ~A => ~A~%" a b ,(to-prefix expr))))))

(defun TO-PREFIX (expr)
  (labels ((frob (expr)
             (cond ((atom expr) expr)
                   ((and (consp expr) (eq 'not (car expr))) 
                    (if (consp (cadr expr))
                        `(not ,(frob (cadr expr)))
                        expr))
                   ((atom (car expr))
                    (destructuring-bind (a pred b) expr
                      `(,pred ,a ,(frob b))))
                   ('T (destructuring-bind (a pred b) expr
                         `(,pred ,(frob a) ,(frob b)))))))
    (frob (conjunct-not-expr expr))))

(defun CONJUNCT-NOT-EXPR (expr)
  (cond ((null expr) () )
        ((eq 'not (car expr))
         `((not ,(if (atom (cadr expr))
                     (cadr expr)
                     (CONJUNCT-NOT-EXPR (cadr expr))))
           ,@(CONJUNCT-NOT-EXPR (cddr expr))))
        ((atom (car expr))
         (cons (car expr) (CONJUNCT-NOT-EXPR (cdr expr))))
        ('T (cons (CONJUNCT-NOT-EXPR (car expr))
                  (CONJUNCT-NOT-EXPR (cdr expr))))))
;

Franz Lisp

| 17:55 | Franz Lisp - わだばLisperになる を含むブックマーク はてなブックマーク - Franz Lisp - わだばLisperになる

Franz Lispを試してみたくて、4.3BSDをSIMHで動かす。

4.3BSDは、ディスクイメージを配布しているところがあるので、それなりに簡単に動いたが、外部とのファイル交換の方法が良く分からない、ネットワーク接続も大義だし。

テープデバイスからtarのイメージを読み込めないか試してみたがフォーマットが違う様子。

ファイルが取り込めさえすれば、Franz Lispがmakeできると思うんだけれど…。

GOOでL-99 (P02 最後から2つのペアを返す)

| 17:49 | GOOでL-99 (P02 最後から2つのペアを返す) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P02 最後から2つのペアを返す) - わだばLisperになる

GOOはDylanに結構影響を受けているようで、オブジェクト指向なところは、Dylanっぽい様子。

Dylanっぽいということは、CLOSっぽいということでもありますが、GOOにも総称関数があり、どうやら積極的に使うようなので、基本的に総称関数を使うことにしてみました。

dm→define methodの略のようです。

<...>で型を表わすところがDylanっぽい。

(my-but-last '(1 2 3 4))
;=> (3 4)

(dm my-but-last ((u <lst>))
  (if (nul? (tail (tail u)))
      u
      (my-but-last (tail u))))
;

ArcでL-99 (P47 真偽値表 その2)

| 14:38 | ArcでL-99 (P47 真偽値表 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P47 真偽値表 その2) - わだばLisperになる

今回は、前回のものを一捻りして、与える式をより普通の数式に近い表現で与えられるようにするというお題です。

適当に、2引数であることを決め打ちにして、中間記法→前置記法変換を書いてみました。

conjunct-not-exprという表現が英語として正しいのかどうかは謎です…。

(let (A B) '(t nil)
  (table/b (A B)
   ;; 式
   A *and (A *or not B)))
;=> ====
;   t: t => t
;   t: nil => t
;   nil: t => nil
;   nil: nil => nil

(mac table/b ((a b) . expr)
  `(do (prn "\n====")
       (each (,a ,b) (perm (list ,a ,b))
         (prf "~ : ~  => ~ \n" ,a ,b ,(to-prefix expr)))))

(def to-prefix (expr)
  ((afn (expr)
     (if atom.expr expr
         ;; not X ...
         (and (acons expr) (is 'no car.expr)) 
         (if (acons cadr.expr)
             `(no ,(self cadr.expr))
             expr)
         ;; X ...
         (atom car.expr) 
         (let (a pred b) expr
           `(,pred ,a ,self.b))
         ;; (X ...) ...
         'else
         (let (a pred b) expr
           `(,pred ,self.a ,self.b))))
   (conjunct-not-expr expr)))

;; notを先に結合させるための関数
(def conjunct-not-expr (expr)
  (if no.expr ()
      ;; not X ...
      (is 'not car.expr) 
      `((no ,(if (atom cadr.expr)
                  cadr.expr
                  (conjunct-not-expr cadr.expr)))
        ,@(conjunct-not-expr cddr.expr))
      ;; X ...
      (atom car.expr)
      (cons car.expr (conjunct-not-expr cdr.expr))
      ;; (X ...) ...
      'else 
      (cons (conjunct-not-expr car.expr)
            (conjunct-not-expr cadr.expr))))

Arcのマクロ

| 14:11 | Arcのマクロ - わだばLisperになる を含むブックマーク はてなブックマーク - Arcのマクロ - わだばLisperになる

(mac foo (a b)
  `(prf "#,a #,b"))

で、

(foo x y)
;=> (prf "#x #y")

となることを期待してしまうが、残念ながら今のところ

(prf "#,a #,b")

となる。

便利なので、展開されると良いなと思ったり。

DESTRUCTURING-BIND

| 09:13 | DESTRUCTURING-BIND - わだばLisperになる を含むブックマーク はてなブックマーク - DESTRUCTURING-BIND - わだばLisperになる

CARとCDRの組み合わせの代わりにDESTRUCTURING-BINDを使用するメリットを一つ発見。

DESTRUCTURING-BINDだと、ラムダリストキーワードのお蔭で

(car ()) => NIL
(car '(())) => NIL

の違いを判定することができる。

(destructuring-bind (&optional (x () car-win) . y) ()
  (list x y car-win))
=> (NIL NIL NIL)

(let ((lst () ))
  (let ((x (car lst))
        (y (cdr lst)))
    (list x y)))
=> (NIL NIL)

2008-03-24


オブジェクト指向なストリーム

| 12:56 | オブジェクト指向なストリーム - わだばLisperになる を含むブックマーク はてなブックマーク - オブジェクト指向なストリーム - わだばLisperになる

黒田氏の過去のエッセイ?を読みかえしていて、CLに足りないものとして、「オブジェクト指向なストリーム」というのがあったので調べてみる。Gray Streamという奴らしい。名前だけは良く聞くけれど全然使ったことがない。

(defmethod sb-gray:stream-read-line ((stream sb-sys:fd-stream))
  (read-line stream nil :eof))

(defun eofp (input)
  (eq :eof input))

(with-open-file (in "/tmp/foo.txt")
  (loop :for line := (sb-gray:stream-read-line in) :until (eofp line)
        :do (write-line line)))

…いや、この例では全然、旨味が分からない(笑)

ここの例だと、ストリームに出力すると自動でタイムスタンプを付けてくれるというなんだか便利そうな例があるけれど…。

CLOSでL-99 (P15 各要素を任意の回数複製する)

| 12:21 | CLOSでL-99 (P15 各要素を任意の回数複製する) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P15 各要素を任意の回数複製する) - わだばLisperになる

car、cdrではなくて、destructuring-bindを積極的に使ってみる。

&optionalを上手く使えば、パターンの不整合によるエラーも回避できる様子。

今回の例では、destructuring-bindが()を受けることはないので、(&optional head ...)のようなエラー回避はしていません。

(repli '(a b c) 3)
;=> (A A A B B B C C C)

(defgeneric REPLI (lst n-times)
  (:documentation "P15 (**) Replicate the elements of a list a given number of times."))

(defmethod REPLI ((lst null) n-times)
  () )

(defmethod REPLI ((lst cons) n-times)
  (destructuring-bind (head &rest tail) lst
    `(,@(make-list n-times :initial-element head) ,@(REPLI tail n-times))))

QiでL-99 (P15 各要素を任意の回数複製する)

| 12:02 | QiでL-99 (P15 各要素を任意の回数複製する) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P15 各要素を任意の回数複製する) - わだばLisperになる

carとcdrとifの条件分岐で書くより、Qiみたいな書法の方がすっきりして良いと思い始めました。CLでQi風に書けるマクロとか書いてみようかな。

(repli [a b c] 3)
\=> [a a a b b b c c c]
\

(define repli 
  [ ] _ -> [ ]
  [H | T] N -> (append (n-of N H) (repli T N)))

(define n-of 
  N Item -> [ ] where (>= 0 N)
  N Item -> [Item | (n-of (1- N) Item)])

GOOでL-99 (P01 最後のペアを返す)

| 11:40 | GOOでL-99 (P01 最後のペアを返す) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P01 最後のペアを返す) - わだばLisperになる

L-99に新しい仲間、Gooが加わりました。

GOOは、SchemeにDylan的なオブジェクト指向を足してArc的なものも加えて、さらにCとの親和性も高くしてみたりしてるような処理系です。

Arcより更に関数名がゴルフな感じになっており、さらにネーミングセンスも作者の嗜好が強いようで割と覚えにくいです。

既にL-99には自分自身食傷気味ですが、少しずつでも常に書いていると、案外色々覚えられるみたいなので(´∀`*)

他に良い問題集ないかしら。

GOOでのリストは普通のLisp系とはちょっと変っていて、常にプロパーリストで、点対リストはないそうです。

(my-last '(a b c d))
;=> (d)

(df my-last (u) 
  (if (nul? (tail u))
      u
      (my-last (tail u))))

Arcのリファレンス

| 10:09 | Arcのリファレンス - わだばLisperになる を含むブックマーク はてなブックマーク - Arcのリファレンス - わだばLisperになる

  • Arcはドキュメントがあまり整備されていないので、どういう関数が用意されているのか、いまいち把握できなかったが、素晴しいリファレンスが登場→Arc: Table of Contents。いままで、make-listが無いと思って自作したりしていたが、お蔭様でn-ofがそれに相当することが判明。

ArcでL-99 (P46 真偽値表)

| 09:25 | ArcでL-99 (P46 真偽値表) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P46 真偽値表) - わだばLisperになる

前回で、算術篇は終わり、今回から論理と符号篇です。ということで、番号が飛んでP46から。 これまでの問題を細かく分けると、43問あるので2問足りてない感じです。 今回のお題は、2引数のand、or、nand、nor、xor、impl、equを定義を定義し、真偽値表を出力するプログラムで結果を表示させるというものです。 implがなんだか良く分かりませんでしたが、検索してみると、IMPLY B (AならばB)のことのようなので、それらしいものを作ってみましたが、これで良いのか自信がありません。
(table t nil *impl)
;=> ====
;   t : t => t
;   t : nil => nil
;   nil : t => t
;   nil : nil => t
;   nil

(def *nand (a b) (no:and a b))
(def *nor (a b) (no:or a b))
(set *and ~*nand)
(set *or ~*nor)
(def *equ (a b) (*or (*and a b) (*and no.a no.b)))
(set *xor  ~*equ)
(def *impl (a b) (*or no.a b))

(def perm (lst)
  ((afn (u res)
     (if no.u
         res
         (self cdr.u `(,@res ,@(map [list car.u _] lst)))))
   lst () ))

(def table (a b f)
  (prn "\n====")
  (each (a b) (perm (list a b))
    (prf "#a : #b => ~ \n" (f a b))))

2008-03-23

PDP-6 LISP -> MacLISP

| 14:27 | PDP-6 LISP -> MacLISP - わだばLisperになる を含むブックマーク はてなブックマーク - PDP-6 LISP -> MacLISP - わだばLisperになる

  • どっからPDP-6 LISPで、どっからMacLISPなのかというのはずっと謎だったが、今日WikipediaのMacLISPの項目を読んでいて、途中から名前が変っただけのものということが分かった。1970年代始めに、同じPDP-6で稼働するBBN LISPが出現したので区別するために、MacLISPと呼ぶようになったとのこと。そういうことか!

CLOSでL-99 (P14 各要素を2倍する)

| 11:10 | CLOSでL-99 (P14 各要素を2倍する) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P14 各要素を2倍する) - わだばLisperになる

全体を纏めるdefgenericを根っことして作成して、他の枝葉は、defmethodで書く、というスタイルがあるようなので真似してみました。 確かに分かりやすいかもしれません。
(dupli '(a b c d e f))
;=> (A A B B C C D D E E F F)

(defgeneric DUPLI (lst)
  (:documentation "P14 (*) Duplicate the elements of a list."))

(defmethod DUPLI ((lst null))
  () )

(defmethod DUPLI ((lst cons))
  (destructuring-bind (head &rest tail) lst
    `(,head ,head ,@(DUPLI tail))))

QiでL-99 (P14 各要素を2倍する)

| 10:54 | QiでL-99 (P14 各要素を2倍する) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P14 各要素を2倍する) - わだばLisperになる

割とQiは良いかもしれない…、と思いつつ、未だチュートリアルを開いて見ることさえしていない…。
(dupli [a b c d e])
\=> [a a b b c c d d e e]
\

(define dupli 
  [ ] -> [ ]
  [H | T] -> [H H | (dupli T)])

(setf (values ~))

| 10:40 | (setf (values ~)) - わだばLisperになる を含むブックマーク はてなブックマーク - (setf (values ~)) - わだばLisperになる

気合いを入れてエントリとして纏めるのは面倒だけれど、メモしておきたいことを*standard-output*エントリとして書いてみることにしました。
  • いつもmultiple-value-setqを書いてて思い出すけど、(setf (values x y) (values 1 2))で複数の値を一度にセットできることを忘れがち。
  • MacLISPのコードを読んでいて、(setq x 10 x/' 11 y 20)のような記述を発見。/はエスケープ文字で、Common Lispでは、\になる。エスケープしてまで、x'と表現する意気込みに感心。割とエスケープしてでも意図通りに書く、というのは、MacLISPには多い気もする。

ArcでL-99 (P41c ゴールドバッハ予想をリスト表示)

| 08:17 | ArcでL-99 (P41c ゴールドバッハ予想をリスト表示) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P41c ゴールドバッハ予想をリスト表示) - わだばLisperになる

前回のものをさらにひねって、2〜3000の範囲で該当するものが何件あるかと求めよ、とのこと。 目視で数えるのはアレなので、数えるプログラムを書いてみました。
(goldbach-list/c 2 3000 50)
;=> 10

(def goldbach-list/c (start end limit)
  (count (fn ((x y)) (< limit (min x y)))
         (trues goldbach (range start end))))

ArcでL-99 (P41b ゴールドバッハ予想をリスト表示)

| 08:17 | ArcでL-99 (P41b ゴールドバッハ予想をリスト表示) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P41b ゴールドバッハ予想をリスト表示) - わだばLisperになる

前回は範囲をそのまま出力するものでしたが、ちょっとひねって、50より大きいものだけを出力するというものです。 ちょっと改造して終了。
(goldbach-list/b 1 3000 50)
;=> 992 = 73 + 919
;   1382 = 61 + 1321
;   1856 = 67 + 1789
;   1928 = 61 + 1867
;   2078 = 61 + 2017
;   2438 = 61 + 2377
;   2512 = 53 + 2459
;   2530 = 53 + 2477
;   2618 = 61 + 2557
;   2642 = 103 + 2539

(def goldbach-list/b (start end limit)
  (each p (range start end)
    (whenlet (x y) (goldbach p)
      (when (< 50 (min x y))
        (prf "#p = #x + #y\n")))))

2008-03-22

read-lineが多値を返すのを有効利用したい

| 13:36 | read-lineが多値を返すのを有効利用したい - わだばLisperになる を含むブックマーク はてなブックマーク - read-lineが多値を返すのを有効利用したい - わだばLisperになる

何気なくLispマシン(LMI Lambda)のソースコードを眺めていたのですが、

(DEFUN SXHASH-FILE (FILENAME &OPTIONAL &KEY (CHUNK-SIZE 1024))
  (LET ((BUFFER (MAKE-STRING CHUNK-SIZE)))
    (WITH-OPEN-FILE (INPUT FILENAME)
      (DO ((END)
           (EOFP)
           (HASHSUM 0 (PROGN (MULTIPLE-VALUE-SETQ (END EOFP) (SEND INPUT :STRING-IN NIL BUFFER))
                             (COMPILER::%SXHASH-SUBSTRING BUFFER #o377 0 END))))
          (EOFP
           HASHSUM)))))

というコードに遭遇しました。

DOで入出力のループを回すと、read系の関数を2回書くことになったりするのが、DO派の悩みですが、この方法だと1回で済み、また、ループから抜ける判定も同時にこなしてるのが、何だか素敵なので真似して他に応用できないか考えてみることにしました。

とはいえ、

(SEND INPUT :STRING-IN NIL BUFFER)

がFlavors(CLOS以前にメジャーだったオブジェクトシステム)なのが問題で、憶測ですが、bufferに値をセットして、返り値は、ファイルポジションと、EOFに遭遇したか否かを多値で返すとか、そんな感じじゃないでしょうか。

(DEFUN SXHASH-FILE (FILENAME &OPTIONAL &KEY (CHUNK-SIZE 1024))
  (with-output-to-string (BUFFER)
    (WITH-OPEN-FILE (INPUT FILENAME)
      (DO ((END)
           (EOFP)
           (HASHSUM 0 (PROGN (MULTIPLE-VALUE-SETQ (END EOFP) (read-line input nil))
                             (COMPILER::%SXHASH-SUBSTRING BUFFER #o377 0 END))))
          (EOFP
           HASHSUM)))))

みたいな。

そんなこんな考えるうちに、DOが多値に対応すれば、何か素敵なことができるんじゃないかと思ったので、multiple-value-doを作ってみることにしました。

;; ファイルの読み込み
(with-open-file (in "/tmp/foo.txt")
  (multiple-value-do (((line eofp) (values) (read-line in nil)))
      (eofp 'done)
    (and line (write-line line))))

;=> abcdef ....... EOF

;; 他になんかできないか…。
(defun my-gcd (n m)
  (multiple-value-do (((n m) (values n m) (values m (rem n m))))
      ((zerop m) n)))

しかし、read系は、read-lineのようにEOFの検出を2値目で知らせてくれるのかと思ったら、read-lineだけでした。そう言われてみればそうだったんですが、行単位で扱うから多値を返すんでしょうか…。

そうすると、実質 MULTIPLE-VALUE-DO を書いた意味がない…

他にも色々試してみましたが、「残念ながら、MULTIPLE-VALUE-DOはあまり役に立ちそうもない」というのは議論の余地のない given な事実として淀みなく会話は流れる、というのが一般的になりそうです。

(defpackage :mv 
  (:use :cl)
  (:export :multiple-value-psetq
           :multiple-value-do))

(in-package :mv)

(defmacro MULTIPLE-VALUE-DO ((&rest varlist) (test &rest finally) &body body)
  (let ((vars (mappend #'car varlist))
        (inits (mappend #'cadr varlist))
        (tag (gensym)))
    `(BLOCK NIL
       (MULTIPLE-VALUE-BIND ,vars ,inits
         (TAGBODY
            (MULTIPLE-VALUE-PSETQ ,@(mappend (fn ((x y z)) `(,x ,y))
                                             varlist))
       ,tag (WHEN ,test
              (RETURN-FROM NIL (PROGN ,@finally)))
            ,@body
            (MULTIPLE-VALUE-PSETQ ,@(mappend (fn ((x y z)) `(,x ,z))
                                             varlist))
            (GO ,tag))))))

;; --

(defmacro FN ((&rest args) &body body) ;; Arcから拝借
  (let ((g (gensym)))
    `(LAMBDA (&rest ,g)
       (DESTRUCTURING-BIND ,args ,g
         (DECLARE (IGNORABLE ,@(metatilities:flatten args)))
         ,@body))))

(defun MAPPEND (fn &rest lists)
  (reduce #'append (apply #'mapcar fn lists)))

(defmacro MULTIPLE-VALUE-PSETQ (&rest pairs)
  (cond ((cddr pairs) `(SETF (VALUES ,@(car pairs))
                             (MULTIPLE-VALUE-PROG1 ,(cadr pairs)
                               (MULTIPLE-VALUE-PSETQ ,@(cddr pairs)))))
        ((cdr pairs) `(SETF (VALUES ,@(car pairs)) ,@(cdr pairs)))
        ('T (error "Odd number of args."))))

ArcでL-99 (P41a ゴールドバッハ予想をリスト表示)

| 01:10 | ArcでL-99 (P41a ゴールドバッハ予想をリスト表示) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P41a ゴールドバッハ予想をリスト表示) - わだばLisperになる

今回のお題は、ある数値の範囲を与え、その範囲のゴールドバッハ予想をリスト表示するというものです。

前回定義したgoldbachを使用します。

おまけの質問があるのですが、それは、P41bということで次回に解答することにしました。

(goldbach-list 9 20)
;=> 10 = 3 + 7
;   12 = 5 + 7
;   14 = 3 + 11
;   16 = 3 + 13
;   18 = 5 + 13
;   20 = 3 + 17

(def goldbach-list (start end)
  (each a (range start end)
    (whenlet (x y) (goldbach a)
      (prf "#a = #x + #y\n"))))

2008-03-21

CLOSでL-99 (P13 ランレングス圧縮 その3)

| 19:59 | CLOSでL-99 (P13 ランレングス圧縮 その3) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P13 ランレングス圧縮 その3) - わだばLisperになる

Qiと同じくencode-modifiedの解釈がP13の解釈になっていたので、修正しつつ解答。

パターンマッチングが使える場合、P13よりは、P11の方が面白いかもしれないと思いつつ、パターンマッチの道具としてCLOSを使うというのはやはり濫用だなな思いつつ(笑)

(encode-direct '(a a a a b c c a a d e e e e))
;=> ((4 A) B (2 C) (2 A) D (4 E))

(defgeneric encode-direct (lst)
  (:method ((lst null)) () )
  (:method ((lst cons))
    (let ((pack (pack lst)))
      (encode-direct1 (caar pack) (cdar pack) pack))))

(defgeneric encode-direct1 (head-item head-cdr lst)
  (:method (head-item head-cdr (lst null)) () )
  (:method (head-item (head-cdr null) (lst cons))
    (cons head-item (encode-direct1 (caadr lst) (cdadr lst) (cdr lst))))
  (:method (head-item head-cdr (lst cons))
    (cons `(,(length (cons head-item head-cdr)) ,head-item)
	  (encode-direct1 (caadr lst) (cdadr lst) (cdr lst)))))


(encode-modified '(a a a a b c c a a d e e e e))
;=> ((4 A) B (2 C) (2 A) D (4 E))

(defmethod encode-modified ((lst null))
  () )

(defmethod encode-modified (lst)
  (let ((lst (encode lst)))
    (encode-modified1 (caar lst) (cadar lst) lst)))

(defmethod encode-modified1 (head-num head-item (lst null)) 
  () )

(defmethod encode-modified1 ((head-num (eql 1)) head-item (lst cons))
  (cons head-item
        (let ((next-head (cadr lst)))
          (encode-modified1 (car next-head) (cadr next-head) (cdr lst)))))

(defmethod encode-modified1 (head-num head-item (lst cons))
  (cons (car lst)
	(let ((next-head (cadr lst)))
	  (encode-modified1 (car next-head) (cadr next-head) (cdr lst)))))

QiでL-99 (P13 ランレングス圧縮 その3)

| 02:52 | QiでL-99 (P13 ランレングス圧縮 その3) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P13 ランレングス圧縮 その3) - わだばLisperになる

P10、P11、P13は続きものになっていて、P11はP10の結果を加工して解答するというもので、P13はP10を加工するのではなく直接リストを生成するという内容になっていますが、P11で直接リストを生成する方法で答えてしまいました(^^;

ということで、P11の名前を変更してP13として再掲載し、P11は新たに作り直してみました。

(encode-direct [a a a a b c c a a d e e e e])
\=>[[4 a] b [2 c] [2 a] d [4 e]]
\

(define encode-direct
    X -> (encode-direct* (pack X)))

(define encode-direct*
    [ ] -> [ ]
    [H | T] -> [(head H) | (encode-direct* T)] where (= 1 (length H))
    [H | T] -> [[(length H) (head H)] | (encode-direct* T)])


(encode-modified [a a a a b c c a a d e e e e])
\=>[[4 a] b [2 c] [2 a] d [4 e]]
\

(define encode-modified 
    X -> (encode-modified* (encode X)))

(define encode-modified*
    [ ] -> [ ]
    [[1 X] | T] -> [X | (encode-modified* T)]
    [H | T] -> [H | (encode-modified* T)])

ArcでL-99 (P40 ゴールドバッハ予想)

| 01:10 | ArcでL-99 (P40 ゴールドバッハ予想) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P40 ゴールドバッハ予想) - わだばLisperになる

Wikipediaによれば、一般的には、6以上の偶数は、2つの奇素数の和で表わすことができる、という予想らしいのですが、この問題では、2より大きい偶数は2つの素数の和で表わせる、という説明になっています。

ということで、一応お題の定義の方で作成してみました。

(goldbach 88888888888)
;=> (29 88888888859)

(def goldbach (n)
  (point RETURN
    (if (or odd.n (> 4 n))
        RETURN.nil
        ((afn (i)
           (let j (- n i)
             (when prime.j
               (RETURN:list i j)))
           (self next-prime.i))
         2)))))

2008-03-20

30年前のオリジナルEMACSとLisp開発環境

| 00:49 | 30年前のオリジナルEMACSとLisp開発環境 - わだばLisperになる を含むブックマーク はてなブックマーク - 30年前のオリジナルEMACSとLisp開発環境 - わだばLisperになる

最近サービスが開始されたPartty!.orgが面白そうだったので、オリジナルのEMACSを操作しているところをアップしてみたら受けるかもしれないということでキャプチャしてアップしてみました。

EMACSは32年位前にITS(MITで稼働していたMITのOS)で生まれ、それから同じくDECのPDP-10で稼働するTOPS-20等に移植されたのですが、このキャプチャはTOPS-20のものです。本当は、ITSの操作を取り込みたかったのですが、画面の描画が崩れてしまうので、しょうがなくTOPS-20で…。といっても見た目的にはそんなに違いはありません。

キャプチャについて大まかに解説すると、まず、MacLISPを起動しています。自分はMacLISPの初期化ファイルで、LEDITというEMACSとMacLISPが連携するLISP開発環境を呼び出しているので、起動後にすぐEMACSも起動します。

その後、適当にfib関数を定義したりしてみています。LEDITは、選択した範囲をMacLISPに送信する機能があるので、範囲を選択して送信すると、MacLISPでは送信された式が評価されます。そして、ショートカットでぱぱっとEMACSからMacLISPに抜けたり、戻ったりできます。

次に、carとcdrを拡張して定義できるcarcdr.lspというものをロードしてみています。

def-carcdrというマクロがあるので、適当にcadd...rのようなものを定義して遊んでみています。

その後、INFOを呼び出してLEDITの説明を表示してみています。

INFOもITSが生まれ故郷で、ITSでは、UNIXのmanのようにINFOが機能していました。

ほんのさわりしか紹介していないのですが、30年前のEMACSの時点でLISP式の編集に関しては、ほぼ完成してしまっています。

そして、70年代から、LISPのコーディングはこういう編集支援と共に育って来ていて、30年前の時点でLISPのメッカでは支援なしの素のLISPであれこれするということは既に行われていなかった様子です。

2008-03-19


ArcでL-99 (P39 指定した範囲の素数のリスト)

| 22:43 | ArcでL-99 (P39 指定した範囲の素数のリスト) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P39 指定した範囲の素数のリスト) - わだばLisperになる

今回のお題は、指定した範囲の素数のリストを作成するというものです。

以前定義したprimeとrange(Arc組込み)を組み合わせて解答。

それは良かったのですが、以前のP31 prime解答の間違いに気付いたので修正しました。(1を素数、2は素数でないと判定していた…。)

(prime-list 1 100)
;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)

(def prime-list (start end)
  (rem ~prime (range start end)))

2008-03-18


CLで学ぶ「プログラミングGauche」 (3)

| 23:42 | CLで学ぶ「プログラミングGauche」 (3) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (3) - わだばLisperになる

今回は3章「Gaucheの設計思想や誕生の背景」です。

Perlの影響

Gaucheは実用性を重視し、Perlの良いと思われる部分は積極的に吸収したということで、

  • 正規表現リテラル
  • 文字列間補完
  • モジュールシステム
  • DBI/DBD

等がPerlから受けた主な影響だそうです。

この辺は、最近では必須と考えられることが多いと思われるような機能でもあります。

Common Lispではどうかというと、Perl風の正規表現を提供するデファクトと言って良いような存在としては、CL-PPCREパッケージがあり、文字列間補完は、CL-INTERPOLあたりでしょうか。

モジュールシステムについてはちょっと考え方が異なりますが、CLには、標準でパッケージ機能があります。ただし、パッケージ機能は、ソースファイルの配布形態、読み込み方等を規定するものではないので、その辺を補完するものとしては、最近では、ASDFがデファクトになりつつあります。

DBI/DBDの例は、GaucheのPerlからの影響を受けたことを示す例だと思うので、横に置いておいても良いだろうと思われます。もちろんCLにもDB関係のパッケージも色々あります。

Common Lispの影響

勿論ですが、ここの説明は全部Common Lispに含まれています(笑)

  • キーワード引数
  • オブジェクトシステム(CLOS)
  • コンディションシステム

等が主な影響だそうです。

キーワード引数は確かに便利なので、良く使います。それと、ここには挙げられていませんが、オプショナル引数の扱いは、CL方式の方が扱いは単純で、簡単な故に普通に多用されています。

次に、CLOSは非常に強力と言われていますが、強力過ぎとも良く言われるようです。

CLのコンディションシステムもまた、非常に強力で、色々なことが可能です。

数理システムさんのCondition System (PDF)という親切なドキュメントがあるので、詳細はこちらを参照されると良いかと思われます。

ちなみに、私自身は、CLOSもCLのコンディションシステムも全然理解できていません(^^;

しかし、この二つは大規模なアプリケーションや、ミッションクリティカルなものの開発では、必須になってくるものではある気はします。

…まあ、素人が適当に小さいコードを、ちょこちょこ書く範囲ではそれ程深く追及する機会もあまりないということなのかも知れません。

これから出て来るGaucheの例をCLで書いたりして学んでみようと思います。

ArcでL-99 (P38 自作したオイラーのφ関数2種を比較)

| 02:33 | ArcでL-99 (P38 自作したオイラーのφ関数2種を比較) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P38 自作したオイラーのφ関数2種を比較) - わだばLisperになる

今回のお題は、P34と、P37で作成したオイラーのφ関数のベンチを取って速度を比較してみようという、お題になっているような、なっていないような微妙なお題です。

ということで、timeで比較してみました。

どうやら、P37の方が速いようです。

;----(P34 totient-phi)-------------------------------------------
;time: 597 msec.
;
;----(P38 phi)---------------------------------------------------
;time: 69 msec.

(let n 10090
  (prn)
  (prn "----(P34 totient-phi)-------------------------------------------")
  (time (totient-phi n))
  (prn)
  (prn "----(P38 phi)---------------------------------------------------")
  (time (phi n))
  (prn)
  nil)

2008-03-17


大文字と小文字を区別しない

| 06:06 | 大文字と小文字を区別しない - わだばLisperになる を含むブックマーク はてなブックマーク - 大文字と小文字を区別しない - わだばLisperになる

先日のPAIP読書会でNorvig先生がRETURNだけ見易いように大文字で書いている例から、もちらっと話題になったのですが、Common Lispは歴史的なLISP処理系と同様に大文字と小文字を区別しません。(設定すれば可能ですが…)

この辺は古臭いという風にも捉えられますが、区別しないということを利用して色々とコードを読み易いように工夫をしている例があります。

ということで、適当に色々なスタイルを列挙してみます。

  • コードはとりあえず全部小文字。コメントは、普通の文章と一緒
(defun hello-world ()  
  "Hello, World!")              ;Hello, World!

最近はこれが主流だと思います。他の言語もこれが普通なので、その影響だと思われます。

  • コードはとりあえず全部大文字。コメントは、普通の文章と一緒
(DEFUN HELLO-WORLD ()
  "Hello, World!")              ;Hello, World!

1970年代後半位までは、こっちが主流だったようです。

Zmacs(LispマシンのEmacs)には、こういうスタイルを支援する、Electric Shift Lock ModeというCAPS Lockが掛ったような動作をするマイナーモードがありました。コードの部分では、シフトキーの役割が引っくり返るんですが、コメントや、文字列の中では、普通という秀逸なモードです。

  • とにかく全部大文字
(DEFUN HELLO-WORLD ()
  'HELLO-WORLD)              ;HELLO, WORLD!

1970年代前半位までこんな感じです。というより、大文字しか扱えなかったシステムが多かったようだったようなので、必然かもしれません。

色々工夫している例

ここからは、大文字と小文字を区別しないシステムの失われつつある文化の領域になってきます。

目につくところだけ集めてみました。細かいこだわりになると無数にあるようで、眺めていると結構面白いです。

  • Tは大文字で書く(MacLISP等)
(cond ((< n 2) n)
      (T 'hello)))

(cond ((null lst) n)
      ('T 'hello))
... etc

Tにはクオートを付けたりもします。しかし対応するnilは小文字というのが謎。

  • gotoのタグは大文字で書く(MacLISP等)
(prog (lst)
   L  (cond ((null lst) (return 'hello)))
      (pop lst)
      (go L))

タグは大文字で書かれることが多かったようです。

(defun LIVE-ARRAYS (kind)
  ...)

これは今でもちらほらみかけます。

  • マクロの定義で、展開された結果になる所は大文字で書く(MacLISP等)
(defmacro SETQ-IF-UNBOUND (&rest args)
  (do ((a args (cddr a))
       (l () (cons `(OR (BOUNDP ',(car a)) (SETQ ,(car a) ,(cadr a))) l)))
      ((null a) 
       (cond ((null (cdr l)) (car l))
	     (`(PROGN ,.(nreverse l)))))))

(setq-if-unbound x 3 y 5)
;=> (PROGN (OR (BOUNDP 'X) (SETQ X 3)) (OR (BOUNDP 'Y) (SETQ Y 5)))

これは良く思い付いたなと感心しますが、MacLISPでは結構このスタイルで書いてる人がいます。

  • システム定義のものは大文字、ユーザ定義のものは小文字で書く(TI-Explorer)
(DEFUN search-and-or (substrings string)
  (DECLARE (optimize (compilation-speed 0) (safety 1) (SPACE 2) (speed 3))
	   (inline search-and-or simple-string-search))
  (LOOP for and in substrings
	unless (IF (ATOM and)
		    (simple-string-search and string)
		  (LOOP for or in and do
			(IF (ATOM or)
			    (WHEN (simple-string-search or string) (RETURN t))
			  (LOCALLY (DECLARE (notinline search-and-or))
			    (search-and-or or string)))))
	do (RETURN nil)
	finally (RETURN t)))

MacLISPとは逆でシステムが大文字な例です。

  • 上記に加え、なんでか知らないが、defun等、def-系だけ先頭を大文字にする(TI-Explorer)
(Defun ALL-ARGLIST-BEFORE-&AUX (arglist)  
;; return a copy of the arglist up to but excluding &aux
  (LET ((pos (POSITION '&aux (the list arglist) )))
    (IF pos 
	(FIRSTN pos arglist) 
	arglist)))

以上、大文字小文字を区別しないことを不自由と考えるか、自由と考えるか、様々だと思いますが、自由と考えている風な例を取り上げてみました。

ArcでL-99 (P37 オイラーのφ関数 その2)

| 03:34 | ArcでL-99 (P37 オイラーのφ関数 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P37 オイラーのφ関数 その2) - わだばLisperになる

今回のお題は、P34のオイラーのφ関数の改良版の作成です。

phi(m) = (p1 - 1) * p1 ** (m1 - 1) + (p2 - 1) * p2 ** (m2 - 1) + (p3 - 1) * p3 ** (m3 - 1) + ...

という式を前回作成したprime-factors-multを利用して実装します。

今回、ふとArcの構造化代入ってどうなってるのか試してみたら、7年前のプラン通りにletに構造化代入の機能が付いてました。

(let (x y) '(1 2)
  (list x y))
;=> (1 2)

そうだったのか…、全然試してなかったな…。

arc.arcを眺める限りでは、letの定義でも、withの定義でも分解している様子はないので、fn自体に構造化代入機能がある様子。ということで、

((fn ((x (y z))) (list x y z)) 
 '(1 (2 3)))
;=> (1 2 3)

こういうことも可能だったんですね。知らなかった…。ということで、今回早速試してみました。

mapで使うと便利ですね。

(phi 1192)
;=> 592

(def phi (m)
  (apply * (map (fn ((p m)) (* (- p 1) (expt p (- m 1))))
		(prime-factors-mult m))))

2008-03-16


CLOSでL-99 (P12 ランレングス圧縮の伸長)

| 16:08 | CLOSでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる

もの凄く下らないんですがconspを使用するような、ifを排除する方法として、補助関数は、先頭の要素だけ別の引数として持っていて、その型を調べるという方法が、イディオムとして使えるなということに気付きました。

もちろんif式を排除する必要性はどこにもありません(笑)

(decode '((4 A) B (2 C) (2 A) D (4 E)))
;=> ((A A A A) (B) (C C) (A A) (D) (E E E E))

(defgeneric DECODE (lst)
  (:method (lst) (decode1 (car lst) lst)))

(defgeneric decode1 (head lst)
  (:method (head (lst null)) () )
  (:method ((head cons) (lst cons))
    (let ((head (car lst)))
      (cons (make-list (car head) :initial-element (cadr head))
	    (decode1 (cadr lst) (cdr lst)))))
  (:method (head (lst cons))
    (cons (list head)
	  (decode1 (cadr lst) (cdr lst)))))

ArcでL-99 (P36 素因数分解 その2)

| 15:25 | ArcでL-99 (P36 素因数分解 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P36 素因数分解 その2) - わだばLisperになる

今回は素因数分解した結果を因数ごとに纏めてリストにして表現するというものです。

ヒントとして、P13をちょっと応用せよ、ということが書いてあります。

という訳で、P13と前回の解答を合体しました。

(def prime-factors-mult (n)
  ((afn (lst acc)
     (if no.lst
	 rev.acc
	 (self cdr.lst
	       (cons `(,caar.lst ,(len car.lst)) acc))))
   (pack:prime-factors n) () ))

第3回 PAIP 本読書会に参加してきました

| 02:25 | 第3回 PAIP 本読書会に参加してきました - わだばLisperになる を含むブックマーク はてなブックマーク - 第3回 PAIP 本読書会に参加してきました - わだばLisperになる

今日は、Peter Norvig氏の名著「Paradigms of Artificial Intelligence Programming」の読書会に参加して来ました。

初心者の自分に果してついて行けるかどうかということと、まだ本を入手していないということで、今回は見学というスタンスでしたが、欠席の方のPAIPを貸して頂けることになったので普通に参加させて頂くことになりました。

内容は、PAIPの内容を各自順に音読して訳しつつ進めるというものでした。

人前で英語で内容を即時訳して行くのは高校以来位であり、また内容も予習していないので、頭が真っ白になり何を読んでいるのか全然把握できていませんでしたが、周りの皆様に助けて頂きどうにか進めることができました。

頭が真っ白だったので、記憶が曖昧なのですが、以下適当に纏めてみました。

2. A Simple Lisp Program

  • ここでは、Lispを使って英文を生成させつつ、抽象化をの技法の入門といった感じ。
  • 人に読みやすいプログラムを書くということを解説しつつ、また、そうすることで、Lispベースのちょっとした専用言語のようなものができることを示されているような、いないような。

3. Overview of Lisp

とりあえず、Norvig家家訓として、

コードは、

  1. 明確に書くべし
  2. 抽象化を活用すべし
  3. 簡潔に書くべし
  4. 予め用意されているもの(関数等)は活用すべし
  5. 一貫性を持たせるべし

の6訓があるようです。

  1. defun、defvar、defparameter等のdef-系の説明で、defvar、defparameter、defconstantの使い分けについてと、defstructの機能の解説。
    • setfの解説。値を代入するだけでなく、値の場所を指定することにより、その場所を展開して値を代入することが可能であることを解説。また、ユーザがsetfの拡張を定義することが可能。途中、佐野さんより、define-setf-methodという表記は古いというツッコミがはいる。ANSI Common Lispでは、define-setf-expanderに名称変更。また、(defun (setf foo)〜)という定義も可能だよね、というツッコミもありつつ。
  2. 同じことをするにも複数の書き方があるが、どれが適切かを良く考えることと、どういう表現をするにしても一貫性をもって表現することが大事であることを強調
    • 繰り返し機構の解説と比較
      • 以上を踏まえ具体例何種類かのループでlengthを作成してみせる。妙な書き方も解説しつつ、何がプログラムの表現として適切かを探る。基本的には、dolist、dotimes、dodo系のものと、mapcar等のmap系のもの、再帰を比較する。副作用前提のもの、そうでないもの等で表現が変わることを解説。また、特定の用途に特化したfindや、count-if等の仲間も解説し、それぞれ、一長一短を解説。

ちなみに、色々あるlengthの実装で、自分が一番妙だなと思ったのは、

(defun length8 (list)
  (if (null list)
      0
      (+ 1 (position-if #'true list :from-end t))))

で、これは、かなり捻らないと出てこない発想じゃないかと思います。読書会の後で話題にもなりました。

また、関連するところでは、Norvig先生は、trueという引数を与えられたら無条件にtを返すという関数を定義しています。

(defun true (&rest ignore) t)

確か、こういう用途には、何かあった筈…という話題も読書会の後の飲み会で出ましたが、家で調べたらconstantlyでした。

constantlyは関数を返す関数で、

(mapcar (constantly t) '(1 2 3 4 5 6))
;=> (T T T T T T) 

のように使えます。こういう場所位でしか使いどころがないと思うので、個人的には是非使ってあげたい関数かなと思います(笑)

また、例に挙げられていない方法でlengthを考えてみる、というのもちょこっと話題になったのですが、自分は、

(defun length-1192 (lst)
  (apply #'+ (mapcar (constantly 1) lst)))

というのを考えてみました。内容を全部1に置き換えて最後に+を適用するというものです。

次回は、続きで、Macroのところから。

読書会後の飲み会的な会

今回、CL風味の方が結構集まった様子。折角なので、会場近所の店で、色々お話することになりました。

自分としても色々御聞きしたいことがあったのですが、自分は、ひきこもっているということもあり、あまり話をしていない反動で、延々と自分の好きな話題を喋りまくっておりました。ほんとに、すいません(笑)

こういう会をきっかけに、CLが草の根的にどんどん盛り上がっていったら良いなと思いつつ帰宅しました。

QiでL-99 (P12 ランレングス圧縮の伸長)

| 00:55 | QiでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる

Qiでは、nthが0オリジンではなく、1オリジンというところにはまってしまいました。

(nth 0 ~)とかすると、処理系から返事がなくなってしまったりします。

(decode [[4 a] b [2 c] [2 a] d [4 e]])
\=> [[a a a a] [b] [c c] [a a] [d] [e e e e]]
\

(define decode
    [ ] -> [ ]
    [H | T] -> [(unpack* (nth 2 H) (nth 1 H) [ ]) | (decode T)] where (cons? H)
    [H | T] -> [[H] | (decode T)])

(define unpack*
    Item Cnt Acc -> Acc where (= 0 Cnt)
    Item Cnt Acc -> (unpack* Item (1- Cnt) [Item | Acc]))

2008-03-14


CLで学ぶ「プログラミングGauche」 (2)

| 19:12 | CLで学ぶ「プログラミングGauche」 (2) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (2) - わだばLisperになる

Gaucheの特徴

今回は2章「Gaucheの特徴」ですが、Gaucheと比較してCommon Lispはどんな感じなのかしらということを書いてみたいと思います。

Gaucheは

  1. 手軽にプログラムを書いて試せるスクリプト言語
  2. 実用規模のプログラムまでスケールする
  3. 他の言語で書かれたアプリケーションに埋め込める

ことに力を入れている、とあります。

それでCommon Lispはどうかというと、UNIX等のOSの上でスクリプトとして手軽に試せる、というのはちょっと苦手です。

頑張ればできないこともありませんが、そこに力は入ってないようです。

ただ、手軽に試せる、ということや、アイディアをさっとスケッチする、ということはSLIMEのような中の環境から逆にOSを操作すれば良い訳で、スクリプト言語でなければ不可能というわけではないと思います。この辺は、Smalltalkに代表されるイメージの中で生活する処理系で共通しているかと思います。換言すれば、現在一般的にスクリプト言語として手軽、というのは、ホストのUNIXと親和性が高いかどうかということで、ホストを含めてイメージとして抱えている言語では、また違ったアプローチになるかと思います。

次に、スケールするかですが、自分は良く知らないのですが数十〜百万行規模のアプリケーションも実稼働しているようなのでスケールはするんじゃないでしょうか。

そして、他のアプリケーションに埋め込み可能かですが、これも最初の項目に関連し、苦手としていると思います。

  • マルチバイトの処理

これはCLでも可能ですが、Gaucheのように環境が整備されていて、かつ、日本のコミュニティが活溌というわけではないので、何か新しいパッケージを試して文字コード特有の問題に遭遇しても、解決するには自力で色々調べたり、直したりする必要に迫られることが多いかと思います。

  • パッケージ、モジュールシステム

Common Lispには標準でパッケージ機能があるので、コードを書く際にも手軽に書き捨てでパッケージを作成して色々試す、ということも広く行われているかと思います。パッケージを作ると名前の衝突等を簡単に回避できるので、この辺もスケーラビリティーも貢献しています。

また、標準ではありませんが、ASDFというパッケージを導入する仕組があり、最近では、ASDFを使って何でも配布することが多くなって来ているようです。

ASDF-INSTALLという、ネットワークインストールに対応した仕組みもあり、DebianのAptのようにモジュールをネットワークインストール可能で非常に便利です。

  • オブジェクトシステム

Gaucheには、CLOSライクなオブジェクトシステムがありますが、CLOSはCommon Lisp Object Systemの略でもありANSI Common Lispで標準になっています。

「実行時メタオブジェクトプロトコルを完全実装したフル動的オブジェクトシステム!」とか、なんだか凄そうなんですが、親切な解説やチュートリアルは(特に日本)あまりなく、残念ながら人口に膾炙している気がしません。

また、CLOS以外にもオブジェクトシステムはあり、AOP等の実装もあります。

  • Cとの連携

C(や他言語)との連携のためのインターフェースもありますが、実装依存で処理系により異なっています。フリーの処理系では、CFFIがメジャーどころかと思われ、殆どCFFIか、UFFIパッケージを使用しているかと思われます。

これらを利用して、OpenGLや、SQLと連携したりするパッケージも多数公開されています。

ArcでL-99 (P35 素因数分解)

| 17:57 | ArcでL-99 (P35 素因数分解) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P35 素因数分解) - わだばLisperになる

今回は、素因数分解がお題です。

ちょうど去年の今頃、このお題をCommon Lispで解いていたのですが、職場の飲み会で普段は何をして過してるんですか、という質問に、

「いや、ほんと無趣味なんで何もしてないですね。…あ、強いて挙げれば、素因数分解ですかね」

と答えたところ、死ぬ程笑われたことを思い出します。そんなに面白かったかしら…。

私は、数学以前の算数で挫折しているクチなのですが、素朴に書いてみました。

大きめの素数を与えると返事がなくなります。

以前定義したprimeを使用しています。

(prime-factors 600851475143)
;=> (71 839 1471 6857)

(def prime-factors (n)
  ((afn (n i)
     (with (q (trunc (/ n i)) r (mod n i))
       (if (< n 2) list.n
	   (is 0 r) (if (is 1 q) 
			list.i
			(cons i (self q i)))
	   'else (self n (next-prime i)))))
   n 2))

(def next-prime (n)
  ((afn (n)
     (if (prime n)
	 n
	 (self (+ 1 n))))
   (+ n 1)))

CLOSでL-99 (P11 要素をランレングス圧縮する その2)

| 05:41 | CLOSでL-99 (P11 要素をランレングス圧縮する その2) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P11 要素をランレングス圧縮する その2) - わだばLisperになる

なんかどんどん脱線して行ってしまう!

(encode-modified '(a a a a b c c a a d e e e e))
;=> ((4 A) (1 B) (2 C) (2 A) (1 D) (4 E)) 

(defgeneric encode-modified (lst)
  (:method ((lst null)) () )
  (:method ((lst cons))
    (let ((pack (pack lst)))
      (encode-modified1 (caar pack) (cdar pack) pack))))

(defgeneric encode-modified1 (head-item head-cdr lst)
  (:method (head-item head-cdr (lst null)) () )
  (:method (head-item (head-cdr null) (lst cons))
    (cons head-item (encode-modified1 (caadr lst) (cdadr lst) (cdr lst))))
  (:method (head-item head-cdr (lst cons))
    (cons `(,(length (cons head-item head-cdr)) ,head-item)
	  (encode-modified1 (caadr lst) (cdadr lst) (cdr lst)))))

QiでL-99 (P11 連続する要素をランレングス圧縮する その2)

| 23:29 | QiでL-99 (P11 連続する要素をランレングス圧縮する その2) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P11 連続する要素をランレングス圧縮する その2) - わだばLisperになる

実は本家サイトのP-99はPrologの全問解答がありますが、L-99は解答が全部揃ってません。

そういう訳で、fixdapにてL-99の解答を作成するというプロジェクトを作成してみたんですが、良かったら投稿してみて下さい!

現在作成したCommon Lisp、Scheme、Arc、Qi等の解答例を少しずつアップしてみています。

(encode-modified [a a a a b c c a a d e e e e])
\=>[[4 a] b [2 c] [2 a] d [4 e]]
\

(define encode-modified
    X -> (encode-modified* (pack X)))

(define encode-modified*
    [ ] -> [ ]
    [H | T] -> [(head H) | (encode-modified* T)] where (= 1 (length H))
    [H | T] -> [[(length H) (head H)] | (encode-modified* T)])

2008-03-13


CLで学ぶ「プログラミングGauche」 (1)

| 02:32 | CLで学ぶ「プログラミングGauche」 (1) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (1) - わだばLisperになる

以前から私は、「プログラミングGauche」が出版された暁にはCommon Lispで内容をさらってみようと思っていました。

この書物はLisp系を実用的に使用するに当って現状で直面するであろう様々な問題に実際に取り組んできたGaucheという言語を使って、実際的なプログラミングを紹介している本というわけで、Common Lispにこの内容が活きない訳はないと思ったからなのですが、実際にぱらぱらと内容を確認してみても、自分のようなLISP初心者が知りたいと思うようなことが程よく纏められているので、順を追って実習して行けば、一通りのことはできるようになるんじゃないかと思いました。

問題は、これが全部CLで実習できるかどうかということですが、Perl互換の正規表現パッケージから継続ベースのウェブサーバまで、一通り似たようなものはあるので、あれこれ代用品を探しつつ実習すれば可能じゃないかと思っています。

  • なぜCommon Lispなのか。

ちなみに、「なぜGaucheではなくてCommon Lispなのか」は自分でも良く分かっていません。

自分は、レトロコンピューティングが好きということもあり、連綿と続くLISPの流れからすると、CLの方が本流に近いから好きというのはあるかもしれません。

それで、自分が考える「連綿と続くLISPの流れ」の印象なんですが、「なんだか適当なんだなあ」です(笑)

また、自分は、リスト操作言語が好きなようなのですが、リスト操作言語として比較すると、CLの方がその性格がちょっと強く出ている気がします。Schemeはリスト操作言語がベースになってはいますが、他に色々目玉があるので、そこに焦点は当てられていないというか、そこを目当てに使ってる人は割と少ないんじゃないかなあと、勝手に想像しています。

リスト操作言語的特徴ってなんなんだ、ということになってしまうかと思いますが、リストでなんでも考えようという所というか、なんというか。

リスト操作で物事を解決するというのも結構美しいと思うのですが、一般的にはどうなのでしょう。

自分は、結構Guy Steel氏の講演Error 404 (Not Found)!!1を見てLISPのこういう面に感銘を覚えました。

また、Arcも原点回帰なのか、元々Paul Graham氏がそういうのが好きなのか分かりませんが、リスト処理的面が強い気がしています。

なんとなく、「S式」、「リスト操作」、「伝統的マクロ」、「適当」の組み合わせが好きな人は、SchemeよりはCLの方が好みなんじゃないかなあ、と想像します。

それはそれで良いとして、とりあえず、1章から

LispとScheme

この章は基礎知識的なところなので、SchemeをCommon Lispに置き換えても別に違いはなく、S式ベースの言語なら大体共通しているかと思います。

という感じで、まったり進めて行きたいと思っています。

Gaucheを知ってる人が読んで、簡単に同じことをCommon Lispでも試して遊べるような、そういうお手軽情報になるという方向も同時に目指しています。

2008-03-12

CLOSでL-99 (P10 連続する要素をランレングス圧縮する)

| 23:47 | CLOSでL-99 (P10 連続する要素をランレングス圧縮する) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P10 連続する要素をランレングス圧縮する) - わだばLisperになる

こうやってL-99を色んなLispの方言で書いていれば、しょこたん並みにブログを更新できる日も近い!

とりあえず、今のところ、Common Lisp、Scheme、Lisp Machine Lisp、Arc、Qiで挑戦してみています。

e7とか、gooとか、UtiLispとか、INTERLISPとか、MacLISPとか、Dylanでも書いてみたい!

誰も読まなくなる可能性については、とりあえず置いておきます…。

(encode '(a a a a b c c a a d e e e e))
;=> ((4 A) (1 B) (2 C) (2 A) (1 D) (4 E)) 

(defmethod encode ((lst cons)) (encode1 (pack lst)))

(defmethod encode1 ((lst null)) () )
(defmethod encode1 ((lst cons))
  (cons `(,(length (car lst)) ,(caar lst)) (encode1 (cdr lst))))

QiでL-99 (P10 連続する要素をランレングス圧縮する)

| 23:29 | QiでL-99 (P10 連続する要素をランレングス圧縮する) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P10 連続する要素をランレングス圧縮する) - わだばLisperになる

Qiのそこそこ普通のLISPとは違っていて、それでいてそんなに違っている訳でもないという辺が段々好きになって来たような、来ないような。

(encode [a a a a b c c a a d e e e e])
\=> [[4 a] [1 b] [2 c] [2 a] [1 d] [4 e]]
\

(define encode 
    X -> (encode* (pack X)))

(define encode*
    [ ] -> [ ]
    [H | T] -> [[(length H) (head H)] | (encode* T)])

ArcでL-99 (P34 オイラーのφ関数)

| 20:04 | ArcでL-99 (P34 オイラーのφ関数) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P34 オイラーのφ関数) - わだばLisperになる

私は、オイラーのφ関数には全く馴染みがないのですが、Wikipediaの解説から想像して作成するとこうなりました。

前回定義したcoprimeを使用しています。

(totient-phi 10)
;=> 4

(def totient-phi (n)
  ((afn (m n)
     (if (is 0 n)
	 0
	 (+ (if (coprime m n) 1 0)
	    (self m (- n 1)))))
   n (- n 1)))

2008-03-11

CLOSでL-99 (P09 連続して現われる要素を纏める)

| 19:32 | CLOSでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる

なんだかあまり面白くないパズルの様相を呈して来ました。こういうのではなくて、まともにCLOSの勉強をしなくては(笑)

(pack '(a a a a b c c a a d e e e e))
;=> ((A A A A) (B) (C C) (A A) (D) (E E E E))

(defmethod pack ((lst null)) () )
(defmethod pack (lst) (pack1 lst () () ))

(defmethod pack1 ((lst null) acc res)
  (nreverse (cons acc res)))
(defmethod pack1 ((lst cons) (acc null) res)
  (pack1 (cdr lst) (cons (car lst) acc) res))
(defmethod pack1 ((lst cons) acc res)
  (if (equal (car lst) (car acc))
      (pack1 (cdr lst) (cons (car lst) acc) res)
      (pack1 lst () (cons acc res))))

QiでL-99 (P09 連続して現われる要素を纏める)

| 16:47 | QiでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる

ちょっと複雑になると途端にどうしたら良いか分からなくなってしまいます。

そろそろチュートリアルをきちんと読まねば…。

(pack [a a a a b c c a a d e e e e])
\=> [[a a a a] [b] [c c] [a a] [d]]
\

(define pack
    [ ] -> [ ]
    X -> (pack* X [ ] [ ]))

(define pack*
    [ ] Acc Res -> (reverse (cons Acc Res))
    [H | T] Acc Res -> (pack* T (cons H Acc) Res) where (or (empty? Acc) (= H (head Acc)))
    Lst Acc Res -> (pack* Lst [ ] (cons Acc Res)))

ArcでL-99 (P33 互いに素であるかを判定する)

| 16:18 | ArcでL-99 (P33 互いに素であるかを判定する) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P33 互いに素であるかを判定する) - わだばLisperになる

今回のお題は、互いに素であるかを判定せよとのこと。自分は数学には滅法疎いので、Wikipediaの説明を元にgcdの結果を1と比較しているだけです。

前回のgcdも良く考えれば、modを使えば簡単に書けるので書き直しました。

(def coprime (x y)
  (is 1 (gcd x y)))

(def gcd (n m)
  (if (is 0 m)
      n
      (gcd m (mod n m))))

繰り返し構文からみる自分のコーディングスタイル (2)

| 17:22 | 繰り返し構文からみる自分のコーディングスタイル (2) - わだばLisperになる を含むブックマーク はてなブックマーク - 繰り返し構文からみる自分のコーディングスタイル (2) - わだばLisperになる

前回反響が少しでもあるとは全く考えていなかったのでデータについては適当にしていましたが、☆が2個付いたし折角なので、文字のデータですが公開してみることにしました! 見難いですが、とりあえず色々あります。これらから一体何が読み解けるのかは、全くの謎です!

見慣れない構文名があるので、変なものをざっと解説すると、DO-FOREVERはその名のとおり無限ループ用です。個人的には是非復活して欲しいですね(笑) Lispマシンでは人気がありましたが、Common Lisp以降どっかにいなくなりました。DO-NAMED系は、DOのブロックに名前が付いていて脱出時に指定します。これもCLで、BLOCKとして統一されたので姿を消してしまいました。

全然関係ないですが、ループ系の構文の名前を考える、ということでは、RRRSのメーリングリストで名前付きLETに適切な名前を付けよう!、というのが熱くて面白いです。もの凄く沢山の案が提案されているのですが、結局採用されずに今に至るという流れが特に好きです(笑)

現在の主なフリーの処理系

  • SBCL
構文名 総数 総行数行数/構文最大行数
DOLIST 1073 9956 9 152
DO 702 7463 10 170
MAPCAR 547 2082 3 45
LOOP 514 3574 6 57
DOTIMES 359 2161 6 88
LABELS 156 5339 34 306
DO* 65 821 12 81
MAP 53 340 6 103
MAPC 47 152 3 14
MAPCAN 23 229 9 64
PROG 7 568 81 366
MAPLIST 1 7 7 7
  • CLISP
構文名 総数 総行数行数/構文最大行数
DOLIST 382 4016 10 332
MAPCAR 304 1345 4 176
DO 282 4110 14 117
DOTIMES 144 729 5 62
LOOP 102 993 9 206
DO* 94 1871 19 250
MAP 70 184 2 12
MAPCAN 60 333 5 26
LABELS 52 4073 78 1233
MAPC 35 155 4 36
PROG 12 256 21 131
MAPL 8 45 5 35
MAPLIST 4 31 7 26
MAPCON 2 2 1 1
  • CMUCL
構文名 総数 総行数行数/構文最大行数
DOLIST 1570 12602 8 90
DO 1243 13010 10 179
DOTIMES 710 4565 6 91
MAPCAR 612 2361 3 47
PROG 424 7489 17 377
LOOP 405 2554 6 56
DO* 175 3335 19 132
LABELS 161 5755 35 230
MAPC 104 191 1 14
MAP 58 148 2 12
MAPCAN 18 88 4 11

古い処理系

  • Franz Lisp 1985頃?
構文名 総数 総行数行数/構文最大行数
DO 371 4462 12 195
PROG 205 5377 26 575
MAPCAR 69 213 3 16
MAPC 53 303 5 41
DOLIST 41 280 6 32
LOOP 24 104 4 11
MAPCAN 10 61 6 17
MAPLIST 3 33 11 11
DOTIMES 2 2 1 1
MAP 1 6 6 6
MAPCON 1 5 5 5
  • Rutgers PDP-10 CL 1985年頃
構文名 総数 総行数行数/構文最大行数
DO 368 3451 9 78
DOLIST 157 964 6 68
DOTIMES 78 361 4 28
DO* 74 874 11 61
MAPCAR 62 176 2 13
PROG 31 687 22 62
LABELS 11 244 22 59
MAPC 6 19 3 6
MAPCAN 6 37 6 8
LOOP 2 4 2 3
MAPL 1 4 4 4
構文名 総数 総行数行数/構文最大行数
DO 902 9181 10 251
PROG 359 14913 41 603
MAPC 275 1597 5 52
MAPCAR 184 628 3 29
MAPCAN 51 322 6 52
LOOP 30 166 5 28
DOTIMES 16 238 14 46
MAP(MAPL) 15 118 7 25
DOLIST 13 35 2 7
MAPLIST 6 19 3 6
MAPCON 3 5 1 2
DO* 1 1 1 1

Lispマシン系

  • LMI K-Machine 1986年頃
構文名 総数 総行数行数/構文最大行数
DO 614 5653 9 146
DOTIMES 392 2658 6 121
DOLIST 355 2441 6 62
MAPCAR 235 626 2 13
LABELS 137 1754 12 98
LOOP 92 303 3 16
MAPC 89 257 2 15
DO-FOREVER 46 548 11 58
DO* 42 571 13 56
MAP 26 43 1 6
PROG 16 333 20 58
MAPCAN 10 68 6 9
DO*-NAMED 6 48 8 9
MAPL 5 7 1 3
MAPCON 2 16 8 8
MAPLIST 1 5 5 5
DO-NAMED 0 0 0 0
  • LMI Lambda 1982年頃
構文名 総数 総行数行数/構文最大行数
DO 4018 46904 11 156
DOLIST 2049 12879 6 142
LOOP 1308 11002 8 119
DOTIMES 1127 5761 5 151
MAPCAR 662 1882 2 92
PROG 607 17999 29 404
DO-FOREVER 257 3782 14 183
MAPC 250 2581 10 1719
DO* 97 1716 17 114
MAP 84 255 3 44
MAPCAN 68 325 4 20
DO-NAMED 36 933 25 97
DO*-NAMED 6 27 4 9
MAPL 2 2 1 1
MAPCON 2 4 2 2
MAPLIST 0 0 0 0
  • MIT CADR 1979年頃
構文名 総数 総行数行数/構文最大行数
DO 2321 27545 11 142
DOLIST 806 4632 5 72
PROG 665 15177 22 253
LOOP 457 3360 7 54
DOTIMES 316 1775 5 142
MAPCAR 155 390 2 12
MAPC 114 306 2 17
DO-NAMED 46 1094 23 74
MAPCAN 16 56 3 9
MAP 12 17 1 5
MAPCON 2 4 2 2
  • Gigamos 1987年頃
構文名 総数 総行数行数/構文最大行数
DO 622 7827 12 140
DOLIST 362 2358 6 50
LOOP 233 1808 7 119
DOTIMES 191 1112 5 121
MAPCAR 151 380 2 48
LABELS 65 1949 29 199
PROG 64 2297 35 167
MAPC 56 126 2 25
DO* 21 267 12 32
DO-FOREVER 16 196 12 34
MAPCAN 9 49 5 8
DO-NAMED 7 283 40 90
MAP 4 4 1 1

コードの量が少ないので参考データとして

  • Peter Norvig (LTD) 1995年頃
構文名 総数 総行数行数/構文最大行数
LOOP 32 133 4 17
MAPCAR 29 64 2 7
MAP 8 17 2 6
DOLIST 7 42 6 13
LABELS 4 47 11 32
DO 3 3 1 1
MAPC 3 7 2 3
MAPCAN 3 9 3 7
MAPLIST 1 1 1 1
MAPCON 1 1 1 1
DOTIMES 1 9 9 9

繰り返し構文からみる自分のコーディングスタイル

| 01:50 | 繰り返し構文からみる自分のコーディングスタイル - わだばLisperになる を含むブックマーク はてなブックマーク - 繰り返し構文からみる自分のコーディングスタイル - わだばLisperになる

Common Lispせよ、Schemeにせよ繰り返しの構文は豊富に用意されているかと思うのですが、どんな構文を自分は好んで使っているのか、ふと、知りたくなりました。 ということで、DOやMAP、PROG等のめぼしい構文を抜き出して各々の構文の数を勘定するコードをCLで書いてチェック。自分が書いたメモ書きからスクラッチのごみのようなものまで含めて約4万行を対象にしてみました。グラフはGoogleDocsにお任せしました。ほんとはCLで完結させたかったんですが…。 主観的には自分は繰り返しにはDO構文を良く使っていて、LOOPはあまり使ったことがない、と思っているのですが、意外なことにMAPCARを一番多く使っていて、大体同じ位DOを使用。そして使ってない筈のLOOPも普通に使ってました(笑) 最近、LOOPで書く練習をしていて、できるだけLOOPで書くようにしているからかも知れません。PROGが多いのはレトロコンピューティングな趣味が反映されたものだと思われます。 ついでに、SBCL 1.0.15のソースコードも調べてみました。 DOLIST、DO、MAPCARで7割弱。何でもかんでもLOOPだろうと勝手に思っていたので意外でした。 ■ それで調子に乗って古い処理系から最近のCLの処理系まで色々調べてみたのですが、最近の傾向としては、ちょとした違いはありますが、DOLIST、DO、MAPCARの順で6割強を占めるようです。この35年位を通じDOは首位で安定している様子で、LOOPは大体4番手か5番手位。CMUCLでは、LOOPよりPROGが多かったりして何となく処理系の歴史を感じさせます。 また、調べてみてMacLISPのような古い処理系では、DOLISTの代わりにMAPCが好んで使われていたことが分かりました。MAPCは、Schemeで言えば、for-eachで、副作用主目的としたmapです。機能としては、あまりDOLISTと変わらないのですが、Lispマシン時代からDOLISTに取って代わられ始め、現在では殆んど使われなくなってしまいました。 また、LOOPはLispマシンから出て来ただけに、Lispマシンでは今より好んで使われていた様子で、今のCommon Lispの処理系より全体に占める割合は多いようです。これも意外でした。 ちなみに、再帰は、統計を取るのが面倒なので、LABELS位にしています。処理系のソースという性質もあるとは思いますが、眺める限りはLispマシン以前では殆ど使われずCommon Lisp以降から少しずつ増え始めている感じです。 以上、非常に下らないですが、統計を取ると存外色んなことが分かって来たりするもんだと思いました。 …分かってくると言っても、全く本質的でない事項だとは思いますが(笑)

2008-03-10

CLOSでL-99 (P08 連続して現われる要素を圧縮)

| 17:24 | CLOSでL-99 (P08 連続して現われる要素を圧縮) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P08 連続して現われる要素を圧縮) - わだばLisperになる

なんとなくのQiでの解答をなんとなくdefgenericで。

(compress '(a a a a b c c a a d e e e e '(foo) '(foo)))
;=> (A B C A D E '(FOO))

(defgeneric compress (lst)
  (:method ((lst null)) ())
  (:method (lst) (compress1 (car lst) (cdr lst))))

(defgeneric compress1 (head tail)
  (:method (head (tail null)) (list head))
  (:method (head (tail cons))
    (if (equal head (car tail))
	(compress tail)
	(cons head (compress tail)))))

QiでL-99 (P08 連続して現われる要素を圧縮)

| 16:47 | QiでL-99 (P08 連続して現われる要素を圧縮) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P08 連続して現われる要素を圧縮) - わだばLisperになる

なんとなくで書いてみました。

(compress [a a a a b c c a a d e e e e])
\=> [a b c a d e]
\

(define compress
    [ ] -> [ ]
    [H T] -> [H] where (= H T)
    [H | [T | U]] -> (compress [T | U]) where (= H T)
    [H | T] -> [H | (compress T)])

ArcでL-99 (P32 最大公約数を求める)

| 16:18 | ArcでL-99 (P32 最大公約数を求める) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P32 最大公約数を求める) - わだばLisperになる

今回はユークリッドの互除法で最大公約数を求めよ、というお題です。

どうも今のところArcは算術系のオペレータは充実してない様子。余りを求める関数が探し出せなかったので自作しました。

(gcd 1071 1029 14)
;=> 7

(def gcd nums
  (reduce 
    (afn (x y)
      (if (is 0 y)
	  x
	  (let r (remainder x y)
	    (if (is 0 r)
		y
		(self y r)))))
    nums))

(def remainder (x y)
  ((afn (x y)
     (if (> 0 x)
	 (+ x y)
	 (self (- x y) y)))
   (abs x) (abs y)))

CLOSでL-99 (P07 リストの平坦化)

| 01:53 | CLOSでL-99 (P07 リストの平坦化) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P07 リストの平坦化) - わだばLisperになる

可能な限りif式を排除して型のディスパッチだけにしてみようということで、補助関数と本体の間で呼び出しあったりしてます。

なんとなくCLOSで解くというよりは、いかにQiの解答を移植するか、という感じになっています。

もしくは、型のディスパッチだけで、どこまで行けるか、みたいな(笑)

(flatten '(1 2 3 4 ((2 (3) 1) 5 6 7 () 8)))
;-> (1 2 3 4 2 3 1 5 6 7 NIL 8)

(defmethod flatten ((lst null)) () )
(defmethod flatten (lst)
  (flatten1 lst (car lst) (cdr lst)))

(defmethod flatten1 ((head cons) tail)
  (append (flatten head) (flatten tail)))
(defmethod flatten1 (head tail)
  (cons head (flatten tail)))

QiでL-99 (P07 リストの平坦化)

| 01:39 | QiでL-99 (P07 リストの平坦化) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P07 リストの平坦化) - わだばLisperになる

今回は、flatten。Qiだと、どうなるのかいまいちはっきりしませんが、なんとなく解いてみました。

(flatten [1 2 3 4 [[2 [3] 1] 5 6 7 8]])

(define flatten
    [ ] -> [ ]
    [X | Y] -> (append (flatten X) (flatten Y)) where (cons? X)
    [X | Y] -> [X | (flatten Y)])

ArcでL-99 (P31 素数かどうかを判定する)

| 01:17 | ArcでL-99 (P31 素数かどうかを判定する) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P31 素数かどうかを判定する) - わだばLisperになる

L-99はリスト篇が終了し今回から算術篇。28から番号が飛んで31番なのですが、一応問題の数としては、31番目にはなっています。

問題の例としては、is-primeという名前になっていますが、処理系の習慣に沿いたいということで、Arcっぽく、primeとしてみました。

コードの内容としては、Qiのチュートリアルを読んでいたら素数判定のコードがあったので、そのまま移植。

(rem ~prime (range 1 100))
;-> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)

(def prime (n)
  (case n
    1 'nil
    2 't
    ((afn (x max div)
       (if (isa (/ x div) 'int) 'nil
	   (> div max) 't
	   'else (self x max (+ 1 div))))
     n (sqrt n) 2)))

2008-03-09

gauche.nightでnlambda (4) 2次会篇 (2)

19:33 | gauche.nightでnlambda (4) 2次会篇 (2) - わだばLisperになる を含むブックマーク はてなブックマーク - gauche.nightでnlambda (4) 2次会篇 (2) - わだばLisperになる

そんなこんなで、新橋に移動。

20名程の大所帯となりました。大所帯な為になかなか場所が決まりませんでしたが、素晴しい手配により場所、決定。

この間、世代が近いnaoya_tさん等と昔のPCについて思い出話をしていました。

場所に移動し、人数が多かったためメインとサブの方に分散して着席

自分は、コアな方々と話をするネタもないので、離れ小島の方へ。

離れ小島には、λ組の皆様とmasa_edwさんが集まり、SWI-Prologが『銀河ヒッチハイク・ガイド』のパロディで、万物の答え42を出すというネタや、ザリガニの脱皮失敗について等あんまりSchemeと関係ないで盛り上がりました。

下らないネタばかり投稿して申し訳ありませんでした(笑)

そんななかで、zickさんが、何かの拍子にnlambdaということを口にしたので、それって、昔の引数を評価しないというnlambdaですか、ときいてみたところ、そのことだとのこと。

指南された方が、1980年代のテイストが好きな方だったそうで、zickさんの「マクロはどうやって実装すれば良いんですかね?」という問に、「ああ、nlambda使えば良いんじゃない?」というお答えでnlambdaを実装することになったということ。

その流れが、普通でない。また、Prologを使うようになったきっかけも、その方のご指南ということだそうですが、色んな意味で凄い!

こういうところ大切にして欲しい!(笑)

ちなみにnlambdaとは、

((nlambda (x) (list x)) foo)
;-> (foo)

のようなもので、こういうのは、fexprと呼ばれ、LISP1.5、INTERLISPMacLISP等、以前の処理系にはfexprをサポートするものがありました。この中で、INTERLISPでは、fexprをnlambdaと呼びます。

INTERLISPにはマクロがないのですが、引数を評価しないnlambdaがあるので、マクロのようなことが可能、という訳で、そういう指南だった訳です。

帰宅して、地獄Lispと地獄Schemeにnlambdaはあるのかなと、実行してみたら、これらにもnlambdaがちゃんとありしました!

何から何まで、他とは違う視点で、かつ結果を出してるってのが、何より凄いなと思いました。

また、Lispが純粋関数型でないところとして、代入があるところと、クオートがあるところ、という話で、代入については分かるけど、クオートが駄目な理由が分からないという話をしたところ、zickさんも、どっかでそういう話をきいたことがあるとのことだったので、shiroさんがに質問できそうなネタといえばこれ位なので、記念に質問してみました。

答えとしては、別にクオートが駄目ということではなく、その人がどう定義しているかによるのではないか?とのことでした。なるほど!

とりあえず良い記念になりました(笑)

そんなこんなで2次会もお開きになり、撤収。

theoriaさんが良い感じに出来上がっていて非常に楽しかったです。

解散の際に、そもそもhayamizさんのλデートに誘われた意味がずっと分からなかったので、訊いてみたところ、「Lispについて、詳しそうだったから…」とのこと。

これもまた、裏切ってしまうことになり非常に申し訳ない!(笑)

あと、S式Dylanが評判良さそうなのが意外でした。

前にマニュアルのリンクを貼っていたと思いましたが、貼ってなかったので、貼ってみます。

皆さん今度は、是非S式Dylanを実装して下さい!

その後、同じ電車のhogelogさんと、プログラミングについてのスタンスや、FPGAの話をしつつ帰宅となりました。

振り返ってみると、思ったより色々な方とお話できて、非常に楽しい時間でした!

自分は変な話しかできませんでしたが、また、何かの機会があれば、またお話して下さい。

gauche.nightでnlambda (3) 2次会篇 (1)

19:33 | gauche.nightでnlambda (3) 2次会篇 (1) - わだばLisperになる を含むブックマーク はてなブックマーク - gauche.nightでnlambda (3) 2次会篇 (1) - わだばLisperになる

イベントも終わりこの後どうするのかと動向を伺いつつ、とりあえず駅へ移動。

この間にbulbさんとxyzzy方面のことについてお話することができました、今後ともよろしくお願いします!

そんなこんなしているうちに新橋で2次会をするという流れになり移動開始。

黒田さんやsanoさん達は、新宿に集まるけど、どうかというお誘いがあり、うおー、黒田さんとお話してみたいと、非常に悩みましたが、先に新橋組と約束してしまったので、新橋の方へ行くことにしました。後で、theoriaさんにそのことを話したところ、ああ、じゃあ一緒に新宿すれば良かたねえ、ということに。

sanoさんの日記によれば、TLUGと合流されたようで、当初2次会はTLUGと合流するのはどうか、という案もあったので、確かに残念でした。

そんなこんなで、電車移動。移動中higeponさんと話す機会があり、自分が「話をしてみたい人リスト」に載っていた理由がいまいち分からなかったのできいてみたところ、Lispマシンことについて書いてるということが印象に残ったということでした。

確かにhigeponさんのSchemeシェル/MONA OSとLispマシンの方向性には非常に近いものがある、と自分も思っていたので納得!

Lispマシンのシェルの動作や、ファイルシステムについて何点か質問して頂きましたが、自分はつっこんだ内容については疎くて、お力になれず非常に申し訳ないです!

また、Lispマシンのファイルシステムの名前空間についてですが、この辺は、Common Lispにも受け継がれているので、この辺を参照して頂くとはっきりするかと思います。

名前空間が分かれているかどうかについては、非常に適当な説明をしてしまった気がしますが、もしかして分かれてはいないのかもしれません…。

ホスト、デバイス、パス等を指定できるのは確かで、様々なOSやネットワーク接続に対応できるような構造になっているのは確かなのですが…。

また、同じパス名は同一のオブジェクトになって、eqで判定できたり色々あるようです。

また、Schemeシェルでは、GUIでファイル操作をする予定とのことでしたが、そういえば、LispマシンにもGUIのインターフェースがあったな、と書いていて気付いたので、リンクを貼っておきます。

ここに置かれているビデオ Video 4、(ファイル名lispm3.mov)では、Lispマシンのシェル操作、Explorerのようなファイル操作インターフェースを解説しています。

また、 Video 3(ファイル名lispm2.mov)では、話に出て来た、グラフィック描画したオブジェクトをマウスで掴んで評価したり、という説明があります。

いづれにせよ、ここのビデオは、もれなくLispの開発環境製作者、Lispシェル製作者には参考になるんじゃないかと思うので、是非全部視聴されることをお勧めしたい!と個人的には思っています。

gauche.nightでnlambda (2) イベント篇

18:35 | gauche.nightでnlambda (2) イベント篇 - わだばLisperになる を含むブックマーク はてなブックマーク - gauche.nightでnlambda (2) イベント篇 - わだばLisperになる

発表者の方々は早めに会場入りしなくてはいけないということで、会場に移動。

しかし、一般客は会場には入れないので、会場前で雑談。

新潟からお越しのshiroさんのエッセイファンの方と昔のPCについて語ってました。

ここで、CADRグループのmokeheheさんとも合流することができました。

120人集まるということで、当日会えなかったらどうしようと、心配していましたが、一発で発見できて良かったです!

そんなこんなで、イベント開始、λデートに参加する予定だった、masa.edwさん、mokeheheさん達と一緒の席に。

また、sanoさんのお蔭でCADRグループに参加の現在PAIP日記を書いているbulbさんともお会いすることができました!

masa.edwさんは前回のイベントにも参加されたということで、前回の様子の逐次説明織り交ぜつつ解説して頂き非常に面白かったです。

黒田さんは、今回も切れの良いツッコミで会場を沸かせていました。

非常に本質的で、また、昔からLISP/Schemeを知らないと出てこないような視点なので、本当に貴重だと思います。

ただ、毎回思うのは、Common Lispの知識を前提をとした説明が多い気がします。…当たり前か(笑)

まあ、内容は、後で調べれば良いので、その分濃縮されていて良いとも思いますが…。

黒田さんのツッコミの内容は色々なところで纏められると思うのでそちらを参照して下さい(笑)

そして、Gaucheゴングですが、λデートでは、大人しかった、hogelogさんが、もの凄いハイテンションな人格に変わり突っ走っていたので、びっくりしました。

発表もGacheから外の機能を呼び出すのではなく、外からGaucheを呼び出す事例ということで、Gauche本来の設計思想をしっかりと活かした、素晴らしいものだと思いました。

そして、ゴングも終わり、サイン会的な流れになりつつ、雑談。

yharaさんを掴まえて、私の趣味であるレトロコンピューティングについて延々と思い付いたことを片っ端から話してました。

役に立たないことばかり喋っていて申し訳ありませんでした(笑)

話に出て来たAI Memoですが、下記のリンクから辿れます。DSpaceの方は検索もできて非常にお手軽で、過去の偉人達のメモが大量に読めるので是非若い方々にもお勧めしたいです! 最初のSchemeの論文などもAI Memoに含まれています。

gauche.nightでnlambda (1) イベント前篇

18:35 | gauche.nightでnlambda (1) イベント前篇 - わだばLisperになる を含むブックマーク はてなブックマーク - gauche.nightでnlambda (1) イベント前篇 - わだばLisperになる

gauche.night観覧してきました!

イベント前にhayamiz氏主催のλデートという集会に流れゆくまま参加。

hayamizさん、higeponさん、gemmaさん、theoriaさん、lequeさん、hogelogさん、yharaさん、sanoさん等、はてな周辺に君臨する主の皆さんとお会いました。

皆さん緊張の為かそれ程つっこんだ話には進まず。

sanoさんはCommon Lispの方でXyzzyのWikiで知っていました。

CL周辺の方ということで、CLもGaucheみたいにコミュニティがどんどんが育って行くと良いですよねというような話に。

しかし、自分の基本的に人生に対して後ろ向きなところにガッカリされていたようです。

いやはや、CLコミュニティに貢献できないような不甲斐なさで申し訳ない(笑)

勿論、自分ができるところは、コミットさせて頂きたいのですが、今のところ自分ができることは、このブログでCLのことを書く位だと思っています。

この辺から徐々になにかをして行ければと思っています!

またsanoさんは、近所の方ということで、区内の図書館に絶版の「bit別冊 Common Lisp オブジェクトシステム -- CLOSとその周辺」があるんですよ、という話をしたところ、sanoさんも全く同じ本を区の図書館から借りてたとのことで、世界は狭いもんだと感心しました。

hayamizさん、higeponさん、gemmaさん、theoriaさん、hogelogさん、yharaさんとはあまり話せず。

lequeさんとは、lequeさんがはてなの日記を旧漢字旧仮名遣いで書いているので、自分も高校3年間、旧漢字旧仮名遣いでノートを取ってましたという、あんまりSchemeに関係ない話をしてました(笑)

2008-03-08

今日はgauche.night

10:54 | 今日はgauche.night - わだばLisperになる を含むブックマーク はてなブックマーク - 今日はgauche.night - わだばLisperになる

自分は、黒いパーカーに右膝のところだけ破れたジーパンというみすぼらしい、175cm位のおっさん、という格好をしています。

良かったら声でも掛けてみて下さい!

声が掛けにくい場合、「東京テレポート駅は、どこですか?」

と訊いてもらえれば、

「すいません、地元の人間ではないもので…、地元の人間ではないもので、すいません」

と答えたら、私です。

QiでL-99 (P06 リストの中身が回文的かを調べる)

| 10:33 | QiでL-99 (P06 リストの中身が回文的かを調べる) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P06 リストの中身が回文的かを調べる) - わだばLisperになる

これまた普通に。Qiの述語命名規則的には、Schemeのように最後に?を付けるようなので、そういう雰囲気で。

また、真偽値は、trueとfalseになっています。

(palindrome? [x a m a x])
\-> true
\

(define palindrome? 
    X -> true where (= X (reverse X)))

2008-03-07

明日はgauche.night

16:54 | 明日はgauche.night - わだばLisperになる を含むブックマーク はてなブックマーク - 明日はgauche.night - わだばLisperになる

明日はgauche.nightですが、参加されるCLerの皆さんは、gauche.night前後で会合などあったりするのでしょうか?

自分は、流れゆくままイベント前に猛者Schemerの方々の会合に畏れ多くも参加することになったのですが、CLer集会があるならば、途中参加かもしれませんが、是非参加したいです!

いずれにせよ、CADRグループでイベント参加の方々にご挨拶位はしたいなとは思っているんですが…。

どうやって探せば良いのかしら…。とりあえず、現場で叫ぶか(笑)

CLOSでL-99 (P05 リストを逆転させる)

| 14:56 | CLOSでL-99 (P05 リストを逆転させる) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P05 リストを逆転させる) - わだばLisperになる

Qiで解答を書いていて、これはCLOSの総称関数の書き方に近い気がするなあ、と思ったのでテスト投稿。

といっても、ifの代わりに型でディスパッチしてるだけですが…。

効率については良く分かりませんが、デバッグについては、面倒になってる気がします(笑)

(rev '(1 2 3 4 5 6 7 8))
;-> (8 7 6 5 4 3 2 1)

(defgeneric rev (lst)
  (:method ((lst null)) () )
  (:method ((lst cons)) 
    (append (rev (cdr lst)) (list (car lst)))))

;; もしくは
(defmethod rev ((lst null)) () )

(defmethod rev ((lst cons))
  (append (rev (cdr lst)) (list (car lst))))

QiでL-99 (P05 リストを逆転させる)

| 14:39 | QiでL-99 (P05 リストを逆転させる) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P05 リストを逆転させる) - わだばLisperになる

これまた定番な感じで。

Qiには標準で、reverseがあります。

(rev [1 2 3 4])
\-> [4 3 2 1]
\

(define rev 
    [ ] -> [ ]
    [H | T] -> (append (rev T) [H]))

ArcでL-99 (P28b 子リストの長さの頻度順で整列)

| 12:35 | ArcでL-99 (P28b 子リストの長さの頻度順で整列) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P28b 子リストの長さの頻度順で整列) - わだばLisperになる

P28も前半と後半に分かれているのを忘れていました!

リスト篇はP28までなのですが、一つの問題が前後半に分かれているものが2つあるので問題の総数としては、30問あるということになります。

今回は、子リストの長さの頻度順で整列させるというもの。以前に定義した、packと、lsortを使用してみました。

何回もソートしてるんですが、もっとすっきり書く方法があるんじゃないかと思います。

(lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
;-> ((o) (i j k l) (a b c) (f g h) (d e) (d e) (m n))

(def lfsort (lst)
  (let freq len-freq.lst
    (sort (fn (x y) (< (pos len.x freq) (pos len.y freq)))
	  lst)))

(def len-freq (lst)
  (map car (lsort:pack (map len lsort.lst))))

2008-03-06

昔のLISPの関数名に記号が使われないのはなぜなのか

| 12:17 | 昔のLISPの関数名に記号が使われないのはなぜなのか - わだばLisperになる を含むブックマーク はてなブックマーク - 昔のLISPの関数名に記号が使われないのはなぜなのか - わだばLisperになる

昔のLISPの関数名(昔といっても、Lisp 1.5の話なのでかなり古いです)は(- 3 2)ではなく、(difference 3 2)と書きました。このように、やたら長いスペルの関数名はあるものの直感的に思い付くような-や+記号というのは、まったく見掛けません。

以前から何でなんだろうなあ、と思っていたのですが、昨日のifや、condのエントリで、M式を書いていて、もしかしたら!という理由を思い付きました。

それは、M式で書くと、

difference[3;2]

と書くのは、まあ普通に見て状況を把握できますが、

-[3;2]

だと、何が何だか良く分からない、ということなんじゃないかなと。

M式以外にも、Eval quoteという表記方法があるんですが、これはトップレベルは、M式のように書くというもの。Lisp 1.5や、INTERLISPで可能な表記形態だったのですが、これも同様に、

difference(3 2)

は良くても

-(3 2)

は何となく変。INTERLISPにも記号で書いた方が完結な長い関数名がずっと残っていましたが、この辺をずっと継承していたからなのではないか?!ということなのですね。

…しかし実際のところ、真相は知る由もございません。

以上、重箱の隅過ぎてトリビアにさえならないネタでした。

ちなみに改めて確認したところ、INTERLISPでは中間記法が使え、その場合は記号が使えました。

ということで、トップレベルでは、

3 - 2

と書くと、1となります。

お馴染のfibはINTERLISPだと

defineq((fib (n)
	     (if (lessp n 2)
	       then
		 n
	       else 
		 (fib n - 1) + (fib n - 2))))

fib(15)
;-> 610

と書けます。

ArcでL-99 (P28a リストを子リストの長さ順で整列)

| 11:55 | ArcでL-99 (P28a リストを子リストの長さ順で整列) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P28a リストを子リストの長さ順で整列) - わだばLisperになる

今回は、リストを子リストの要素数で昇順に整列させるというお題です。

Arcには備え付けでsortがあり、それを使った方が効率が良いとは思うのですが、sortを自作させるのが主旨なんだろうなということで再帰のqsortで書いてみました。

なお、Arcのsortは引数の順番がCommon Lispとは逆のようです。

(lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
;=> ((o) (d e) (d e) (m n) (a b c) (f g h) (i j k l))

(def lsort (lst)
  (if no.lst
      ()
      (let piv (len car.lst)
	(+ (lsort:rem [<= piv len._] cdr.lst)
	   (list car.lst)
	   (lsort:rem [> piv len._] cdr.lst)))))

;; sort使用
(def lsort (lst)
  (sort (fn (x y) (< (len x) (len y)))
	lst))

QiでL-99 (P04 リストの要素の個数を数える)

| 10:58 | QiでL-99 (P04 リストの要素の個数を数える) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P04 リストの要素の個数を数える) - わだばLisperになる

これまた普通な書き方で。

Qiには備え付けでlengthがあるようです。

(len [1 2 3 4 5 6 7 8])
\-> 8
\

(define len
    [ ] -> 0
    [_ | T] -> (1+ (len T)))

QiでL-99 (P03 リストのK番目の要素を取り出す)

| 04:07 | QiでL-99 (P03 リストのK番目の要素を取り出す) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P03 リストのK番目の要素を取り出す) - わだばLisperになる

いまいちQiの流儀というかパターンマッチが分からず、普通のLISPみたいに書いてしまっていますが、これで良いんでしょうかねえ。

(element-at [a b c d e] 3)
\ -> c
\

(define element-at 
    List Pos -> [ ] where (or (< Pos 1) (< (length List) Pos))
    List Pos -> (element-at* List 1 Pos))

(define element-at*
    [ ] _ _ -> [ ]
    [X | _] Cnt Lim -> X where (= Cnt Lim)
    [_ | X] Cnt Lim -> (element-at* X (1+ Cnt) Lim))

2008-03-05

cond、ifの変遷

| 19:20 | cond、ifの変遷 - わだばLisperになる を含むブックマーク はてなブックマーク - cond、ifの変遷 - わだばLisperになる

ポール・グレアム氏のコア言語としてのArcについての最近のエッセイで、condの括弧の多さへの批判と、これを放置していたのは、既存の価値観に捕われていた所為じゃなかろうか?のような指摘があったのですが、いやいや、condや、ifも色々面白い変遷があったようだし、そうでもないんじゃないか?、と思ったので、適当に纏めてみました。

もちろんPGはそういうことが言いたいんじゃない!ということになろうかと思いますが、私は、プログラミングに興味はあまり無く、言語の歴史や変遷に興味があるので(笑)

まず私のスタンスですが、condの括弧は多いとは感じません。R6RS風の角括弧も読み難く感じます。この辺は全く感覚的なものだと思うので、どうしようもないですね。どこにも理由がないし(笑)

ということで、Arcのifはcondより読み難いと思っていて、cond万歳な価値観であり、下記にもそういうバイアスがかかっていると思います。

それはさておき、cond、ifの歴史的変遷を眺めてみたいと思います。

M式 1958年頃

[a[B;C] → prog2[d[E;F];g[H;I];
 j[K;L] → (M N O);
 T → prog2[p[Q;R];s[T;U]]

まず一番最初は、M式ですが、別にcondという名前もifという名前も付いていなくて、[]で纏められた条件式の集まりです。条件が真ならば、→の右側が評価されます。式はセミコロンで区切られます。

また、'(a b c)は、(A B C)と表現され、(list 'a 'b 'c)は、list[A;B;C]と表現されます。つまり括弧が2種類あって意味的に違ったものを表現しています。

無理にS式風に書いてみると、

[(a b c)(prog2 (d e f) (g h i))
 (j k l)'(m n o)
 'T(prog (p q r) (s t u))]

という感じです。つまりM式は既にR6RS風であり、また、PGが問題にしている括弧の多さ問題もなかった訳ですね。まあ、代わりに矢印があるわけなのですが。

上記を当時のS式で書くと

;; S式
(cond ((a b c) (prog2 (d e f) (g h i)))
      ((j k l) (quote (m n o)))
      ((quote t) (prog2 (p q r) (s t u))))

となります。condの実行節が暗黙のprognになっているかどうか不明なのですが、自分がエミュレータ試しても、論文を眺めても暗黙のprognになっているという記載は見当たりません、また、省略されるとnilが返るということもなく、省略できません。この辺本当はどうだったんでしょう。PG氏は、暗黙のprognだった、って書いてるんですけども…。M式でも暗黙のprognってどう表現して良いか分からないし。

それはさておき、ここからずっと下って、1978年頃なのですが、IFが登場して来ます。

MacLISP、Zetalisp、Emacs Lisp 1978年頃

(if (a b c)
    (progn
	(d e f)
	(g h i))
    (if (j k l)
	'(m n o)
      (p q r)
      (s t u)))

CONDがあるので、こういう書き方はされないのですが、敢えて書くとこうなります。

else節が暗黙のprognになっていますが、

(defmacro if (pred then &rest else)
  `(cond (,pred ,then)
	 (t ,@else)))

のようなcondに展開されるマクロになっているので、おまけでそうしてるんじゃないかと思ったりします。

このifの由来ですが、The Evolution of Lispによれば、schemeからの影響じゃないだろうかとのことで、Schemeには、1975の最初からifが存在します。

これは、else節は暗黙のprognになっていません。

SCHEME 1975年

(IF (A B C)
    (lambda ()
      (D E F)
      (G H I))
    (if (J K L)
	'(M N O)
	(lambda ()
	  (P Q R)
	  (S T U))))

これまた、若干無理矢理な書き方で、こういう時は素直にCONDを使うようです。

…ということで、最初の20年位はifがなく、whenやunlessと登場時期は一緒だったようなのですね。

MacLISP Multics Emacs 1978 / Bernard S. Greenberg

そういう経緯もあり、1980年台初頭位まで、LISPにおいてのifの首はまだ座っておらず、変種が結構あります。

(if (a b c)
    (d e f)
    (g h i)
    else
    (if (j k l)
	'(m n o)
	else
	(p q r)
	(s t u)))

これは、Multics Emacsの中のifマクロの例。

elseで区切り、then節もelse節も暗黙のprognになっています。

Franz Lisp 1980頃? John Foderaro

(if (a b c)
    then (d e f)
         (g h i)
  elseif (j k l)
         '(m n o)
    else (p q r)
         (s t u))

これは、Franz Lispのifマクロの例。Franz Lispの処理系のソースでは、condが殆ど使われておらず、殆どこのifマクロです。

最近のAllegro CLでも、if*として存在しています。

このifマクロは、condと機能的に完全に等価で、(if 'foo thenret)と表現することにより、(cond ('foo) )のようなことも可能です。

また、多重の括弧の読みやすさへの配慮として、R6RS風に角括弧も使えました。

(cond [(a b c) (prog2 (d e f) (g h i))]
      [(j k l) '(m n o)]
      ['T (prog2 (p q r) (s t u))])

INTERLISP

また、Interlisp系でもいつ頃なのかはっきりしませんが、

(if (a b c)
    then
    (d e f)
    (g h i)
    else
    (if (j k l)
	then
        '(m n o)
        else
	(p q r)
	(s t u)))

のように書けるようになりました。thenとelseのキーワードがあり、どっちの節も暗黙のprognです。

Common Lisp 1984

それで 1984年 Common Lispですが、Schemeと同じく実行節は暗黙のprognになっていません。

(if (a b c)
    (progn
	(d e f)
	(g h i))
    (if (j k l)
	'(m n o)
	(progn
	  (p q r)
	  (s t u))))

Arc 2008年

そして、2008年 Arcは、condから各節の括弧を省略した形をifという名前にしました。

(if (a b c)
     (do (d e f)
	 (g h i))
    (j k l)
     '(m n o)
    (do (p q r)
	(s t u)))

という風にcond、ifにも色々あったようなのです。

今日の状況からすれば、プログラミングをLISPから入門するということはないと思われ、condは異質なものと感じられることが多いと思います。

cond自体もifに展開されるマクロとなり、なんとなく寂しいですね。

…いや、別に寂しくはないか(笑)

2008-03-04

QiでL-99 (P02 最後の要素をリストにして返す)

| 18:50 | QiでL-99 (P02 最後の要素をリストにして返す) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P02 最後の要素をリストにして返す) - わだばLisperになる

そのうちこのブログはL-99ばっかりになりそうな予感が!

(last-but-one [1 2 3 4])
\-> [4]
\

(define last-but-one
    [] -> []
    [X | []] -> [X]
    [_ | X] -> (last-but-one X))

QiでL-99 (P01 リストの最後の要素)

| 18:49 | QiでL-99 (P01 リストの最後の要素) - わだばLisperになる を含むブックマーク はてなブックマーク - QiでL-99 (P01 リストの最後の要素) - わだばLisperになる

割と自分は一度に色んな物に手を出して全部失敗する口なのですが、その流れを継承してQiにも手を出してみることにしました。

Qiは…何か凄そうなLISPの方言みたいです。自分は良く分かっていません。

型の扱いとか、パターンマッチとか色々特徴はあるようです。

自分的にはProlog的なパターンマッチが面白そうだったので手を出してみました。

そういう意味では、TAOは、PrologとSmalltalkとLISPが合体しているので、TAOを使ってみたいもんだと思います。

ヤフオクとかにELISが出品されたりしないですかね(笑)

(last [1 2 3 4])
\-> 4 
\

(define last
    [] -> []
    [X | []] -> X
    [_ | X] -> (last X))

ArcでL-99 (P27b リストを任意の比率で分割した組み合わせ)

| 14:09 | ArcでL-99 (P27b リストを任意の比率で分割した組み合わせ) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P27b リストを任意の比率で分割した組み合わせ) - わだばLisperになる

今回は、前回の続きです。

リストを任意の比率で分割したすべての組み合わせをリストで返すというお題なのですが、多分、L-99のリスト篇では一番ややこしいんじゃないかと思います。

(1 2 3 4 5)というリストで、2:3に分ける場合、((1 2) (3 4 5) )と((2 1) (4 3 5) )は同じものとみなされますが、((1 2) (3 4 5) )と((3 4 5) (1 2) )は別物という扱いになります。

解答には、前に定義したcombinationと、setdiffを使用しています。butlastも見当たらないので、自作しました。

かなり混沌としていますが、私の実力では、最早これが正しいのかさえ良く分かりません(笑)

どう書くorgにはこういうのささっと綺麗に解く人が沢山いるんですよね。あやかりたい。あやかりたい。

(group '(aldo beat carla david evi flip gary hugo ida) '(2 3 4))
;=> (((aldo beat) (gary hugo ida) (carla david evi flip)) ...)

(len (group '(aldo beat carla david evi flip gary hugo ida) '(2 3 4)))
;=> 1260

(def group (lst pat)
  ((afn (lst pat)
     (if (or no.pat (~<= 0 (apply + pat) len.lst)) () 
	 (is len.lst car.pat) list.lst
	 (is 1 len.pat) (sep2 lst car.pat)
	 'else (sep2-list (self lst cdr.pat) car.pat)))
   lst rev.pat))

;; リストを2つに分ける
(def sep2 (lst num)
  (map [list _ (setdiff lst _)]
       (combination num lst)))

;; 複数のリストを2つに分けて、それを継げたリストを返す
(def sep2-list (lsts num)
  (let res ()
    (each l lsts
      (= res (+ (map [if cadr._
			 `(,@butlast.l ,@_)
			 `(,@butlast.l ,car._)]
		(sep2 last.l num))
		res)))
    res))

(def butlast (lst)
  (cut lst 0 (- len.lst 1)))

2008-03-03

ArcでL-99 (P27a 9人を2:3:4に分ける組み合わせ)

| 13:40 | ArcでL-99 (P27a 9人を2:3:4に分ける組み合わせ) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P27a 9人を2:3:4に分ける組み合わせ) - わだばLisperになる

P27はaとbの二段構えなのですが、今回は、9人を2:3:4に分けるすべての組み合わせをリストで返すというお題です。

組み合わせ系は総数が爆発的に増えたりすることが多く、非常に苦手です…。

ということで、解答も結構やっつけになってしまっています…。

解答には、前回定義したcombinationを使用しています。

CLでいうset-difference、SRFI-1でいうlset-differenceがArcで見付けられなかったので、MacLISPのsetdiffを参考に作成しました。

また、pointは、Schemeのlet/ccに相当するようです。

(group3 '(aldo beat carla david evi flip gary hugo ida))
;=> (((aldo beat) (carla david evi) (flip gary hugo ida))
;    ((aldo beat) (carla david flip) (evi gary hugo ida))
;    ((aldo beat) (carla david gary) (evi flip hugo ida)) ...)

(len (group3 '(aldo beat carla david evi flip gary hugo ida)))
;=> 1260

(def group3 (lst)
  (let res ()
    (each u (combination 2 lst)
      (let diff (setdiff lst u)
	(each v (combination 3 diff)
	  (= res `(,@res (,u ,v ,(setdiff diff v)))))))
    res))

(def setdiff (x y)
  (point exit
    (each yy y
      (when (mem yy x)
	(exit (y-x+z x y () ))))
    x))

(def y-x+z (y x z)
  (let y-x ()
    (each xx y
      (or (mem xx x) (push xx y-x)))
    (= y-x (join (rev y-x) z))))

2008-03-02

ArcでL-99 (P26 リストから指定した個数を抜き出す組み合わせ)

| 16:38 | ArcでL-99 (P26 リストから指定した個数を抜き出す組み合わせ) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P26 リストから指定した個数を抜き出す組み合わせ) - わだばLisperになる

今回は、リストから指定した個数を抜き出す組み合わせの作成がお題です。

個人的に組み合わせ問題は苦手で考えているとめまいがしてきます…。

(combination 3 '(a b c d e f))
;=> ((a b c) (a b d) (a b e) ...)

(len (combination 3 (range 1 12)))
;=> 220

(def combination (n lst)
  (let llen (len lst)
    (if (or (is n 0) (> n llen)) ()
	(is n llen) `(,lst)
	(is n 1) (map list lst)
	'else `(,@(map (fn (l) `(,car.lst ,@l))
		       (combination (- n 1) cdr.lst))
		,@(combination n cdr.lst)))))

2008-03-01

世の中にONEPは必要か?

| 10:48 | 世の中にONEPは必要か? - わだばLisperになる を含むブックマーク はてなブックマーク - 世の中にONEPは必要か? - わだばLisperになる

今回のエントリもくだらないネタなのですが、ONEPは世の中に必要なのかどうか、それが無性に知りたくなりました。

ONEPはZEROPの兄弟で、1かどうかを調べるものです。

ONEPは実はLISP 1.5にも存在し、その歴史は非常に古くもうすぐ50歳にもなろうかという大物なのです。

しかし、歴史の荒波に揉まれているうちにいつのまにやら姿を消してしまいました。

調べてみたところでは、標準でonepが存在した処理系は、LISP 1.5、UCI LISP、Franz Lisp等が確認できましたが、MIT系にはどうやら存在しなかったようで、その流れを引き継いだのかCommon Lispにも存在しません。

それで、存在意義を確かめてみたいと思い立ち、(= 1 ~)はどれだけ書かれているかを調べてみました。

ソース 1との比較zerop prog2onep/zerop=全体に占める割合
Google ソースコード検索 4000 19700400 1/5 5%
ラドガース大学のPDP-10用のCL26 77 0 1/5 11.5%
MIT CADR Lispマシン 178 1055 22 1/6 7%

ここで、比較対象にprog2を選んだ理由ですが、ANSI CLに無駄だと思うものを一つ挙げよ、と言われたときに個人的に真っ先に思い浮ぶのが、prog2ということでprog2にしてみました。prog1とprognの組み合わせで、prog2は置き換え可能だし、後方互換の維持という面でも役に立ってないと思われるので…。

それはさておき、=における1との比較ですが、上記のソースでは全体の5%〜12%位だったりして意外に多いんだなと感心しました。

zerop比べても約1/6位の様子。

まとめ

ということで、以上から、ONEPは世の中に必要なんだ! ということにしておきたいと思います。

新しい処理系を作るみなさんは是非一度onep、one?、1=などの採用をご検討なさってはいかがでしょうか!

ArcでL-99 (P25 ランダムに並び換え)

| 07:41 | ArcでL-99 (P25 ランダムに並び換え) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P25 ランダムに並び換え) - わだばLisperになる

今回は、リストの内容をランダムに並び換えるというお題です。

ヒントとしては、P23で定義したrnd-selectを使う、とのこと。

前回rnd-selectの出力をちょっと変更して、

(rnd-select '(a b c d e f) 1)
;=> ((e) (f c b d a))

のようにしましたが、中身を一つのリストにしてしまえば今回の目的に適うので、joinでくっつけて終了。

(rnd-permu '(a b c d e f))
;=> '(e f c b d a)

(def rnd-permu (lst)
  (apply join (rnd-select lst 1)))