『関数プログラミングの楽しみ』の1章をPrologで書いてみる

Scheme版に引き続き、『関数プログラミングの楽しみ』の第1章を Prolog で書いてみた。使用した処理系はB-Prolog。恐らく他の処理系でも問題ないと思われる。


関数プログラミングの楽しみ
Jeremy Gibbons and Oege de Moor, 山下 伸夫
オーム社 ( 2010-06-23 )
ISBN: 9784274068058


それでは一気に行こう。

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.6 遅延評価

Prolog で遅延評価するにはどうしたらよいのだろうか? Scheme が lambda でくるむように、 trem でラップしてやるのかな?この辺は追々で。