小屋畑ソフトウェアサービス ブログページ

カテゴリー: PROLOG

  • labelingに関して

    制約論理プログラミングで必ず出てくるlabelingに関して説明しようと思います。
    だだーっとマニュアル見ないでいい加減に書くので多分嘘も書いてますが大体で読んでください。なるべくプログラム自体も書かない記述にします（めんどくさいので）

    概要的にはECLiPSe CLP のtutorialに書いてあることを抜粋して書くので英語読める人はそちらを読んでもらう方が絶対に良いです。とても分かりやすいです。
    ECLiPSeのtutorial

    制約論理プログラミングでは基本的なプログラムの構造は以下のような形になってます。
    １．制約の記述
    ２．解のサーチ
    ３．解の表示

    labelingというのはこれの2．解のサーチに相当します。

    labeling述語には制約変数のリストを渡します。
    例えば、（便宜的に整数のみ扱います。というか整数しか自分は扱い方が良くわかりません。）
    変数Aが１から３
    変数Bが１から３
    変数Cが１から３
    といった制約をつけた後、labeling([A,B,C])というような呼び出しをすると、A=1,B=1,C=1という解が設定されます。
    Prologをやっている人はピンとくると思いますが、labelingの呼び出しでバックトラックが発生し、failすると次のA=2,B=1,C=1という別解が設定されます。バックトラックするごとに制約を満たす解が順番に設定されます。

    ちょっと余談で、ECLiPSe CLPの資料を読んでるとことあるごとに口酸っぱく書いてあるのですが
    「１．の制約の記述の部分は、バックトラックを発生させてはいけない」とのことです。制約の部分でバックトラックを発生させる作りにすると正確な解が得られないとのことです。
    バックトラックの有無がPrologの一般的な述語と制約論理プログラミングの制約の大きな違いだと思います。
    ですので、ECLiPSe CLPにもSWI-PrologのCLPFDにもたくさん制約用の述語が定義されてますが、そのどれもがバックトラックをしない述語になってるはずです。

    これもまた余談ですがECLiPSeには自分が任意に定義したPrologの述語を制約に変換することが出来るPropiaという仕組みがあり、とても便利です。これを使うとバックトラックを生成させてしまう術語がバックトラックを生成しない制約に変わります。

    話は戻って、labelingなのですが、既定では与えられた変数群の解を生成する際、
    ・リストの先頭の変数から順番に値を確定
    ・値はドメイン（取りうる範囲）の小さいほうから大きいほうへ
    決定しています。

    ただ、これが一番良いやり方かどうかはわかりません。
    SWI-PrologのclpfdでもECLiPSe CLPでも「どの変数の値を優先的に決定するか」「値をどのように設定するか」の2つの観点でいろいろなオプションが用意されてます。
    例えば以下の観点のオプションなどあります。
    ・一番ドメインの範囲（取りうる値の範囲）が小さい変数から決定する
    ・値を中央から外側に向かうように設定する
    ・値をランダムに設定する

    SWI-PrologのCLPFDではここまでの話でlabelingに関しての説明は完了なのですが、ECLiPSe CLPはこのlabelingの部分を完全にプログラム制御できます。tutorialのTree Search Methodの項を見てください。

    まずlabelingを使用せずに、1つの制約変数を指定して、
    indomain(変数)という書き方ができます。
    これは変数の取りうる値を小さいほうから順に設定してfailするたびバックトラックをさせるという、labelingの1変数バージョンのような述語です。そしてindomainの2番目の引数にオプションを渡すと、いろいろな順番で値を決めることが出来ます（大きい順、ランダム、真ん中から、etc…）

    また、deleteという紛らわしい名前の述語があるのですが、これにfirst_failなどのオプションを指定して制約変数のリストを渡すと、指定したオプションに応じたやり方で1つ変数を取り出し、それ以外の変数をRestに返してくれます。
    first_failの場合はリスト内の一番ドメインが少ない変数を選択し、残りをRestで返します。
    （「次に値を決める変数の選択」を行ってくれる述語）

    ECLiPSeではこのdeleteとindomainを駆使して、細やかに変数のラベリングをコントロールできます。ECLiPSeのtutorialには、これらを使用してN-Queenの問題をいろいろなラベリング方法で解き、発生したバックトラックの回数を計測するという興味深い記事が出てますので是非読んでみてください。

    あとsearch/6という似たようなことする術語もあるのですがまだよくわかってません。
    あとECLiPSeでは整数以外の値が扱えるのですが、そのときにindomainの実数バージョンのようなlocateという術語があるのですが、これもまだ詳細に使いこなせてません。

    これ読んでる方もぜひ一緒に勉強しましょう（そして教えて下さい）

  • DOMINO PUZZLEソルバーの解説

    ここ最近、勉強で ECLiPSe CLPのExampleページのドミノタイル問題ソルバーのソースを解析していました。大体理解したので解説したいと思います。

    問題の解説：
    0-0、0-1、0-2…..6-6 の全部で28枚のドミノタイルがある。
    tiles

    このタイルが横８×縦７の長方形の中にランダムに敷き詰められている。
    縦、横、左右逆、上下逆のどの置き方でも良い。

    どのように置いたかは不明で、並べた結果全体の数字が以下のようになっていた場合、タイルがどのように配置されていたかを解け。
    3 1 2 6 6 1 2 2
    3 4 1 5 3 0 3 6
    5 6 6 1 2 4 5 0
    5 6 4 1 3 3 0 0
    6 1 0 6 3 2 4 0
    4 1 5 2 4 3 5 5
    4 1 0 2 4 5 2 0

    プログラムの解説：

    プログラムの概要を説明します。
    ①述語one_by_two_tiling/4でLeftとUpというマス同士の接続状態を表す配列を作成、制約を設定します。

    Leftの配列は以下の色のついた部分の接続状態を表す2次元配列です。
    1つのドミノタイルとしてつながっていれば１、つながっていなければ０になります。
    lefts

    Upは以下の色のついた部分の接続状態を表す2次元配列です。
    Ups

    制約のつけ方なのですが、あるマスに注目し上下左右の接続状態を考えたとき、必ず上下左右のいずれか1つの方向のみ接続されていることになるので、そのような制約を設定します（上下左右の変数の和が１）

    ②２つのdo文で、隣接した2マスに注目しながら、「2つの数字-対応する接続変数」の組み合わせをどんどんリストに集めます。このとき、タイルは数字が小-大の順番になるようにして保存します。
    その部分にタイルが配置されていた場合は、該当する接続状態の変数が1になるというわけです。

    scan
    ヨコ方向の隣接マスに注目した後は、タテ方向で同様の操作を行います。どちらも同じ配列にまとめます。
    このようにまとめると当然 (1,4)-変数 というような組み合わせが複数見つかりますが、いくつか見つかった中のどれか1つの組み合わせだけが実際に配置されているタイルの情報だということになります。

    ③まとめた配列をkeysortでソートします。タイルごとにまとまります。

    ④group_same_key_values/2で、ソート後の
    […(1,4)-接続状態変数1,(1,4)-接続状態変数2,(1,4)-接続状態変数3,(1,5)-接続状態変数4,(1,5)-接続状態変数5…]
    のような状態のリストを
    […(1,4)-[接続状態変数1,接続状態変数2,接続状態変数3],(1,5)-[接続状態変数4,接続状態変数5]…]
    のような形式にまとめます。

    ⑤
    [接続状態変数1,接続状態変数2,接続状態変数3]　の和が１
    [接続状態変数4,接続状態変数5]　の和が１
    というような制約を設定します(foreach)

    ⑥term_variableで全変数を1つのリストにまとめた後labelingですべての接続状態変数の解を探します。

    ⑦
    prety_print出力結果：
    pretty_print

  • 四角に切れ（パズル）を解くプログラム

    昔いくつか書いたPrologのパズルソルバーのコードがリンク切れになってたので再掲します。

    今回は四角に切れ（パズル）のソルバーです。

    プログラム
    解説と実行結果

    これも数年後、英語のStackOverFlow で以下の ECLiPSe CLP で書かれたプログラムを発見しました。
    ECLiPSe の開発メンバーのjschimpfさんのコードですね。
    ECLiPSeで書かれた四角に切れソルバー

  • RUSH HOUR(パズル)を解くプログラム

    昔いくつか書いたPrologのパズルソルバーのコードがリンク切れになってたので再掲します。

    今回はラッシュアワーというパズルを解くプログラムです。

    プログラム
    解説と実行結果

  • ペントミノを解くプログラム

    昔いくつか書いたPrologのパズルソルバーのコードがリンク切れになってたので再掲します。

    今回はペントミノのソルバーです。

    プログラム
    解説と実行結果

  • 数独を解くプログラム

    昔いくつか書いたPrologのパズルソルバーのコードがリンク切れになってたので再掲します（これから4回分続きます）。

    まずは数独のソルバーです。

    これ書いたときはまだ制約論理プログラミングのことを知らなかったのでPure Prologで書いてます（SWI-Prolog)。

    その後SWI-Prologのマニュアルのclpfdライブラリの説明の箇所の数独ソルバーのプログラムを発見して衝撃を受け、制約論理プログラミングの勉強を開始したのであった。

    プログラム
    解説と実行結果

    以下は僕が衝撃を受けたSWI-Prologのマニュアルに載っている数独ソルバー（僕のプログラムよりエレガントかつ速い）

    :- use_module(library(clpfd)).
sudoku(Rows) :-
	length(Rows, 9), maplist(same_length(Rows), Rows),
	append(Rows, Vs), Vs ins 1..9,
	maplist(all_distinct, Rows),
	transpose(Rows, Columns),
	maplist(all_distinct, Columns),
	Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
	blocks(As, Bs, Cs),
	blocks(Ds, Es, Fs),
	blocks(Gs, Hs, Is).

blocks([], [], []).
blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
	all_distinct([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
	blocks(Ns1, Ns2, Ns3).
problem(1, [[_,_,_,_,_,_,_,_,_],
	[_,_,_,_,_,3,_,8,5],
	[_,_,1,_,2,_,_,_,_],
	[_,_,_,5,_,7,_,_,_],
	[_,_,4,_,_,_,1,_,_],
	[_,9,_,_,_,_,_,_,_],
	[5,_,_,_,_,_,_,7,3],
	[_,_,2,_,1,_,_,_,_],
	[_,_,_,_,4,_,_,_,9]]).

    実行結果：

    ?- problem(1, Rows), sudoku(Rows), maplist(portray_clause, Rows).
[9, 8, 7, 6, 5, 4, 3, 2, 1].
[2, 4, 6, 1, 7, 3, 9, 8, 5].
[3, 5, 1, 9, 2, 8, 7, 4, 6].
[1, 2, 8, 5, 3, 7, 6, 9, 4].
[6, 3, 4, 8, 9, 2, 1, 5, 7].
[7, 9, 5, 4, 6, 1, 8, 3, 2].
[5, 1, 9, 2, 8, 6, 4, 7, 3].
[4, 7, 2, 3, 1, 9, 5, 6, 8].
[8, 6, 3, 7, 4, 5, 2, 1, 9].
Rows = [[9, 8, 7, 6, 5, 4, 3, 2|...], ... , [...|...]].

  • Project Euler Problem 62

    Problem 62

    ECLiPSe CLP で解きました。
    ほぼPure Prolog で、制約論理の述語は使用してません。
    自分のマシンで約9秒。

    プログラム：

    :-lib(util).
:-dynamic(cubic_sorted/2).

go:-
	retractall(cubic_sorted(_,_)),
	between(1,1000000000000,I),
		CubicNum is I * I * I,
		digit_sort(CubicNum,Sorted),
		assert(cubic_sorted(Sorted,I)),
		findall(Num,cubic_sorted(Sorted,Num),NumLst),
		length(NumLst,NumLen),
		(
			NumLen>=5->
				sort(NumLst,NumLstSorted),
				[First|_]=NumLstSorted,
				CubeFirst is First * First * First,
				printf(output, "CubicNum %d ,Lst %w", [CubeFirst, NumLst]),nl,
				true
				;
				fail
		)
	.

digit_sort(Num,Sorted):-
	num2lst(Num,Lst),
	msort(Lst,Sorted).

% convert number to list(reversed)
num2lst(0,[]):-!.
num2lst(Num,[Dig|DigRst]):-
	Dig is Num mod 10,
	RestNum is Num // 10,
	num2lst(RestNum,DigRst).

    コマンドライン：

    ?- time(go).
    Yes (9.22s cpu)

    標準出力：

    <解答伏せます。>

    Success, times: 9.218750s thread, 9.219+0.000s process, 9.224s real

  • Project Euler Problem 59

    Problem 59

    全体の文字数 – 「何文字がA-Z a-zの範囲だったか」　の数値をコストとして計算し、一番コストが小さくなるものをbb_minで調べました。
    あんまり効率よくないプログラムで、1900秒くらいかかりました…遅いな…
    あとテキストの文字数が3の倍数というところは前もって調べてて、それをあてにしたプログラムになってます（文字数が3の倍数でないとdecryptでこける）

    ソース

    :-lib(ic).
:-lib(ic_sets).
:-lib(propia).
:-lib(branch_and_bound).
:-lib(csv).

go(Str,Cost,Sum) :-
	csv:(csv_read("p059_cipher.txt", [InLst], Option)),
	char_code('a',AscA),
	char_code('z',AscZ),
	[Key1,Key2,Key3]#::AscA..AscZ,
	decrypt(InLst,OutLst,[Key1,Key2,Key3]),
	OutLst#::0..127,
	OutLst#::0..127,
	letter_count(OutLst,Cnt),
	length(OutLst,Len),
	Cost #= Len - Cnt, 
	flatten([Key1,Key2,Key3,OutLst],AllVals),
	labeling(AllVals),
	iso_light:(atom_codes(Str,OutLst)),
	mysum(OutLst,Sum).

decrypt([],[],_).
decrypt([N1,N2,N3|NRest],[D1,D2,D3|DRest],[K1,K2,K3]):-
	xor(N1,K1,D1) infers most,
	xor(N2,K2,D2) infers most,
	xor(N3,K3,D3) infers most,
	decrypt(NRest,DRest,[K1,K2,K3]).

letter_count([],0).
letter_count([First|Rest],Cnt):-
	letter_count(Rest,Cnt1),
	#::(First, [65..90, 97..122],Hit),
	Cnt #= Cnt1+Hit.

mysum([],0).
mysum([First|Rest],Sum):-
	mysum(Rest,Sum1),
	Sum is Sum1 + First.

    実行結果

    ?- bb_min(go(A, Cost, Sum), Cost, _223).
A = 復号化した文字列（伏せます）
Cost = 伏せます
Sum = 伏せます
Yes (1893.05s cpu)

  • Project Euler Problem 52

    Problem52

    ECLiPSeで解きました。
    処理時間は自分のマシン(Intel(R) Core(TM) i5-3340M CPU @ 270GHz)で6.5秒くらい。
    見どころ？はECLiPSeのlogical-loopで書いた順列permutationと、propiaで数値を入れ替えた制約を作っているところ
    logical loop はループ用のサブ述語みたいなアホっぽい定義がなくなってコードがエレガントになるのでSWI-Prologでもぜひ正式採用してほしい。
    桁のところは一般化してなく、1桁、2桁、3桁…　と手入力で増やしながら確認しました
    （bb_minでそれぞれの桁での最小の数値が取れるようにしてます）。

    プログラム：

    :-lib(ic).
:-lib(propia).
:-lib(branch_and_bound).

go(Digits,[X1num,X2num,X3num,X4num,X5num,X6num]) :-
	length(X1Lst,Digits),
	X1Lst#::[0..9],
	lst2num(X1Lst,X1num),
	X1num #> 10 ^ (Digits-1),
	X2num #= X1num * 2,
	X3num #= X1num * 3,
	X4num #= X1num * 4,
	X5num #= X1num * 5,
	X6num #= X1num * 6,
	permutation(X1Lst,X2Lst) infers most,
	lst2num(X2Lst,X2num),
	permutation(X1Lst,X3Lst) infers most,
	lst2num(X3Lst,X3num),
	permutation(X1Lst,X4Lst) infers most,
	lst2num(X4Lst,X4num),
	permutation(X1Lst,X5Lst) infers most,
	lst2num(X5Lst,X5num),
	permutation(X1Lst,X6Lst) infers most,
	lst2num(X6Lst,X6num),
	labeling([X1num,X2num,X3num,X4num,X5num,X6num]).
	
lst2num(L,N):-
	(foreach(Num,L),fromto(0,In,Out,N),count(I,0,_)
		do
		Out #= In + 10^I * Num
	).

permutation(A,B):-
	(fromto(A,AIn,AOut,[]),fromto(B,[BFirst|BRest],BRest,[])
		do
		select(BFirst,AIn,AOut)
	).

    実行結果（解答伏せます）：

    ?- bb_min(go(XXXXXXX, [N1, N2, N3, N4, N5, N6]), N1, Option).
N1 = XXXXXXXX
N2 = XXXXXXXX
N3 = XXXXXXXX
N4 = XXXXXXXX
N5 = XXXXXXXX
N6 = XXXXXXXX
Option = bb_options(continue, -1.0Inf, 1.0Inf, 1, 1, 0, 0, one, _466, _467, _468)
Yes (6.59s cpu)

  • Project Euler Problem79

    久しぶりにProject Eulerやってみました。
    制約論理プログラミングで解きました。ほとんど頭使ってない…
    SWI-Prologです。

    Problem79

    :-use_module(library(clpfd)).

solve(A,Len):-
	length(A,Len),
	A ins 0..9,
	choice(A,[3,1,9],IdxLst1,Len),
	choice(A,[6,8,0],IdxLst2,Len),
	choice(A,[1,8,0],IdxLst3,Len),
	choice(A,[6,9,0],IdxLst4,Len),
	choice(A,[1,2,9],IdxLst5,Len),
	choice(A,[6,2,0],IdxLst6,Len),
	choice(A,[7,6,2],IdxLst7,Len),
	choice(A,[6,8,9],IdxLst8,Len),
	choice(A,[7,6,2],IdxLst9,Len),
	choice(A,[3,1,8],IdxLst10,Len),
	choice(A,[3,6,8],IdxLst11,Len),
	choice(A,[7,1,0],IdxLst12,Len),
	choice(A,[7,2,0],IdxLst13,Len),
	choice(A,[7,1,0],IdxLst14,Len),
	choice(A,[6,2,9],IdxLst15,Len),
	choice(A,[1,6,8],IdxLst16,Len),
	choice(A,[1,6,0],IdxLst17,Len),
	choice(A,[6,8,9],IdxLst18,Len),
	choice(A,[7,1,6],IdxLst19,Len),
	choice(A,[7,3,1],IdxLst20,Len),
	choice(A,[7,3,6],IdxLst21,Len),
	choice(A,[7,2,9],IdxLst22,Len),
	choice(A,[3,1,6],IdxLst23,Len),
	choice(A,[7,2,9],IdxLst24,Len),
	choice(A,[7,2,9],IdxLst25,Len),
	choice(A,[7,1,0],IdxLst26,Len),
	choice(A,[7,6,9],IdxLst27,Len),
	choice(A,[2,9,0],IdxLst28,Len),
	choice(A,[7,1,9],IdxLst29,Len),
	choice(A,[6,8,0],IdxLst30,Len),
	choice(A,[3,1,8],IdxLst31,Len),
	choice(A,[3,8,9],IdxLst32,Len),
	choice(A,[1,6,2],IdxLst33,Len),
	choice(A,[2,8,9],IdxLst34,Len),
	choice(A,[1,6,2],IdxLst35,Len),
	choice(A,[7,1,8],IdxLst36,Len),
	choice(A,[7,2,9],IdxLst37,Len),
	choice(A,[3,1,9],IdxLst38,Len),
	choice(A,[7,9,0],IdxLst39,Len),
	choice(A,[6,8,0],IdxLst40,Len),
	choice(A,[8,9,0],IdxLst41,Len),
	choice(A,[3,6,2],IdxLst42,Len),
	choice(A,[3,1,9],IdxLst43,Len),
	choice(A,[7,6,0],IdxLst44,Len),
	choice(A,[3,1,6],IdxLst45,Len),
	choice(A,[7,2,9],IdxLst46,Len),
	choice(A,[3,8,0],IdxLst47,Len),
	choice(A,[3,1,9],IdxLst48,Len),
	choice(A,[7,2,8],IdxLst49,Len),
	choice(A,[7,1,6],IdxLst50,Len),
	label(A).


choice(A,[P1,P2,P3],[N1,N2,N3],Cnt):-
	[N1,N2,N3] ins 1..Cnt,
	element(N1,A,P1),
	element(N2,A,P2),
	element(N3,A,P3),
	N1 #< N2,
	N2 #< N3.

    回答伏せます