Prologに投稿されたコード一覧

Prolog (蛇足) can_unify/2を使って、定義3のremoveを定義1,2とよく似た形で定義する。

% can_unify/2
% 「can_unify(X, Y) が成功する」⇔「X = Y が成功する」、ただし単一化は行われない。
can_unify(X, Y) :-
	setof(Z, (Z = X, X = Y), [_|_]).

?- can_unify(a:_, a:1).
?- \+ can_unify(b:_, a:_).

remove(_, [], []).
remove(E, [H|Src],    Dst ) :- can_unify(E, H), !, remove(E, Src, Dst).
remove(E, [H|Src], [H|Dst]) :- remove(E, Src, Dst).

?- remove(a:_, [a:1, a:1, a:2, b:2], [b:2]).

Prolog remove 述語の定義―リスト[a:1, a:2]から[a:_ をすべて取り除いた結果は?

% テストデータ
ls([a:1, a:1, a:2, b:2]).

% 定義1 - 等号の失敗を使って排除
remove_v1(_, [], []).
remove_v1(E, [E|L1],    L2 ) :- remove_v1(E, L1, L2).
remove_v1(E, [H|L1], [H|L2]) :- \+(E = H), remove_v1(E, L1, L2).

?- ls(Src), setof(L, remove_v1(a:_, Src, L), [[a:2, b:2]]).

% 定義2 - 単一化の失敗とカットを使って排除
remove_v2(_, [], []).
remove_v2(E, [E|L1], L2) :- !, remove_v2(E, L1, L2).
remove_v2(E, [H|L1], [H|L2]) :- remove_v2(E, L1, L2).

?- ls(Src), setof(L, remove_v2(a:_, Src, L), [[a:2, b:2]]).

% 定義3 - 「単一化できない要素」全体を求める
remove_v3(Val, Ls, Rs) :-
	findall(E, (member(E, Ls), E \= Val), Rs).

?- ls(Src), setof(L, remove_v3(a:_, Src, L), [[b:2]]).

Prolog 非決定性の述語 単位行列/2 (「添字」を用いるバージョン)

natural(0).
natural(s(N)) :- natural(N).

natural(0, 0).
natural(s(N), X) :- number(X), !, X > 0, X1 is X - 1, natural(N, X1).	% N によって変項 X を単一化させる場合
natural(s(N), X) :- var(X), !, integer_itetate(X, 1), natural(s(N), X).	% 両方変項の場合
natural(s(N), X) :- natural_acc(N, X, 1), !.	% X によって変項 N を単一化させる場合
natural_acc(0, X, X).
natural_acc(s(N), X, Acc) :- Acc1 is Acc + 1, natural_acc(N, X, Acc1).

integer_itetate(X, X).
integer_itetate(X, L) :- L1 is L + 1, integer_itetate(X, L1).

mylength_n([], 0).
mylength_n([Head|Tail], s(N)) :- mylength_n(Tail, N).

at_n([Val|_], 0, Val).
at_n([_|List], s(N), Val) :- at_n(List, N, Val).

insertAt_n(List, 0, Val, [Val|List]).
insertAt_n([X|List], s(N), Val, [X|Tail]) :- insertAt_n(List, N, Val, Tail).

零リスト([]).
零リスト([0|T]) :- 零リスト(T).

単位行列_n(0, []).
単位行列_n(s(N), LL) :- 単位行列_n(s(N), LL, 0).	% 行番号によってループする

単位行列_n(N, [], N).
単位行列_n(N, [Row|RowT], M) :-
	mylength_n(Row, N), insertAt_n(RowRems, M, 1, Row), 零リスト(RowRems),
	単位行列_n(N, RowT, s(M)).

単位行列(X, LL) :- natural(N, X), 単位行列_n(N, LL).	% インターフェイス

?- 単位行列(2, [[1, 0], [0, 1]]).	%=> yes
?- 単位行列(N, [[1, 0], [0, 1]]).	%=> N = 2 ; ... (無限ループに陥る)
?- 単位行列(2, LL).	%=> LL = [[1,0],[0,1]] ; no
?- 単位行列(N, LL).	%=> N = 0, 1, 2, ... と順次成功する

Prolog 非決定性の述語 単位行列/2

mylength([], 0).
mylength([_|T], N) :- mylength(T, N1), N is N1 + 1.

零リスト([]).
零リスト([0|T]) :- 零リスト(T).

単位行列(N, LL) :- mylength(LL, N), 単位行列_(N, LL).
単位行列_(0, []).
単位行列_(N, [[1|RowT]|T]) :-
%	number(N), N > 0,
	N1 is N - 1, mylength(RowT, N1), !,	% important!
	行列の左に列ベクトルを加える(T1, ClmT, T),
	零リスト(RowT), 零リスト(ClmT),
	単位行列_(N1, T1).

行列の左に列ベクトルを加える([], [], []).
行列の左に列ベクトルを加える([T|LL1], [H|V], [[H|T]|LL]) :-
	行列の左に列ベクトルを加える(LL1, V, LL).

?- 単位行列(2, [[1, 0], [0, 1]]).
/*
yes
*/

?- 単位行列(N, [[1, 0], [0, 1]]).
/*
N = 2 ;
no
*/

% うまく定義しないと no が返らず無限ループに陥ることも。

?- 単位行列(2, LL).
/*
LL = [[1, 0], [0, 1]] ;
... (無限ループに陥る)
*/

% no を返してほしいところだが、次の結果を得るためにはこの挙動にならざるをえない?

?- 単位行列(N, LL).
/*
N = 0, LL = [] ;
N = 1, LL = [[1, 0], [0, 1]] ;
N = 2, LL = [[1, 0, 0], [0, 1, 0], [0, 0, 1]] ;
N = 3, LL = [[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]] ;
... (各Nについて無限に成功する)
*/

% うまく定義しないと N = 0, 1 だけで終わってしまうことも。

Prolog 21世紀における0~3の数字を2個ずつ使ってできる年月日の個数 (「禁則」によって表現するバージョン)

順列(Y,0,[]).
順列(Y,N,[A|X]) :- del(A,Y,Z), M is N - 1, 順列(Z,M,X).
del(A,[A|X],X).
del(A,[B|X],[B|Y]) :- del(A,X,Y).

小の月(2).
小の月(4).
小の月(6).
小の月(9).
小の月(11).
% 小の月(M) :- 月の日数(M, Days), Days < 31.

'「禁則」の簡略化のために利用する諸命題' :-
	'閏年か否かは考慮しなくてよい',
	'2月以外の小の月の存在は考慮しなくてよい',
	'0月、14~19月および40月以上の年月日ならびは発生しない',
	'0日および34日以上の年月日ならびは発生しない'.

'閏年か否かは考慮しなくてよい' :-
%      ∀ L [ L : '順列と21世紀の条件'を満たす ⇒ L : 2月29日を表す年月日並びではない ]
% ⇔ ¬∃ L [ L : '順列と21世紀の条件'を満たす ∧ L : 2月29日を表す年月日並びである ]
	\+ 順列と21世紀の条件([_,_,_,_, 0,2, 2,9]).

'2月以外の小の月の存在は考慮しなくてよい' :-
	% 小の月:31日の存在しない月
	\+ (
		順列と21世紀の条件([_,_,_,_, M1,M2, 3,1]),
		M is (M1 * 10 + M2), '2月以外の小の月'(M)
	).

'2月以外の小の月'(M) :- M \== 2, 小の月(M).

'0月、14~19月および40月以上の年月日ならびは発生しない' :-
	% 0月が発生しないのは、21世紀だから、年が0を少なくとも1つ使うため
	\+ (
		順列と21世紀の条件([_,_,_,_, M1,M2, _,_]),
		M is (M1 * 10 + M2),
		( M == 0 ; (14 =< M, M =< 19) ; M >= 40 )  % まとめた
	).

'0日および34日以上の年月日ならびは発生しない' :-
	\+ (
		順列と21世紀の条件([_,_,_,_, _,_, D1,D2]),
		D is D1 * 10 + D2,
		( D == 0 ; D >= 34 )
	).

順列と21世紀の条件(L) :-
	順列([0,0,1,1,2,2,3,3], 8, L),   % 「0~3の数字を2個ずつ使ってできる」こと
	[2,0,0,1, 0,1, 0,1] @=< L,      % 「21世紀」であること
	L @=< [2,1,0,0, 1,2, 3,1].

禁則([_,_,_,_, 0,2, 3,_]) :- !.
禁則([_,_,_,_, 1,3, _,_]) :- !.
禁則([_,_,_,_, 2,_, _,_]) :- !.
禁則([_,_,_,_, 3,_, _,_]) :- !.
禁則([_,_,_,_, _,_, 3,2]) :- !.
禁則([_,_,_,_, _,_, 3,3]) :- !.

条件(L) :-
%	L = [Y1,Y2,Y3,Y4, M1,M2, D1,D2],
	順列と21世紀の条件(L),
	\+ 禁則(L).             % 「年月日ならび」であるための条件 ('順列と21世紀の条件'と併せて)

?- '「禁則」の簡略化のために利用する諸命題',
	setof(L, 条件(L), Ls), length(Ls, N).
% N = 48

/*
備考:全称命題の証明は面倒くさいので、二重否定を使って“存在の否定”命題に変形した。
	'∀x p(x)' :- setof(x, p(x), (x の全体集合を表す整列されたリスト)).
%	:- setof(x, x ∈ 全体集合, (x の全体集合を表す整列されたリスト)).
*/

Prolog 21世紀における0~3の数字を2個ずつ使ってできる年月日の個数

remove1(E, [E|Tail], Tail).
remove1(E, [X|Tail], [X|List]) :- remove1(E, Tail, List).

permutation([], []).
permutation(List, [H|Tail]) :- remove1(H, List, List1), permutation(List1, Tail).

条件(L) :-
	permutation([0,0,1,1,2,2,3,3], L),
	L = [Y1, Y2, Y3, Y4,  M1, M2,  D1, D2],
	Y is (Y1 * 1000 + Y2 * 100 + Y3 * 10 + Y4),
	M is (M1 * 10 + M2),
	D is (D1 * 10 + D2),
	年の条件(Y),
	月日の条件(Y, M, D).

年の条件(Y) :- 2001 =< Y, Y =< 2100.
月日の条件(Y, M, D) :-
	月の日数(Y, M, Days),
	1 =< M, M =< 12,
	1 =< D, D =< Days.

月の日数(_,  1, 31).
月の日数(Y,  2, 29) :- 閏年(Y), !.
月の日数(Y,  2, 28).
月の日数(_,  3, 31).
月の日数(_,  4, 31).
月の日数(_,  5, 31).
月の日数(_,  6, 30).
月の日数(_,  7, 31).
月の日数(_,  8, 31).
月の日数(_,  9, 30).
月の日数(_, 10, 31).
月の日数(_, 11, 30).
月の日数(_, 12, 31).

閏年(Y) :- Y mod 4 == 0, (Y mod 100 \== 0 ; Y mod 400 == 0).

?- setof(L, 条件(L), Ls), length(Ls, N).
% N = 48

Prolog マッチ棒を動かして10を3つ作るパズル

一要素置換([Bef|Tail], [Aft|Tail], (Bef, Aft)).
一要素置換([X|BefTail], [X|AftTail], Replace) :-
	一要素置換(BefTail, AftTail, Replace).

% デジタル文字の定義
デジタル文字(X) :- デジタル文字(X, _).
デジタル文字((number, Ptn),   Char) :- デジタル数字((number, Ptn), Char).
デジタル文字((operator, Ptn), Char) :- デジタル演算子((operator, Ptn), Char).

デジタル数字((number, [1, 1, 1, 1, 0, 1, 1]), 0).		% 8 の各所に対応するマッチ棒の有無を表すリスト
デジタル数字((number, [0, 0, 1, 0, 0, 1, 0]), 1).
デジタル数字((number, [0, 1, 1, 1, 1, 0, 1]), 2).
デジタル数字((number, [0, 1, 1, 0, 1, 1, 1]), 3).
デジタル数字((number, [1, 0, 1, 0, 1, 1, 0]), 4).
デジタル数字((number, [1, 1, 0, 0, 1, 1, 1]), 5).
デジタル数字((number, [1, 1, 0, 1, 1, 1, 1]), 6).
デジタル数字((number, [1, 1, 1, 0, 0, 1, 0]), 7).		% “ワ”型
デジタル数字((number, [1, 1, 1, 1, 1, 1, 1]), 8).
デジタル数字((number, [1, 1, 1, 0, 1, 1, 1]), 9).

デジタル演算子((operator, [1, 1, 0, 0]), '+').
デジタル演算子((operator, [0, 1, 0, 0]), '-').
デジタル演算子((operator, [0, 0, 1, 1]), '*').		% ×
%デジタル演算子((operator, [0, 0, 0, 1]), '/').		% /

デジタル文字列([]).
デジタル文字列([Head|Tail]) :- デジタル文字(Head), デジタル文字列(Tail).

デジタル文字列([], []).
デジタル文字列([DH|DigitString], [H|String]) :-
	デジタル文字(DH, H), デジタル文字列(DigitString, String).

棒を1本加える((Type, Ptn), (Type, PtnAfter)) :-	% 入出力がデジタル文字かは無視
	一要素置換(Ptn, PtnAfter, (0, 1)).
棒を1本減らす((Type, Ptn), (Type, PtnAfter)) :-
	一要素置換(Ptn, PtnAfter, (1, 0)).

棒を1本動かす(Chars, CharsAfter) :-
	棒を1本減らす(Chars, CharsTmp1),
	棒を1本加える(CharsTmp1, CharsAfter),
	Chars \== CharsAfter.

棒を1本加える([Char|Tail], [CharAfter|Tail]) :-
	棒を1本加える(Char, CharAfter).
棒を1本加える([X|CharsTail], [X|CharsAfterTail]) :-
	棒を1本加える(CharsTail, CharsAfterTail).

棒を1本減らす([Char|Tail], [CharAfter|Tail]) :-
	棒を1本減らす(Char, CharAfter).
棒を1本減らす([X|CharsTail], [X|CharsAfterTail]) :-
	棒を1本減らす(CharsTail, CharsAfterTail).

% 数式化 (ただし加減乗除 + - * / のみ)
数式化([X, Op1, Y, Op2, Z], Expr) :-
	current_op(Op1Priority, _, Op1),
	current_op(Op2Priority, _, Op2),
	Op1Priority =< Op2Priority
		-> ( Expr1 =.. [Op1, X, Y], Expr =.. [Op2, Expr1, Z] )
		;  ( Expr1 =.. [Op2, Y, Z], Expr =.. [Op1, X, Expr1] ).

%	?- 数式化([1, '+', 2, '+', 3], X).
%	?- 数式化([1, '*', 2, '+', 3], X).
%	?- 数式化([1, '+', 2, '*', 3], X).
%	?- 数式化([1, '*', 2, '*', 3], X).

% 長さからリストを単一化できる述語 (AZ-Prolog の length にはその機能がない故)
mylen([], 0).
mylen([_|Tail], N) :- N > 0, N1 is N - 1, mylen(Tail, N1).

append([], L, L).
append([H|T1], L, [H|T2]) :- append(T1, L, T2).

append_fold([], []).
append_fold([H|Tail], Sum) :- append_fold(Tail, TailSum), append(H, TailSum, Sum).

% 例題
?-	Q = [
		5, '-', 1, '+', 4,
		4, '*', 7, '-', 5,
		6, '-', 4, '+', 8
	],
	% A は、Q のデジタル文字列の棒を3本動かしてできるデジタル文字列で表現できる
	デジタル文字列(Enc0, Q),
	棒を1本動かす(Enc0,  Enc1),
	棒を1本動かす(Enc1, Enc2), Enc0 \== Enc2,
	棒を1本動かす(Enc2, Enc3), Enc0 \== Enc3, Enc1 \== Enc3,
	デジタル文字列(Enc3, A),
%	write(A), nl,

	% 3つの式の答えがすべて10である
	mylen(A1, 5), mylen(A2, 5), mylen(A3, 5),
	append_fold([A1, A2, A3], A),
	数式化(A1, E1), 10 is E1,	% E1 is 10 ではない
	数式化(A2, E2), 10 is E2,
	数式化(A3, E3), 10 is E3.

% 答えはおそらくこの2通り
% A = [7,-,1,+,4,4,*,4,-,6,6,-,4,+,8]
% A = [5,+,1,+,4,1,*,7,+,3,6,-,4,+,8]

Prolog Prologのテスト

% File   : queens.pl
% Updated: 14 February 2008
% Purpose: N-Queen Puzzle (posed by Franz Nauch, 1850)

main :-
	write('N-Queen Puzzle (posed by Franz Nauch, 1850) '), nl,
	write('N = '),
	flush_output,
	read(N),
	N >= 4,
	read_yn('All solutions (y/n)? ', All),
	read_yn('Output (y/n)? ', Output),
	statistics(runtime, _),
	queen_solve(N, all(All), output(Output)),
	statistics(runtime, [_,T]),
	write('CPU time = '), write(T), write(' msec'), nl.

read_yn(Message, YN) :-
	write(Message),
	flush_output,
	read(X),
	(X == 'y' -> YN = yes; YN = no).

queen_solve(N, all(X), output(Y)) :-
	queens(N, Q),
	(Y == yes -> write(Q), nl; true),
	X == no,
	!.
queen_solve(_,_,_).

queens(N,Qs) :-
	range(1,N,Ns),
	queens(Ns,[],Qs).

queens([],Qs,Qs).
queens(UnplacedQs,SafeQs,Qs) :-
	select(UnplacedQs,UnplacedQs1,Q),
	not_attack(SafeQs,Q),
	queens(UnplacedQs1,[Q|SafeQs],Qs).

not_attack(Xs,X) :-
	not_attack(Xs,X,1).

not_attack([],_,_) :- !.
not_attack([Y|Ys],X,N) :-
	X =\= Y+N, X =\= Y-N,
	N1 is N+1,
	not_attack(Ys,X,N1).

select([X|Xs],Xs,X).
select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X).

range(N,N,[N]) :- !.
range(M,N,[M|Ns]) :-
	M < N,
	M1 is M+1,
	range(M1,N,Ns).
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
実行例 SWI-Prolog   (gprologでは失敗)

?- [queens].
% queens compiled 0.01 sec, 4,112 bytes
true.

?- main.
N-Queen Puzzle (posed by Franz Nauch, 1850)
N = 4.
All solutions (y/n)? y.
Output (y/n)? y.
[3, 1, 4, 2]
[2, 4, 1, 3]
CPU time = 0 msec
true.

?-

よく投稿されているコード

タグ

最近投稿されたコード