1:- module(
2 closure,
3 [
4 leave_closure/3, 5 leave_closure0/3, 6 path_closure/3, 7 path_closure/4, 8 path_closure0/3, 9 path_closure0/4, 10 path_distance/4 11 ]
12).
20:- use_module(library(error)). 21:- use_module(library(lists)). 22:- use_module(library(plunit)). 23
24:- meta_predicate
25 leave_closure(2, ?, ?),
26 leave_closure0(2, ?, ?),
27 path_closure(2, ?, ?),
28 path_closure(2, ?, ?, -),
29 path_closure0(2, ?, ?),
30 path_closure0(2, ?, ?, -),
31 path_closure_1(2, +, -, +, -),
32 path_closure_2(2, -, +, +, -),
33 path_distance(2, -, +, -),
34 path_distance1(2, +, -, +, +, -),
35 path_distance2(2, -, +, +, +, -).
45leave_closure(Goal_2, X, Z) :-
46 ground(X), !,
47 call(Goal_2, X, Y),
48 leave_closure_1(Goal_2, Y, Z, [X,Y]).
49leave_closure(Goal_2, X, Z) :-
50 ground(Z), !,
51 call(Goal_2, Y, Z),
52 leave_closure_2(Goal_2, X, Y, [Y,Z]).
53leave_closure(_, X, Y) :-
54 instantiation_error(args(X,Y)).
62leave_closure0(Goal_2, X, Y) :-
63 ground(X), !,
64 leave_closure_1(Goal_2, X, Y, [X]).
65leave_closure0(Goal_2, X, Y) :-
66 ground(Y), !,
67 leave_closure_2(Goal_2, X, Y, [Y]).
68leave_closure0(_, X, Y) :-
69 instantiation_error(args(X,Y)).
70
71leave_closure_1(Goal_2, X, Z, Hist) :-
72 call(Goal_2, X, Y),
73 \+ memberchk(Y, Hist), !,
74 leave_closure_1(Goal_2, Y, Z, [Y|Hist]).
75leave_closure_1(_, X, X, _).
76
77leave_closure_2(Goal_2, X, Z, Hist) :-
78 call(Goal_2, Y, Z),
79 \+ memberchk(Y, Hist), !,
80 leave_closure_2(Goal_2, X, Y, [Y|Hist]).
81leave_closure_2(_, X, X, _).
95path_closure(Goal_2, X, Y) :-
96 path_closure(Goal_2, X, Y, _).
97
98
99path_closure(Goal_2, X, Z, Path) :-
100 ground(X), !,
101 call(Goal_2, X, Y),
102 X \== Y,
103 path_closure_1(Goal_2, Y, Z, [Y,X], Path0),
104 reverse(Path0, Path).
105path_closure(Goal_2, X, Z, Path) :-
106 ground(Z), !,
107 call(Goal_2, Y, Z),
108 Y \== Z,
109 path_closure_2(Goal_2, X, Y, [Z,Y], Path0),
110 reverse(Path0, Path).
111path_closure(_, X, Y, _) :-
112 instantiation_error(args(X,Y)).
126path_closure0(Goal_2, X, Y) :-
127 path_closure0(Goal_2, X, Y, _).
128
129
130path_closure0(Goal_2, X, Y, Path) :-
131 ground(X), !,
132 path_closure_1(Goal_2, X, Y, [X], Path0),
133 reverse(Path0, Path).
134path_closure0(Goal_2, X, Y, Path) :-
135 ground(Y), !,
136 path_closure_2(Goal_2, X, Y, [Y], Path0),
137 reverse(Path0, Path).
138path_closure0(_, X, Y, _) :-
139 instantiation_error(args(X,Y)).
140
141path_closure_1(_, X, X, Path, Path).
142path_closure_1(Goal_2, X, Z, Hist, Path) :-
143 call(Goal_2, X, Y),
144 \+ memberchk(Y, Hist),
145 path_closure_1(Goal_2, Y, Z, [Y|Hist], Path).
146
147path_closure_2(_, X, X, Path, Path).
148path_closure_2(Goal_2, Z, X, Hist, Path) :-
149 call(Goal_2, Y, X),
150 \+ memberchk(Y, Hist),
151 path_closure_2(Goal_2, Z, Y, [Y|Hist], Path).
160path_distance(Goal_2, X, Y, N) :-
161 ground(X), !,
162 path_distance1(Goal_2, X, Y, [X], 0, N).
163path_distance(Goal_2, X, Y, N) :-
164 ground(Y), !,
165 path_distance2(Goal_2, X, Y, [X], 0, N).
166path_distance(_, X, Y, _) :-
167 instantiation_error(args(X,Y)).
168
169path_distance1(_, X, X, _, N, N).
170path_distance1(Goal_2, X, Z, Hist, N1, N) :-
171 call(Goal_2, X, Y),
172 \+ memberchk(Y, Hist),
173 N2 is N1 + 1,
174 path_distance1(Goal_2, Y, Z, [Y|Hist], N2, N).
175
176path_distance2(_, X, X, _, N, N).
177path_distance2(Goal_2, Z, X, Hist, N1, N) :-
178 call(Goal_2, Y, X),
179 \+ memberchk(Y, Hist),
180 N2 is N1 + 1,
181 path_distance2(Goal_2, Z, Y, [Y|Hist], N2, N).
182
183
184
185
186
188
189:- begin_tests(closure). 190
191test(leave_closure, [set(Y==[charing_cross])]) :-
192 leave_closure(arc(1), bond_street, Y).
193
194test(path_closure, [set(Y-P == [b-[a,b],c-[a,b,c]])]) :-
195 path_closure(arc(2), a, Y, P).
196
197test(path_closure0, [set(Y-P == [a-[a],b-[a,b],c-[a,b,c]])]) :-
198 path_closure0(arc(2), a, Y, P).
199
200arc(1, bond_street, oxford_circus).
201arc(1, oxford_circus, tottenham_court_road).
202arc(1, bond_street, green_park).
203arc(1, green_park, charing_cross).
204arc(1, green_park, piccadilly_circus).
205arc(1, piccadilly_circus, leicester_square).
206arc(1, green_park, oxford_circus).
207arc(1, oxford_circus, piccadilly_circus).
208arc(1, piccadilly_circus, charing_cross).
209arc(1, tottenham_court_road, leicester_square).
210arc(1, leicester_square, charing_cross).
211arc(2, a, a).
212arc(2, a, b).
213arc(2, b, c).
214
215:- end_tests(closure).
Closures
Generic closure predicates that operate over graph data structures.
*/