Prolog Text refer

/**
 * Prolog code for the little solver.
 * With a union find element.
 *
 * Copyright 2012-2013, XLOG Technologies GmbH, Switzerland
 * Jekejeke Minlog 0.6 (minimal logic extension module)
 */

/********************************************************/
/* Little Solver with Union Find                        */
/********************************************************/

% refer(+Atom, +Atom)
% refer(X, Y) == X = Y
:- forward refer/2.

unit &:-
   &- refer(X, X), !.
refer(Z, Y) &:-
   &- refer(X, Y) && refer(X, Z), !.
refer(X, Z) &:-
   &- refer(X, Y) && refer(Y, Z), !.

% bound(+Atom, +Elem)
% bound(X, C) == X = C
:- forward bound/2.

bound(Y, C) &:-
   &- bound(X, C) && refer(X, Y), !.
zero &:-
   &- bound(X, C) && bound(X, D), C =\= D, !.
unit &:-
   &- bound(X, _) && bound(X, _), !.
bound(Y, C) &:-
   refer(X, Y) && &- bound(X, C).

% domain(+Atom, +List)
% domain(X, A) == X in A
:- forward domain/2.

zero &:-
   domain(_, []), !.
bound(X, Y) &:-
   &- domain(X, [Y]), !.
domain(Y, A) &:-
   &- domain(X, A) && refer(X, Y), !.
zero &:-
   &- domain(X, A) && bound(X, C), \+ member(C, A), !.
unit &:-
   &- domain(X, _) && bound(X, _), !.
domain(X, C) &:-
   &- domain(X, B) && &- domain(X, A), intersect(A, B, C), C \== A, !.
unit &:-
   &- domain(X, _) && domain(X, _), !.
domain(Y, A) &:-
   refer(X, Y) && &- domain(X, A).
zero &:-
   bound(X, Y) && &- domain(X, A), \+ member(Y, A), !.
unit &:-
   bound(X, _) && &- domain(X, _).

/********************************************************/
/* List Processing                                      */
/********************************************************/

% member(+Elem, +List)
member(X, [X|_]).
member(X, [_|Y]) :-
   member(X, Y).

% intersect(+List, +List, -List)
intersect([], _, []).
intersect([X|Y], Z, [X|T]) :-
   member(X, Z), !, intersect(Y, Z, T).
intersect([_|Y], Z, T) :-
   intersect(Y, Z, T).

/********************************************************/
/* Test Cases                                           */
/********************************************************/

% ?- post(domain(x,[1])), posted.
% bound(x, 1).
% Yes

% ?- post(domain(x,[1,2,3])), post(domain(y,[2,3,4])), posted.
% domain(x, [1,2,3]).
% domain(y, [2,3,4]).
% Yes

% ?- post(domain(x,[1,2,3])), post(domain(x,[2,3,4])), posted.
% domain(x, [2,3]).
% Yes

% ?- post(domain(x,[2,3])), post(domain(x,[2,3,4])), posted.
% domain(x, [2,3]).
% Yes

% ?- post(domain(x,[1,2,3])), post(domain(x,[2,3])), posted.
% domain(x, [2,3]).
% Yes

% ?- post(domain(x,[1,2,3])), post(bound(x,4)), posted.
% No

% ?- post(domain(x,[1,2,3])), post(bound(x,2)), posted.
% bound(x, 2).
% Yes

% ?- post(bound(x,4)), post(domain(x,[1,2,3])), posted.
% No

% ?- post(bound(x,2)), post(domain(x,[1,2,3])), posted.
% bound(x, 2).
% Yes

% ?- post(domain(x,[1,2,3])), post(refer(x,y)), post(domain(y,[2,3,4])), posted.
% refer(x, y).
% domain(y, [2,3]).
% Yes

% ?- post(domain(x,[1,2,3])), post(domain(y,[2,3,4])), post(refer(x,y)), posted.
% refer(x, y).
% domain(y, [2,3]).

Kommentare