1:- module(preudg, [ends_frontier/1,
2 rect_links/2,
3 prepare_udg/1, prepare_udg/2,
4 prepare_udg_normal/1, prepare_udg_normal/2,
5 prepare_udg_reverse/1, prepare_udg_reverse/2,
6 normal_pair/2, end_node/1,
7 on_pair/2, off_pair/2,
8 intern_node_id/2,
9 setup_frontier_min/2, setup_frontier_max/2,
10 show_udg/0, show_udg_st/0,
11 raise_rel_to_fun/2, setup_prune_vector/1
12 ]). 13
14:- use_module(zdd('zdd-array')). 15:- use_module(zdd(zdd)). 16:- use_module(pac(op)). 17
18 22normal_pair(A-B, B-A):- B @< A, !.
23normal_pair(X, X).
25ends_frontier(efr(E, Fr)):-
26 b_getval(st, E),
27 b_getval(frontier, Fr).
29end_node(X):- b_getval(st, S-T),
30 ( X = S; X = T),
31 !.
33on_pair(I, J-K):- (K = I; J = I), !.
34
35off_pair(I, J-K):- I \== J, I \== K.
36
38rect_links(rect(W, H), Links):-
39 findall( p(I,J) - p(K,L),
40 ( between(0, W, I),
41 between(0, H, J),
42 ( L = J, K is I + 1, K =< W
43 ; K = I, L is J + 1, L =< H
44 )
45 ),
46 Links).
47
54
56
61
62 69
70prepare_udg(Links):-prepare_udg_reverse(Links). 72prepare_udg(ST, Links):- prepare_udg_reverse(Links),
73 prepare_ends(ST, ST0),
74 b_setval(st, ST0).
76prepare_udg_normal(Links):- pred_prepare_udg(Links, prepare_udg_normal).
78prepare_udg_normal(ST, Links):- pred_prepare_udg(ST, Links, prepare_udg_normal).
80prepare_udg_reverse(Links):- pred_prepare_udg(Links, prepare_udg_reverse).
82prepare_udg_reverse(ST, Links):- pred_prepare_udg(ST, Links, prepare_udg_reverse).
84pred_prepare_udg(Links, Pred):-
85 open_memo(memo_nodes),
86 call(Pred, Links, Links0, Succs, D, Vec),
87 b_setval(links, Links0),
88 b_setval(coa, Succs),
89 b_setval(dom, D),
90 b_setval(frontier, Vec).
91
93pred_prepare_udg_pvec(Links, Pred):-
94 open_memo(memo_nodes),
95 call(Pred, Links, Links0, Succs, D, Vec),
96 b_setval(links, Links0),
97 b_setval(coa, Succs),
98 b_setval(dom, D),
99 b_setval(frontier, Vec),
100 setup_prune_vector(Pvec),
101 b_setval(pvec, Pvec).
102
104pred_prepare_udg(ST, Links, Pred):-
105 call(Pred, Links),
106 prepare_ends(ST, Pair),
107 b_setval(st, Pair).
108
109show_udg:-
110 b_getval(links, Links), writeln(links=Links),
111 b_getval(coa, Succs), writeln(coa=Succs),
112 b_getval(dom, D), writeln(dom=D),
113 b_getval(frontier, Vec), writeln(frontier=Vec),
114 b_getval(pvec, Pvec), writeln(pvec=Pvec).
115
116show_udg_st:-show_udg, b_getval(st, ST), writeln(st=ST).
128prepare_udg_normal(Links, Normal_Links, Coa, D, Frontier):-
129 prepare_udg(Links, Normal_Links, Coa, D),
130 length(D, N),
131 length(As, N),
132 maplist(=(0), As),
133 Frontier=..[#|As],
134 setup_frontier_max(Normal_Links, Frontier).
136prepare_udg_reverse(Links, Normal_Links, Coa, D, Frontier):-
137 prepare_udg(Links, Normal_Links, Coa0, D),
138 maplist(reverse_right, Coa0, Coa1),
139 reverse(Coa1, Coa),
140 length(D, N),
141 numlist(1, N, As),
142 Frontier=..[#|As],
143 setup_frontier_min(Normal_Links, Frontier).
145reverse_right(X-L, X-ReverseL):- reverse(L, ReverseL).
147prepare_udg(Links, Normal_Links, Coa, D):-
148 intern_links(Links, Links0),
149 normal_mate_list(Links0, Links1),
150 sort(Links1, Normal_Links),
151 raise_rel_to_fun(Normal_Links, Coa0),
152 domain_of_links(Normal_Links, D), 153 length(D, N),
154 completing_succs(Coa0, Coa, 1, N).
155
157intern_node_id(A, I):- memo(node_id(A)-I, memo_nodes).
159prepare_ends(A-B, A0-B0):-!, R = [A0, B0],
160 intern_node_id(A, I),
161 intern_node_id(B, J),
162 ( nonvar(I), nonvar(J) -> sort([I, J], R)
163 ; format("No link at ~w or ~w\n", [A,B]),
164 fail
165 ).
166prepare_ends(E, _):-
167 format("Unexpected form of end nodes ~w \n", [E]),
168 fail.
169
172completing_succs(X, X, I, N):- I > N, !.
173completing_succs([I-A|Ls], [I-A|Ms], I, N):-!, J is I + 1,
174 completing_succs(Ls, Ms, J, N).
175completing_succs(Ls, [I-[]|Ms], I, N):- J is I + 1,
176 completing_succs(Ls, Ms, J, N).
177
180normal_mate_list([], []).
181normal_mate_list([P|R], [P0|R0]):- P = I-J,
182 ( J @< I -> P0 = J - I
183 ; P0 = P
184 ),
185 normal_mate_list(R, R0).
198
199raise_rel_to_fun([], []).
200raise_rel_to_fun([Pair|L], R):-
201 raise_rel_to_fun(L, R0),
202 raise_rel_to_fun(Pair, R0, R).
204raise_rel_to_fun(A-B, X, Y):-
205 ( X = [A-S|X0] -> Y = [A-[B|S]|X0]
206 ; Y = [A-[B]|X]
207 ).
208
209
211domain_of_links(X, Y):-
212 findall(A , ( member(L, X),
213 ( L = (A - _)
214 ; L = (_ - A)
215 )
216 ),
217 Y0),
218 sort(Y0, Y).
219
221node_id(N, C, C0):- node_id(N, _, C, C0).
222
226node_id(N, I, C, C0):- memo(node_id(N)-I, memo_nodes),
227 ( nonvar(I) -> C0 = C
228 ; C0 is C+1,
229 I = C0
230 ).
231
233intern_links(L, L0):- intern_links(L, L0, 0, _).
235intern_links([], [], C, C).
236intern_links([A-B|L], [I-J|M], C, D):-
237 node_id(A, I, C, C0),
238 node_id(B, J, C0, C1),
239 intern_links(L, M, C1, D).
240
241
252
253off_frontier(I, J, F):- arg(I, F, K), K @< J.
261on_frontier(I, J, F):- arg(I, F, K), J @=< K.
262
263
270
271setup_frontier(L, V):- setup_frontier_max(L, V).
272
274setup_frontier_max([], _).
275setup_frontier_max([I-J|L], V):-
276 lower_max_array(I, J, V),
277 !,
278 setup_frontier_max(L, V).
280setup_frontier_min([], _).
281setup_frontier_min([I-J|L], V):-
282 lower_min_array(I, J, V),
283 !,
284 setup_frontier_min(L, V).
286lower_max_array(I, J, V):- arg(J, V, A),
287 ( I > A -> setarg(J, V, I)
288 ; true
289 ).
291lower_min_array(I, J, V):- arg(J, V, A),
292 ( I < A -> setarg(J, V, I)
293 ; true
294 ).
295
296
303
310
311setup_prune_vector(Pvec):- b_getval(links, Ls),
312 raise_rel_to_fun(Ls, Coa),
313 b_getval(dom, D),
314 Fvec=..[#|D],
315 length(D, N),
316 completing_succs(Coa, Coa0, 1, N),
317 setup_frontier_min(Ls, Fvec),
318 functor(Pvec, #, N),
319 setup_prune_vector(Coa0, Fvec, Pvec).
321setup_prune_vector([], _, _).
322setup_prune_vector([I-S|R], Frontier, Pvec):-
323 findall(J,
324 ( member(J, S),
325 arg(J, Frontier, I)
326 ),
327 Succs),
328 arg(I, Pvec, Succs),
329 setup_prune_vector(R, Frontier, Pvec)