foldとunfoldによるパース
構造化されていないテキストファイルを読んで扱いやすいデータ構造に変換したい時に、 file->string-list でリストとして読み込んで fold で加工する、というのをGaucheを使ってよくやる。
最近foldだけでなく、unfoldも使えることを知った。
例えば、
(define *input-source* '("a" "1" "2" "3" "b" "1" "2" "3" "4" "c" "1" "2" "3" "4" "d" "1" "2"))
のようなフラットなリスト（ファイルから file->string-list で読み込んだ想定）を
(define *output-data* '(("a" ("1" "2" "3")) ("b" ("1" "2" "3" "4")) ("c" ("1" "2" "3" "4")) ("d" ("1" "2"))))
のような構造化されたリストへと変換したい。
このような時、いままではfoldを使って以下のように変換していた。
(define (record-index? x) (if (#/[a-z]/ x) #t #f)) ;; fold版 (define (use-fold input) (define (f elem lis) (if (record-index? elem) (cons (list elem '()) lis) (match lis (((ri rd) . rest) (cons (list ri (cons elem rd)) rest))))) (map (lambda (r) (list (car r) (reverse (cadr r)))) (reverse (fold f '() input))))
同じことがunfoldを使ってもできる。
;; unfold版 (define (use-unfold input) (define (not-record-index? x) (not (record-index? x))) (define (f lis) (list (car lis) (take-while not-record-index? (cdr lis)))) (define (g seed) (drop-while not-record-index? (cdr seed))) (unfold null? f g input))
fold版の方が直感的に理解しやすくスラスラ書けるが、最後に reverse を複数回かけてあげないといけないのが面倒。
一方、 unfold は使い慣れていないせいもあって書くのに時間がかかる。ただしその分 fold に比べてすっきり書ける。一見なにをやっているのかわかりにくいのが難点か。
エラトステネスのふるい
継続的に何かをやることが苦手で『関数プログラミングの楽しみ』も中途半端なまま放置しているが、通勤の時間を有効に使うため、何でもいいから簡単なプログラムを1日1つ書いてみることにした。
週末の外出中に思いつき、帰りの電車の中でプレ実践。お題は「エラトステネスのふるいを愚直に実装して素数列を生成する」にした。
言語はなんでもいいのだが、とりあえず慣れているscheme（Gauche）を選んだものの、散々な結果に・・・orz
やはり日頃から鍛えてないとだめですな。
結局、帰宅後に微修正をして以下のような結果になった。
;;; Date: 2011/11/27 ;;; エラトステネスのふるいを愚直に実装して素数列を生成する ;; [1] 2に印をつける ;; [2] 2の倍数を消す ;; [3] 次の数3に印をつける ;; [4] 3の倍数を消す ;; [5] 次の数5に印をつける ;; [6] 5の倍数を消す ;; ... (use srfi-1) ;; 数列lisからpで割り切れる数を除いた数列を返す (define (remove-multiple p lis) (remove (lambda (x) (= (remainder x p) 0)) lis)) ;; n以下の素数列を返す (define (prime-list n) (let loop ((src (iota (- n 1) 2 1)) (res '(2))) (let ((w (remove-multiple (car src) (cdr src)))) (if (null? w) (reverse res) (loop w (cons (car w) res))))))
答え合わせにとググっていたら、古い記事だがperlでおもしろい解答を見つけた。
次にabigailの傑作の変種。
perl -le '$,=" "; print grep { (1 x $_) !~ /^(11+)\1+$/ } (2..100)'なんでこれで素数判定できるかは、読者の宿題。
404 Blog Not Found:perl - 100までの素数
気になったのでschemeで書き直してみる。
;;; Date: 2011/11/27 ;;; エラトステネスのふるい(正規表現版) ;;; (参考) http://blog.livedoor.jp/dankogai/archives/50534089.html (use srfi-1) (define (prime-list-re n) (let loop ((src (iota (- n 1) 2 1)) (res ())) (if (null? src) (reverse res) (loop (remove (lambda (x) (#/^(11+)\1+$/ (make-string x #\1))) (cdr src)) (cons (car src) res)))))
適宜 #?= を入れながら確認。
素数の倍数がふるいにかけられるように徐々に消えていき、なるほど、確かにエラトステネスのふるいだと納得。
MacOS Leopard で Gauche 0.9.2 へのアップデート
未だに Leopard 使ってますが、 Gauche の新しいバージョンが出ていたので、アップデートを試みます。
前回と同じ configure でビルドを試みますが、 make の途中でコケました。
調べて見ると、どうも ld に -no_pie というオプションが無いことが原因らしいです。
http://practical-scheme.net/chaton/gauche/a/2011/08/10
上記に書いてあるとおり、 src/Makefile と gc/Makefile から -no_pie を削除したところ問題なくビルドできました（make test が1つだけ失敗するけど特に問題ないっぽい！？）。
そろそろ Lion への乗換も本格的に考えねば。。。
『関数プログラミングの楽しみ』の1章をPrologで書いてみる
Scheme版に引き続き、『関数プログラミングの楽しみ』の第1章を Prolog で書いてみた。使用した処理系はB-Prolog。恐らく他の処理系でも問題ないと思われる。
それでは一気に行こう。
1.1 二分ヒープ木
Forkをリストで表すか、項（term）で表すか迷うところだが、今回はSchemeとの違いを出すため項として定義した。
fork( _X, _A, _B ).
あとは述語を適当に定義。パターンマッチが使えるので、 Scheme よりもすっきりしている部分もある。しかしながら、値を返せないという言語上の制約から、余計な変数を使わねばならない箇所もあり、どうしてもこの辺りが冗長に見えてしまう。
isEmpty( nil ). minElem( fork( X, _A, _B ), X ). deleteMin( fork( _X, A, B ), Res ) :- merge( A, B, Res ). insert( X, A, Res ) :- merge( fork( X, nil, nil ), A, Res ). merge( X, nil, X ) :- !. merge( nil, Y, Y ) :- !. merge( A, B, X ) :- minElem( A, _MinA ), minElem( B, _MinB ), _MinA =< _MinB, join( A, B, X), !. merge( A, B, X ) :- join( B, A, X), !. join( fork( X, A, B ), C, fork( X, C, T ) ) :- merge( A, B, T ).
カットは適当に入れた。特に問題ないと思われる。
1.2 最大回避ヒープ
fork( _N, _X, _A, _B ). isEmpty( nil ). minElem( fork( _N, X, _A, _B ), X ). deleteMin( fork( _N, _X, A, B ), Res ) :- merge( A, B, Res ). insert( X, A, Res ) :- merge( fork( 1, X, nil, nil ), A, Res ). merge( X, nil, X ) :- !. merge( nil, Y, Y ) :- !. merge( A, B, X ) :- minElem( A, _MinA ), minElem( B, _MinB ), _MinA =< _MinB, join( A, B, X), !. merge( A, B, X ) :- join( B, A, X), !. join( fork( N, X, A, B ), C, Res ) :- orderBySize( A, B, C, AA, BB, CC ), size( C, S ), N2 is N + S, merge( BB, CC, D ), Res = fork( N2, X, AA, D ), !. orderBySize( A, B, C, AA, BB, CC ) :- size( A, S1 ), size( B, S2 ), size( C, S3 ), max( S1, S2, _M ), max( _M, S3, Max ), orderBySize0( A, B, C, AA, BB, CC, S1, S2, S3, Max ), !. orderBySize0( A, B, C, A, B, C, S1, _S2, _S3, S1 ). orderBySize0( A, B, C, B, A, C, _S1, S2, _S3, S2 ). orderBySize0( A, B, C, C, A, B, _S1, _S2, S3, S3 ). size( nil, 0 ). size( fork( N, _X, _A, _B ), N ). max( X, Y, X ) :- X >= Y, !. max( _, Y, Y ).
joinがうわぁって感じに・・・。
1.4 ラウンドロビンヒープ
fork( _Color, _X, _A, _B ). isEmpty( nil ). minElem( fork( _Color, X, _A, _B ), X ). deleteMin( fork( _Color, _X, A, B ), Res ) :- merge( A, B, Res ). insert( X, A, Res ) :- merge( fork( blue, X, nil, nil ), A, Res ). merge( X, nil, X ) :- !. merge( nil, Y, Y ) :- !. merge( A, B, X ) :- minElem( A, _MinA ), minElem( B, _MinB ), _MinA =< _MinB, join( A, B, X), !. merge( A, B, X ) :- join( B, A, X), !. join( fork( blue, X, A, B ), C, fork( red, X, D, B ) ) :- merge( A, C, D ), !. join( fork( red, X, A, B ), C, fork( blue, X, A, D ) ) :- merge( B, C, D ), !.
こちらはだいぶすっきりした。元の Haskell のコードと遜色ない。パターンマッチ様々だ。
ねじれヒープ
fork( _X, _A, _B ). isEmpty( nil ). minElem( fork( X, _A, _B ), X ). deleteMin( fork( _X, A, B ), Res ) :- merge( A, B, Res ). insert( X, A, Res ) :- merge( fork( X, nil, nil ), A, Res ). merge( X, nil, X ) :- !. merge( nil, Y, Y ) :- !. merge( A, B, X ) :- minElem( A, _MinA ), minElem( B, _MinB ), _MinA =< _MinB, join( A, B, X), !. merge( A, B, X ) :- join( B, A, X), !. join( fork( X, A, B ), C, fork( X, B, D ) ) :- merge( A, C, D ), !.
さらにすっきりした。パターンマッチがメインである Prolog の本領発揮と言ったところだろうか。
『関数プログラミングの楽しみ』の1章をSchemeで書いてみる 2
光栄なことに、shiroさんから match-lambda でパターンマッチができるとのコメントを頂いたので、前回宿題とした遅延評価も含めて、ねじれヒープを書き直してみた。
(use util.match) (define (fork x a b) (list x a b)) (define (empty? tree) (null? tree)) (define min-elem (match-lambda ((x _a _b) x))) (define delete-min (match-lambda ((_x a b) (merge a b)))) (define (insert x tree) (merge (fork x () ()) tree)) (define merge (match-lambda* ((a (= force (? empty? _b))) a) (((= force (? empty? _a)) b) b) (((= force a) (= force b)) (if (<= (min-elem a) (min-elem b)) (join a b) (join b a))))) (define join (match-lambda* (((x a b) c) (fork x b (lazy (merge a c))))))
まずは match-lambda および match-lambda* についてだが、もともと match のパターンが1種類だったものに関しては、記述量的には大差ない感じ。ただ、一時的に使うための引数の名前に頭を使わなくていいので嬉しい。
mergeについても cond で判定していたものを match-lambda* を使うように書き直してみた。こちらも記述量的にあまり変化がないように思えるが、遅延評価に関する部分が加わり、そのための一時的な名前を考えなくてよくなったのがこれまた嬉しい。shiroさんに感謝。
本題とは関係ないが、lazyを使うことによって、そのままではインタラクティブに結果が見られないので、 Promise な部分を含めてリストに展開する関数を定義しておく。
(define unpack-lazy-tree (match-lambda (() ()) ((x a b) (fork x (unpack-lazy-tree (force a)) (unpack-lazy-tree (force b))))))
練習問題 1.5
本題の遅延評価に入る前に、練習問題を少しだけ。次のようなねじれヒープを再現する。
1 --- 2 | 3 --- 4 | 5 --- 6 | 7 --- 8 | 9
解答はGaucheに頑張って出してもらった。
(use srfi-1) (use util.combinations) (define (f n expected) (define (g l) (let ((tree (unpack-lazy-tree (fold insert () l)))) (when (equal? expected tree) (print l) (print tree)))) (permutations-for-each g (iota n 1)))
gosh> (f 9 '(1 (3 (5 (7 (9 () ()) (8 () ())) (6 () ())) (4 () ())) (2 () ()))) (7 9 8 5 6 3 4 1 2) (1 (3 (5 (7 (9 () ()) (8 () ())) (6 () ())) (4 () ())) (2 () ())) (9 7 8 5 6 3 4 1 2) (1 (3 (5 (7 (9 () ()) (8 () ())) (6 () ())) (4 () ())) (2 () ())) #t
自分のマシンだと30秒くらいで返ってきた。
1.6 遅延評価
期待通りに遅延評価されているか確認する。
(let ((base '(1 (3 (5 (7 (9 () ()) (8 () ())) (6 () ())) (4 () ())) (2 () ())))) (insert 10 base)) ;; => (1 (2 () ()) #<promise 0x784f00>)
うむ、期待通りと思われる。
(let ((base '(1 (3 (5 (7 (9 () ()) (8 () ())) (6 () ())) (4 () ())) (2 () ())))) (delete-min base)) ;; => (2 () #<promise 0x758cc0>)
あれ？ 右側のノードは1ノード分だけ計算されるはずなんだけど・・・。あっ、joinの中で lazy されるからか。
deleteMin の遅延評価を Scheme で再現するにはどうしたらよいのだろうか。
『関数プログラミングの楽しみ』の1章をSchemeで書いてみる
今更ながら、前から気になっていた『関数プログラミングの楽しみ』を読みはじめた。
Haskellはまだちゃんと取り組んでいないので、リストを主に扱う1章「二分ヒープ木の楽しみ」の内容をSchemeとPrologに書き下してみた。間違っている箇所もあると思われるがご了承を。
長くなりそうなので、まずはScheme版から。処理系はGaucheを使用している。
1.1 2分ヒープ木
まずは基本的なヒープを実装する。
Schemeではデータ型がないので、Treeはリストで表すことにする。また後々便利なので、Forkを関数として定義しておく。
(define (fork x a b) (list x a b))
順位付きキュー
順位付きキューの実装はHaskellのコードをほぼそのまま書き直した感じ。isEmptyをはじめ、関数名はScheme風(?)のものに適宜変更している。
(define (empty? tree) (null? tree)) (define (min-elem tree) (match tree ((x _a _b) x))) (define (delete-min tree) (match tree ((_x a b) (merge a b)))) (define (insert x tree) (merge (fork x () ()) tree))
簡潔にするため、パターンマッチにGaucheのutil.matchを用いた。引数のパターンマッチができるHaskellがちょっと便利に思える。
マージ
(define (merge a b) (cond ((empty? b) a) ((empty? a) b) (else (if (<= (min-elem a) (min-elem b)) (join a b) (join b a))))) (define (join a0 c) (match a0 ((x a b) (fork x c (merge a b)))))
joinは6つの候補の中から適当に1つを選んで実装した。
1.2 最大回避ヒープ
まずはForkを再定義する。木の大きさを追跡するための計数フィールドが増えただけだ。
(define (fork n x a b) (list n x a b))
その他についても、Haskellのコードを単純にSchemeに書き換えただけである。
(define (empty? tree) (null? tree)) (define (min-elem tree) (match tree ((_n x _a _b) x))) (define (delete-min tree) (match tree ((_n _x a b) (merge a b)))) (define (insert x tree) (merge (fork 1 x () ()) tree)) (define (merge a b) (cond ((empty? b) a) ((empty? a) b) (else (if (<= (min-elem a) (min-elem b)) (join a b) (join b a))))) (define (join a0 c) (define (size a) (match a (() 0) ((n _x _a _b) n))) (define (order-by-size a b c) (let ((biggest (max (size a) (size b) (size c)))) (cond ((eqv? (size a) biggest) (values a b c)) ((eqv? (size b) biggest) (values b a c)) (else (values c a b))))) (match a0 ((n x a b) (receive (aa bb cc) (order-by-size a b c) (fork (+ n (size c)) x aa (merge bb cc))))))
Schemeでは引数のパターンマッチができないため、余計な名前が必要になった。なんか良い書き方がないものか。
1.4 ラウンドロビンヒープ
ラウンドロビンヒープは初めて聞いた。色をつけるというアイディアは面白いが、章末ノートにある通り、後述の「ねじれヒープへの足がかりのための教育的なものにすぎない」らしい。
例によってForkの再定義から。基本的に最大回避ヒープと変わらない。
(define (fork c x a b) (list c x a b))
insert以外は大きな変化なし。insertも、1がシンボルblueになっただけである。
(define (empty? tree) (null? tree)) (define (min-elem tree) (match tree ((_c x _a _b) x))) (define (delete-min tree) (match tree ((_c _x a b) (merge a b)))) (define (insert x tree) (merge (fork 'blue x () ()) tree))
ねじれヒープ
ここでどんでん返し。Forkの定義は最初の単純なものへと戻る。
(define (fork x a b) (list x a b))
その他の順位付きキューの基本関数も、最初に定義したものと変わらない。
(define (empty? tree) (null? tree)) (define (min-elem tree) (match tree ((x _a _b) x))) (define (delete-min tree) (match tree ((_x a b) (merge a b)))) (define (insert x tree) (merge (fork x () ()) tree))
mergeも最初の定義と変わらず、joinの定義にミソがある。とは言うものの、実は最初の定義における6つのやりかたのうちの1つである。
(define (merge a b) (cond ((empty? b) a) ((empty? a) b) (else (if (<= (min-elem a) (min-elem b)) (join a b) (join b a))))) (define (join a0 c) (match a0 ((x a b) (fork x b (merge a c)))))
この後、1.6 遅延評価 へと続くのだが、Schemeの遅延評価をまだ理解しきっていないので、その辺は宿題とする。
prolog.el
1年以上ぶりにPrologを触ってみようとおもったら、Emacs上で何故かconsultできなかった。
当時（学生時代）どうやって動かしていたか記憶にないのだが、どうもprolog.elが古かったらしい。そのくせ .emacs の設定は新しいバージョン用に書いてた…。当時の自分は何をやってんだか。
そこで http://bruda.ca/emacs-prolog/ から落としてきた prolog.el を /usr/share/emacs/22.1/lisp/progmodes 以下のものと入れ替えたのだけれど、ちゃんと認識してくれない。
数分悩んで、CarbonEmacsは /Applications/Emacs.app 以下を見てることに気づく。こっちに置いてあげれば解決した。
なお、使っているProlog処理系は学生時代の名残で B-Prolog なんだけど、 .emacs の設定は
(setq prolog-system 'swi)
で大丈夫みたい。一瞬 SWI-Prolog に入れ替えようか迷ったけど、面倒だったからやめる。
