リストの破壊的操作をする

１０分でコーディング x 2 〜リストの破壊的操作篇〜 - 'T - cadr group

これだ。お題を出されたので解いてみよう。似たような問題をOn Lispで見た気がするなあ。相変わらず記事別に見てる人には意味ないけど、解答は続き。

(defun alist-to-plist (alist &optional l)
  (if alist
      (alist-to-plist (cdr alist) (cons (cdar alist) (cons (caar alist) l)))
    (reverse l)))

8分くらいで出来たもの。・・・名前が"n"alist-to-plistでないのは、明らかに非破壊型だからだ。そうなのだ。実は破壊的ではないリスト操作とかconsを消費しない方法とか良く知らないのだ。私の知っている限り、xyzzyには、ユーザ側でconsの消費量を調べる機能が付いてないし。まあ、とりあえず作ったものの挙動を見てみよう。

(setq l (list (cons 1 2) (cons 3 4) (cons 5 6)))
|((1 . 2) (3 . 4) (5 . 6))
(alist-to-plist l)
|(1 2 3 4 5 6)
l
|((1 . 2) (3 . 4) (5 . 6))

非破壊型の挙動としては問題ないだろう。さて、題意に沿うような関数をどうやって作るか調べてみよう。

学習編

On Lispを確認したところ、私が見たのは( (1 2) (3 4) )のようなlistを(1 2 3 4)にする、非破壊型の関数だった。今回の問題とは少し違ったようだ。

仕方ないので自分で考えよう。consを消費しないっていうのは、要するに新しいconsとかlistを作らなければいいんだろう。今回はヒントとして

alistからplistへの変換は、余計なコンシングを一切せずに組み換えることができる

と言われているので、場所の入れ替えだけで変換が行えるはずである。つまり、rotatefをうまく使えば出来るはずだ。さて、ここでalistとplistを見比べてみよう。連続する部分は共通なので、 ( (1 . 2) ) と (1 2) = (1 . (2)) として、cons cellの図に表してみよう。Xはオブジェクトを示すレジスタ、Cはcons、Nはnil、下向きがcar、右向きがcdrを表している。

(setq x ((1 . 2)))
┌─┐┌─┐
│Ｘ├┤Ｎ│
└┬┘└─┘
┌┴┐┌─┐
│Ｃ├┤２│
└┬┘└─┘
┌┴┐
│１│
└─┘

(setq x (1 2))
┌─┐┌─┐┌─┐
│Ｘ├┤Ｃ├┤Ｎ│
└┬┘└┬┘└─┘
┌┴┐┌┴┐
│１││２│
└─┘└─┘

こうしてみると、パズルのようにくるくる入れ替えてやればいいことがわかる。carのconsは使い回してcdrに、caarをcarに、cdarをcadrに、そして終端のcdrをcddrに・・・と言葉では説明しにくい！

これで一応わかるだろうか。これをrotatefで行えばいいのだが、一発ではうまく行かない。順番通りに順繰りに回していけばいいのではあるが、一つ前を更新すると位置関係が変わってしまうので無理だ。

それでも、順番に入れ替えれば良いので、ステップを分ければ出来ることがすぐにわかる。

このように、いちどcarとcdrを入れ替えれば、残りは位置関係が変わらずに入れ替えられる。早速試してみよう。

(setq x '((1 . 2)))
(progn (rotatef (car x) (cdr x)) x)
|(nil 1 . 2)
(progn (rotatef (car x) (cadr x) (cddr x)) x)
|(1 2)

はい、consを新しく作らないでalistからplistへ変化できた。これはaconsがいくつ合っても同様に行えて、

(setq x '((1 . 2) (3 . 4) (5 . 6)))
(setq y (cdr x))
(progn (rotatef (car y) (cdr y)) x)
|((1 . 2) ((5 . 6)) 3 . 4)
(progn (rotatef (car y) (cadr y) (cddr y)) x)
|((1 . 2) 3 4 (5 . 6))

前後に影響を与えることなく展開できる。私は操作の途中のリストを見ても良く分からないのだが、慣れた人なら図のようなイメージが作れるのだろうか。

さて、ここまで出来れば、あとは末尾再帰か何かで順番に展開するだけである。出来た関数がこちら。

(defun nalist-to-plist (alist)
  (labels ((cur (x)
             (rotatef (car x) (cdr x))
             (rotatef (car x) (cadr x) (cddr x))
             (and (cddr x) (cur (cddr x)))))
    (cur alist)
    alist))

(setq x '((1 . 2) (3 . 4) (foo . bar)))
(nalist-to-plist x)
|(1 2 3 4 foo bar)
x
|(1 2 3 4 foo bar)

ちゃっかりOn Lispの書き方を真似ていたりする。動作は良さそうだ。consの消費量はxyzzyから見られない（と思う）ので、CLISPを使ってテストコードをコピペして実行する。

> (defun nalist-to-plist 〜省略)
NALIST-TO-PLIST
> (prog ((data (loop :repeat 100000 :collect (cons 1 2))))
      (time (nalist-to-plist data)))
*** - Program stack overflow. RESET

Real time: 0.015625 sec.
Run time: 0.015625 sec.
Space: 252 Bytes

あー、overflowしてるってことは再帰が最適化されてない・・・。コンパイルして、

> (compile 'nalist-to-plist)
NALIST-TO-PLIST ;
NIL ;
NIL
> (prog ((data (loop :repeat 100000 :collect (cons 1 2))))
      (time (nalist-to-plist data)))
Real time: 0.046875 sec.
Run time: 0.03125 sec.
Space: 0 Bytes
NIL

Spaceが0byteということで、うまく出来ているようだ。比較として非破壊版も同様にテストしてみた。

> (prog ((data (loop :repeat 100000 :collect (cons 1 2))))
      (time (alist-to-plist data)))
Real time: 0.09375 sec.
Run time: 0.09375 sec.
Space: 3200000 Bytes
GC: 3, GC time: 0.078125 sec.
NIL

こちらはかなり容量を使っていることがわかる。ついでに、ループを使ったバージョンも試してみた。

(defun nalist-to-plist (alist)
  (let ((x alist))
    (loop
      (rotatef (car x) (cdr x))
      (rotatef (car x) (cadr x) (cddr x))
      (if (cddr x) (setq x (cddr x)) (return alist)))))

;コンパイルなし
Real time: 0.46875 sec.
Run time: 0.46875 sec.
Space: 0 Bytes
NIL

;コンパイルあり
Real time: 0.03125 sec.
Run time: 0.0625 sec.
Space: 0 Bytes
NIL

コンパイルなしでもちゃんと動作するが、コンパイルがあるときは大して変わらないか少し遅いくらい。コンパイラに最適化を任せる場合は再帰、xyzzyで気楽に試すときはループを使う感じだろうか。

ここまで大体1時間くらい*1。最後にもう一つの問題をやる。nplist-to-alistはこれの逆をすればいいので、6分ほどで書けた。

;再帰版
(defun nplist-to-alist (alist)
  (labels ((cur (x)
             (rotatef (car x) (cdr x))
             (rotatef (cdr x) (cdar x) (caar x))
             (and (cdr x) (cur (cdr x)))))
    (cur alist)
    alist))

;loop版
(defun nplist-to-alist (alist)
  (let ((x alist))
    (loop
      (rotatef (car x) (cdr x))
      (rotatef (cdr x) (cdar x) (caar x))
      (if (cdr x) (setq x (cdr x)) (return alist)))))

(setq x '(1 2 3 4 5 6 7 8))
(nplist-to-alist x)
|((1 . 2) (3 . 4) (5 . 6) (7 . 8))

(setq x '(1 2 3 4 5 6 7 8 9))
(nplist-to-alist x)
|不正なデータ型です: nil: cons
x
|((1 . 2) (3 . 4) (5 . 6) (7 . 8) nil)

データが不適切だと普通にエラーを返すが、まあいいか。

追記(2009-05-23-22-47)

letter: １０分でコーディング x 2 〜リストの破壊的操作篇に挑戦

でrotatef一回のみで変換可能なことが確認されている。すごい。

*1:記事を書くのに2時間くらい^^;