初めての人のためのLISP - 第9講 デートの前にリストの切り貼り

初めての人のためのLISP[増補改訂版]のメモです。
すんなり理解出来ない部分が増えるほど長くなる。
最初:初めての人のためのLISP (第1講-第5講) - もうカツ丼でいいよな

alist形式の辞書と題付きリスト

次の辞書がphoneという変数に入っているとする。

((reiko 3 712 5648)
 (kimiko 424 86 1416)
 (junko 3 432 7601)
 (fukumi 425 92 293)
 ...
 (akemi 3 583 3198))

これは見出し語とそれに対応する電話番号を表すリストのドット対からなるalistだが、ドットの右側がリストの時はドットと括弧を省略できるので上のような表現になっている。
各要素のリストのcarはリストのタイトルとみなすこともできるので、このようなリストを題付きリストと呼ぶ。式も関数名と引数のリストのドット対と考えることができるので、これも題付きリストと呼ぶ。

alist中の要素を更新する

xの番号をyに更新する関数update-phone。

 (defun update-phone (p x y) ; pは電話番号のalist
        (cond ((null p) nil) ; pの最後までみてxが見つからなければnil
              ((eq (caar p) x) ; pの先頭要素のcarがxに等しければ
               (cons (cons x y) (cdr p))) ; xとyをconsして作成した要素で先頭を更新
              (t (cons (car p ) (update-phone (cdr p) x y))))) ; pの調べる要素を一つ後ろへずらして再帰

セルの中身書き換えるだけで大げさ…

そんなあなたにrplacaとrplacd

consが新しいセルに受け取った内容を入れるように、rplacaとrplacdはセルの中身を受け取った内容に置き換える。

  • rplaca: セルのcar部を書き換え。replace car。ルプラカ。
  • rplacd: セルのcdr部を書き換え。replace cdr。ルプラクド。

以下それぞれxの指すセルorリストをyで書き換える。実行すると既存のリストの構造を変えることになるのでその点は注意。

(rplaca x y)
(rplacd x y)

rplacdを使ってupdate-phoneを改良

rplacdを使うと辞書を更新する関数が簡潔に記述できる。

(defun update-phone (p friend number)
       (rplacd (assoc friend p) number) ; p中のfriendを含む要素のcdrをnumberで置き換え
       p) ; 更新後のpが返るようにしておく

ただしこれだとfriendがp中に見つからなかった場合エラーとなる。nilにrplacdは適用できない。
次のようにすればp中にfriendが見つからなかった場合に引数を新たな項目としてalistに追加するようになる。

(defun update-phone (p friend number)
       (prog (f.n)
             (setq f.n (assoc friend p)) ; pからfriendを含むドット対を探してf.nにセット(なければnilセット)
             (return
                (cond (f.n (rplacd f.n number) p) ; f.nがnilでないならこれを通じてリストを更新したのちpを返す
                      (t (cons (cons friend number) p)))))) ; f.nがnilならpに入力された引数を新たな項目として追加

リストから要素を削除

最初のupdate-phoneと同じ考えで、最初に見つかった要素を削除したリストのコピー(コピーされるのは見つかった場所より前の要素のみ)を返すremove-1を定義。

(defun remove-1 (x y) ; yからxを削除
       (cond ((null y ) nil) ; yの最後まで行ってしまったらnil
             ((eq (car y) x) (cdr y)) ; yのcarとxが等しかったらyのcdrを返す
             (t (cons (car y) (remove-1 x (cdr y)))))) ; yのcarをどけておいてyのcdrに対し再帰適用

指定した要素とeqで比較して等しいと判断されたトップレベルの要素全てを取り除くremove。

(defun remove (x y)
       (cond ((null y) nil) ; yの最後まで行ってしまったらnil
             ((eq (car y) x) (remove x (cdr y))) ; carにxが現れたら取り除いて再帰
             (t (cons (car y) (remove x (cdr y)))) ; carにxが現れなければcarを横に置いといて再帰

delete-1、deleteをrplacdで改良

リストを一つずつ削りながら探索していって削除したい要素が見つかったとき、その要素は既にcarに来てしまっている。cdrでcarを取り除いてみてもセットする先がない。そこで、セットする先として「一つ削る前のリスト」を常に記憶しておく。
目的の要素がヒットしたとき、「一つ削る前のリスト」のcadrには削除したい要素が来ている。そこで「一つ削る前のリスト」のcdr(carにに削除したい要素がある)を「一つ削った後のリスト」(carに削除したい要素がある)のcdrで置き換えれば目的が達成できる。ここにrplacdが使用できる。

(defun delete-1 (x y)
       (cond ((eq (car y) x) (cdr y)) ; 第0要素にヒットしたら単にyのcdrを返す。
             (t (del2 x (cdr y) y) y))) ; 変数を一つ追加。返り値にyを指定。
(defun del2 (x y z)
       (cond ((null y) nil) ; yの最後まで見てしまったらnil
             ((eq (car y) x) (rplacd z (cdr y))) ; yのcarがxだったらzのcdr(先頭がx)をyのcdrで置き換える
             (t (del2 x (cdr y) y)))) ; yをcdrにし、古いyをzに保存しておいて再帰

上記関数中のdelete-1は次のようにも書ける。

(defun delete-1 (x y)
       (setq y (cons 'dummy y)) ; yの頭にダミーをくっつける
       (del2 x (cdr y) y)       ; 一つ前のリストとしてダミー付きのyを渡す
       (cdr y))                 ; ダミーは最後に取り外す

ダミーのおかげで第0要素にヒットした場合もdel2が上手く動く。よく「いけにえの技法」と呼ばれる。
また、「一つ削る前のリスト」を覚えておく代わりに「一つ先」すなわちcadrをxと比較し探索することでdel2の引数を2つにできる。

(defun delete-1 (x y)
       (setq y (cons 'dummy y))
       (del2 x y)
       (cdr y))
(defun del2 (x y)
       (cond ((null (cdr y)) nil)
       ((eq (cadr y) x) (rplacd y (cddr y))) ; yのcdrをyのcddrに置き換えるとyのcadrを飛ばすことができる
       (t (del2 x (cdr y)))))

deleteはdel2のrplacd後に再帰のステップを入れるだけで実現できる。

(defun delete (x y)
       (setq y (cons 'dummy y))
       (dela x y)
       (cdr y))
(defun dela (x y)
       (cond ((null (cdr y)) nil)
             ((eq (cadr y) x) (replacd y (cddr y))
                              (dela x (cdr y))) ; 再帰
             (t (dela x (cdr y)))))

update-phoneに削除機能を付ける

numberが適当な特定のシンボルだったときにdelete-1が動くようにすればいい。

(defun update-phone (p friend number)
       (prog (f.n)
             (setq f.n (assoc friend p))
             (return
                (cond ((eq number 'sukinanoni) (delete-1 f.n p)) ; ココ
                      (f.n (rplacd f.n number) p)
                      (t (cons (cons friend number) p))))))

ただし、delete-1はeqを用いて要素の比較をする。ここではもともとpの中にあったドット対をassocで取り出したものをdelete-1の引数として与えているため、実体として等しい(タグと番地が同一の)ドット対を見つけて削除することができる。このような例を除けばリストの実体は異なる場合が多いので、delete-1をequal(第8講参照)で書き直したものを利用すると確実になる。

リストを逆順にするnreverse

reverse(第6講参照)はconsを使って新しいリストを作成してしまう。
リストを構成するセルのcdr部が指すセルの順番だけを書き換えれば、コピーを作成せずに逆順のリストを得られる。元のリストを変更してしまうような関数は破壊的関数などと呼ばれる。

(defun nreverse (x) (nrev2 x nil))
(defun nrev2 (x r)
       (cond ((null x) r)
             (t (prog1 (nrev2 (cdr x) x)
                       (rplacd x r)))))

prog1はprognと同様に与えられたS式を順に評価するが、prognと異なり最初に評価されたS式の値が返る。
(a b c)というリストを例にnreverseの動きを追って見よう。
1. 初期状態
最初、リストの実体の各セルは次のような状態にある。

2. nrev2の実行
nreverseが呼び出されると第2引数にnilを追加した上でnrev2が呼び出される。nrev2はxがnilになるまでcdrをとりながら再帰的に呼び出される。

(nrev2 '(a b c) nil) ; 最初の呼び出し
(nrev2 '(b c) '(a b c)) ; ↑の呼び出し内部からの呼び出し
(nrev2 '(c) '(b c)) ; 同上
(nrev2 nil (c)) ; 同上

ただし、上に書いたままの状態のリストが引数として渡されるわけではない。後にみるようにリストは段階的に逆転されていく。(a b c)はそのままの形のリストではなく、そのリストの最初のセルとして認識しなければいけない。
3. 返り値
再帰呼び出し中の各々のnrev2はprog1の効果によりprog1中の最初のS式、つまり自らが呼び出す(nrev2 (cdr x) x)の値を返り値として指定する。ただし、xがnilとなる(nrev2 nil (c))はr、つまりリストの最後のセルである

を返り値として指定する。よって最終的な返り値はリストの最後のセルということになる。
自分を呼び出したnrev2へ返り値を渡す前に、prog1の残りの行、つまりrplacdが再帰の深い部分から順に実行される。
4. rplacdの実行
まず、(rplacd '(c) '(b c))が実行される。これによりcのセルのcdrがbのセルを指すようになる。

次に(rplacd '(b c) '(a b c))が実行される。ただし、aやbに続くセルの並びは既に変更されているので、'(b c)ではなくbのセル、'(a b c)ではなくaのセルを考えなければいけない。

最後に(rplacd '(a b c) nil)が実行され、aのセルのcdr部がnilになることで逆転したリストが完成する。

リストが逆転した後にセルcが返るため、結局逆転したリストが返ることになる。

破壊的関数の注意点

例えば

(setq x '(a b c))

とするとxはaのセルを指すようになる。
nreverseを実行してもxがaを指していることは変わらないため、次のようなことが起こる。

(nreverse x) ;=> (c b a)
x ;=> a

これを防ぐにはnreverseをsetqとあわせて使う。

(setq x '(a b c)) ;=> (a b c)
(setq x (nreverse x)) ;=> (c b a)
x ;=> (c b a)

nreverseに限らず、破壊的関数は極力setqとあわせて使うようにしたほうが良い。

今回出てきた関数をdoで書き換える

ところで、今回出てきた関数はみんな再帰法で定義した。これを前に話したwhileやdoで書けないか考えてみよう。これは読者の練習問題としておく。

whileは必要ならマクロで定義できるらしいけどまだそこまで読んでないのでとりあえずdo(第7講参照)で。
delete-1(リスト中に含まれる指定した要素のうち最初のものを削除)

;; 再帰
(defun delete-1 (x y)
       (setq y (cons 'dummy y))
       (del2 x y)
       (cdr y) )
(defun del2 (x y)
       (cond ((null (cdr y)) nil)
             ((eq (cadr y) x) (rplacd y (cddr y)))
             (t (del2 x (cdr y))) ))
;; do使用             
(defun my-remove-1 (x y)
       (setq y (cons 'dummy y))
       (mdel2 x y))
(defun mdel2 (x y)
       (do ((r y (cdr r)))
           ((null (cdr r)) (cdr y))
           (cond ((eq (cadr r) x)
                  (rplacd r (cddr r)) 
                  (return (cdr y))) ))) 

delete(リスト中から指定した要素を全て削除)

;; 再帰
(defun delete (x y)
       (setq y (cons 'dummy y))
       (dela x y)
       (cdr y) )
(defun dela (x y)
       (cond ((null (cdr y)) nil)
             ((eq (cadr y) x) (rplacd y (cddr y))
                              (dela x (cdr y)))
             (t (dela x (cdr y))) ))
;; doを使用
(defun my-remove (x y)
       (setq y (cons 'dummy y))
       (mdela x y))
(defun mdela (x y)
       (do ((r y))
           ((null (cdr r)) (cdr y))
           (cond ((eq (cadr r) x)
                 (rplacd r (cddr r)) )
                 (t (setq r (cdr r)))
                 )))

nreverse(リストを破壊的に逆転)

;; 再帰
(defun nreverse (x) (nrev2 x nil))
(defun nrev2 (x r)
       (cond ((null x) r)
             (t (prog1 (nrev2 (cdr x) x)
                       (rplacd x r)))))
;; do
(defun my-nreverse (x)
       (mynrev2 x (cdr x)))
(defun mynrev2 (x n)
       (rplacd x nil)
       (do ((r (cdr n) (cdr n)))
           ((null n) x)
           (rplacd n x)
           (setq x n)
           (setq n r)))