Code Aquarium

minazoko's blog -*- 水底のブログ -*-

遅延リスト遊び - Emacsで学ぶLazyな世界(後編)

前編に引き続き、使うのはEmacs Lispです。

-*- 遅延リスト -*-

ものすごく基本的なことを書きます。
二つのオブジェクトのペアを作る関数consがあります。このペアはドット対とも呼ばれますが、cdr部がnilの場合、真のリスト*1になります。またcdr部が真のリストであるペアもまた真のリストになります。

(setq c (cons 1 2)) ;=> (1 . 2) ;ドット対
(car c) ;=> 1   car部
(cdr c) ;=> 2   cdr部


(setq ls (cons 1 (cons 2 (cons 3 nil)))) ;=> (1 2 3)  ;リスト

(car ls) ;=> 1
(cdr ls) ;=> (2 3)

(car (cdr ls))             ;=> 2
(car (cdr (cdr ls))        ;=> 3
(car (cdr (cdr (cdr ls)))) ;=> nil

consによってリストが構築され、car, cdrでリストを分解できます。多くのリスト操作関数はこの基本となる3関数により実装できます。
遅延リストもこれとよく似た仕組みになります。まずは遅延リスト用の基本3関数を作りましょう。

(defmacro lz-cons (a b)
  `(cons ,a (delay ,b)))

(defalias 'lz-car 'car)

(defun lz-cdr (s)
  (force (cdr s)))

ここではプレフィックスにlzを付けて遅延(lazy)の意味としています。lz-carはただのcar, lz-cdrはcdr部をforceする関数です。
lz-consはconsに展開されますが、cdr部はdelayされます。delayが作るのはnilでもリストでもなくpromiseというオブジェクトですからこれで構築されるのものは、Lisp的にはただのドット対です。
では遅延リストを作ってみます。

(lz-cons 1 (lz-cons 2 (lz-cons 3 nil)))))

lz-consはマクロなのでEmacsのバッファでこの式を評価するとマクロ展開後評価されます。lz-consの中のconsが実行されるわけですね。

(1 . [cl-struct-promise
      (lambda (&rest --cl-rest--)
        (apply '(lambda (G154156 G154157)
                  (if  (symbol-value G154156)
                      (prog1
                          (set G154157
                               (funcall
                                (symbol-value G154156)))
                        (set G154156 nil))
                    (symbol-value G154157)))
               '--func-- '--memo-- --cl-rest--))])

一番外側のlz-consの展開されたものだということは分かりますが、内側の2つのlz-consはどこにいってしまったんでしょうか? よくわかりませんが、これがちゃんとリストのように扱えるのだから不思議です。

(setq lz (lz-cons 1 (lz-cons 2 (lz-cons 3 nil)))) ;=> 1,2,3を要素にもつ遅延リスト

(lz-car lz) ;=> 1
(lz-cdr lz) ;=> 2,3を要素にもつ遅延リスト

(lz-car (lz-cdr lz))                   ;=> 2
(lz-car (lz-cdr (lz-cdr lz)))          ;=> 3
(lz-car (lz-cdr (lz-cdr (lz-cdr lz)))) ;=> nil

冒頭のリスト操作と同じ結果になっています。

リスト構築関数

lz-consを使って、遅延リストを作る関数を作ってみましょう。

(defun lz-repeat (x)
  "引数が無限につづく遅延リスト"
  (lexical-let ((x x))
    (lz-cons x (lz-repeat x))))

(defun lz-iota (n m)
  "初期値n, ステップmの無限等差数列"
  (lexical-let ((n n) (m m))
    (lz-cons n (lz-iota (+ n m) m))))

いきなり無限リスト構築関数が二つ。無限リストは終了判定がいらないので簡単に作れるんですよね。どちらも再帰関数っぽいですが、再帰はdelay*2されるので実際は再帰呼び出しにはなりません。ドット対を返す関数にすぎません

(lz-repeat "a") ;=> ("a" . [cl-struct-promise (lambda (...
(lz-iota 1 2)   ;=> (1 . [cl-struct-promise (lambda (...

でもリストのようにふるまいます

(setq lz1 (lz-repeat "a"))
(lz-car lz1)                   ;=> "a"
(lz-car (lz-cdr lz1))          ;=> "a"
(lz-car (lz-cdr (lz-cdr lz1))) ;=> "a"

(setq lz2 (lz-iota 1 2))
(lz-car lz2)                   ;=> 1
(lz-car (lz-cdr lz2))          ;=> 3
(lz-car (lz-cdr (lz-cdr lz2))) ;=> 5

遅延リスト、無限リストができました。

-*- 遅延リスト操作関数 -*-

遅延リストの基本はこれだけです。あとは遅延リストを操作するための関数を黙々と作る作業になります。まずはtakeがほしいですね。

(defun lz-take (n lz)
  (when (and lz (> n 0))
    (lexical-let ((n n) (lz lz))
      (lz-cons (lz-car lz)
               (lz-take (1- n) (lz-cdr lz))))))

(defun lz-take-while (pred lz)
  (when (and lz (funcall pred (lz-car lz)))
    (lexical-let ((pred pred) ((lz lz)))
      (lz-cons (lz-car lz)
               (lz-take-while pred (lz-cdr lz))))))

(defun lz-drop (n lz)
  (do ((n n (1- n)) (lz lz (lz-cdr lz)))
      ((or (>= 0 n) (null (cdr lz))) lz)))

(defun lz-drop-while (pred lz)
  (do ((lz lz (lz-cdr lz)))
      ((or (not (funcall pred (lz-car lz)))
           (null (cdr lz))) lz)))

遅延リストからn件切り出すlz-take, predが成立する限り取り出すlz-take-while, ついでにdropも作りました。dropは遅延評価ではない手続ループで作りました。
あと遅延リストを普通のリストに変換する関数もあった方が結果の確認に便利ですね。ついでなので相互変換関数を作ります。

(defun lzlist-to-list (lz)
  (do ((lz lz (lz-cdr lz))
       (ls nil (append ls (list (lz-car lz)))))
      ((null (cdr lz)) ls)))

(defun list-to-lzlist (ls)
  (when ls
    (lexical-let ((ls ls))
      (lz-cons (car ls)
               (list-to-lzlist (cdr ls))))))

リスト操作関数と相性のよいスレッドマクロと、部分適用関数の短縮名も用意しましょう。そうしましょう。

(defmacro ->> (&rest exprs)
  (when exprs
    (reduce
     (lambda (acc e)
       (if (listp e) `(,@e ,acc)
         `(,e ,acc)))
     exprs)))

(defalias 'pa$ 'apply-partially)

つかってみよう。

(->> (lz-iota 0 7)                 ; 7の倍数の
     (lz-drop-while (pa$ '> 5000)) ; 5000未満を捨てた後
     (lz-take 5)                   ; 5件を取得して
     lzlist-to-list)               ; リストにする

;;=> (5005 5012 5019 5026 5033)

5005って7の倍数なんですね。できてます!

次はunfoldを作ってみよう

(defun lz-unfold (endp elem next seed)
  (when (not (funcall endp seed))
    (lexical-let ((endp endp) (elem elem) (next next) (seed seed))
      (lz-cons (funcall elem seed)
               (lz-unfold endp elem next
                         (funcall next seed))))))

unfoldの引数で変化するのはseedだけ。それ以外は常に同じ関数を使います。ということは毎回引数渡すのは無駄ですよね? うまくレキシカルスコープを使えないでしょうか?

(defun lz-unfold (endp elem next seed)
  (lexical-let ((endp endp) (elem elem) (next next))
    (labels
        ((rec (s)
              (when (not (funcall endp s))
                (lexical-let ((s s))
                  (lz-cons (funcall elem s)
                           (rec (funcall next s)))))))
      (rec seed))))

ローカル関数recでsの値を変えながら遅延再帰しています。引数が1つだから呼び出しオーバーへッド少ない...のかな? この手法はいろいろなところで使えそうです。
フィボナッチ数列を作ってみましょう。

(->> (lz-unfold (lambda (_) nil)
                'cadr
                (lambda (ls) (list (apply '+ ls) (car ls)))
                '(1 0))
     (lz-take 20)
     lzlist-to-list)


;;=> (0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)

おお!できてますね。これは楽しい。
きりがないのでこのへんでやめておきますが、他にもfilter, mapcar, zip, reduce, 素数列生成...といくらでも考えられますね。


はっきり言って、遅延評価はオーバヘッドが大きく特にEmacs Lispではクリティカルな場所で使うことは難しいと思います。でも、末尾再帰最適化がないEmacs Lispですから、スタックを食いつぶさない遅延再帰が役立つ場面はありそうな気がするのですが、どうでしょうかね...

-*- おわりに -*-

今月の初めごろとあるブログの記事へのtwitter上での反応をきっかけに「遅延評価」について考える機会がありました。普段Clojureで遅延評価の恩恵を受けているわりに突っ込んで理解してないな気づき、そしてこのエントリができました。

どうせやるなら最初から遅延評価を持っているClojureではなく、あえてEmacs Lispでを選びましたが勉強になりました。動的スコープのEmacs Lispだからこそレキシカルの有難さ、そしてレキシカルスコープが遅延評価においてどの部分で役立っているかなんとなく見えた気がします。

*1:「真のリスト」というのは要するに普通のリストのことです

*2:lz-consはdelayに展開されるマクロだということを思い出してください。前編でも書いたように後で正しく評価するためにはdelayマクロに適用す変数はlexical-letする必要があります。