(PowerShell)ダイナミックスコープなReduce
$1. 関数内再帰関数で Join-Paths
最初にちょっと寄り道。
前回エントリでは、引数を配列にして３つ以上のパス要素連結関数を書きました。
Join-Path 同様に可変長の引数にすることは出来ないでしょうか？ できました。
function Join-Paths{
function rec ([string[]] $paths){
$parent, $rest = $paths
if(-not $rest){
$parent
}else{
Join-Path $parent (rec $rest)
}
}
rec $args
}PS C:\> Join-Paths C: xxx yyy zzz C:\xxx\yyy\zzz
仮引数を省略するとすべての引数は暗黙変数 $argsに配列で渡されます。可変長の再帰関数は書けませんが $argsで受けてしまえば配列を要求する関数へ渡すことが可能です。
ここでは関数内のローカル関数として再帰関数を定義しています。
$2. パイプラインで実装
PowerShellといえばパイプライン指向ですので、パイプラインによる実装も書いてみましょう。
function Join-Paths {
$acc, $rest = $args
$rest | % {}{$acc=Join-Path $acc $_}{$acc}
}% の後ろの３つのブロックが、begin(初期化), process(繰り返し), end(最終処理)となっています。初期化処理は特に必要なかったので空っぽです。
名前付引数を使えば beginブロック自体を省略できます。
function Join-Paths{
$acc, $rest = $args
$rest | % -Process {$acc=Join-Path $acc $_} -End {$acc}
}この場合、-Processも省略できるようです。
function Join-Paths{
$acc, $rest = $args
$rest | % {$acc=Join-Path $acc $_} -End {$acc}
}PowerShellの再帰呼び出しはとても遅いので、通常はこのようにパイプラインやループで書くほうがよさそうです。
$3. ダイナミックスコープなReduce
本題。
% (ForEach-Objectコマンドレット)で畳み込み処理ができましたが、Endブロックを書いたり、Beginブロックに気を遣ったりするのは少し煩わしいですね。そこで関数型言語によくある高階関数的な畳み込み関数 Reduceを書いてみました。
function Get-ReduceObject ([ScriptBlock] $Script, [object] $Init){
if($null -ne $Init){
$acc = $Init
}elseif($input.MoveNext()){
$acc = $input.Current
}else{
return
}
$input | % {$acc = & $Script} -End {$acc}
}
Set-Alias reduce Get-ReduceObject$Init は畳み込みの初期値です。省略可能です。省略した場合、$Inputの初項で代用されます。
$Input は 暗黙の変数で、パイプラインから流れ込むデータを表します。IEnumerator を実装しているので。MoveNextメソッドで参照先を移動し、Currentプロパティで現在の値を取得できます。(ここでは初項を取り出すために MoveNext,Currentを使っています)。また$Inputはforeachで回したりパイプラインへ流すこともできます。
ScriptBlockは無名関数のようなものです。& 演算子で実行します。
ScriptBlockはダイナミックスコープです。クロージャではないので ScriptBlock内の自由変数は実行時の環境で値が決まります。
使ってみます。
PS C:\> 1..10 | reduce {$_ * $acc}
3628800
PS C:\> 1..5 | reduce { "(cons $_ $acc)" } -Init "NIL"
(cons 5 (cons 4 (cons 3 (cons 2 (cons 1 NIL)))))$_ と $acc は Get-ReduceObject内で $Script が実行される環境で見えている $_ と $acc の値となります。...でも、Get-ReduceObject 内に $_ は見当たりませんね。
ForEach-Objectコマンドレット (%) の Processブロック内ではパイプラインからの値が一つ一つ 暗黙変数 $_ でわたってきます。この暗黙変数がそのまま $Scriptから見えているのです。
この reduce を使ってパス連結関数を書くと。
function Join-Paths {
$args | reduce {Join-Path $acc $_}
}ForEach-Object を生で使った場合と比べるとだいぶスッキリしました。
$4. Emacs Lispでも書いてみる。
Emacs Lispはダイナミックスコープな処理系ということで有名です。ならば同じことができるはず。
;; ダイナミックスコープを利用した reduce
(defun reduce-dy (fun ls &optional init)
(let (($acc (if init init (car ls)))
(ls (if init ls (cdr ls))))
(dolist ($_ ls $acc)
(setq $acc (funcall fun)))))(reduce-dy '(lambda () (* $acc $_)) '(1 2 3 4 5 6 7 8 9 10)) ;;=> 3628800
(reduce-dy '(lambda () (format "(cons %s %s)" $_ $acc)) '(1 2 3 4 5) 'NIL) ;;=> "(cons 5 (cons 4 (cons 3 (cons 2 (cons 1 NIL)))))"
なるほどね。
Emacs Lisp で as-> マクロ
Clojure1.5のas->マクロをelispで。
(defmacro as-> (expr name &rest forms) `(let* ((,name ,expr) ,@(mapcar '(lambda (f) `(,name ,f)) forms)) ,name))
本家Clojureの実装はこんな感じ
(defmacro as-> [expr name & forms] `(let [~name ~expr ~@(interleave (repeat name) forms)] ~name))
このケースだと、interleveよりもmapcar(map)の方が分かり安い気がするー。
遅延リスト遊び - 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でリストを分解できます。多くのリスト操作関数はこの基本となる３関数により実装できます。
遅延リストもこれとよく似た仕組みになります。まずは遅延リスト用の基本３関数を作りましょう。
(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の値を変えながら遅延再帰しています。引数が１つだから呼び出しオーバーへッド少ない...のかな？ この手法はいろいろなところで使えそうです。
フィボナッチ数列を作ってみましょう。
(->> (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だからこそレキシカルの有難さ、そしてレキシカルスコープが遅延評価においてどの部分で役立っているかなんとなく見えた気がします。
