```    1:- module(mate_order, []).    2
3:- use_module(zdd('zdd-array')).    4:- use_module(zdd(zdd)).    5:- use_module(pac(op)).```
UDG (S-E, Links) is read (S0-E0, Succs, Dom, Vec) nodes of UDG are integers: Dom = {1, 2, ..., n} Vec is frontier vector build by setup_links_vector. Succs is orderd in reverse.
```   13% ?- (zdd prepare(a-d, [a-b, b-c, c-d], R, L, D, Vec)), write(Vec).
14% ?- (zdd prepare(a-d, [a-b, b-c, c-d], R, L, D, Vec), memo(frontier-F)), write(Vec).
15
16prepare(I-J, Links, I0-J0, Succs, D, Vec, State):-
17	open_state(S),
18	build_node_layers([J], Links, N),
19	reverse(N, N0),
20	number_node_layers(N0, 0, _, S),
26	memo(number_node(J)-J0, S),
27	memo(number_node(I)-I0, S),
30	close_state(S),
32	obj_id((I0-J0, Vec), Id),
33	memo(frontier_id-Id, State).```
rel_to_fun(+R, -F) is det
convert set R of links to a list F of successor lists. In other words: F is a function derived from the relation R such that F(x) = P (x in `dom(R)`) if P = { y | R(x,y)} e.g. R=[a-b, a-c, b-d, b-e] => F=[a-[b,c], b-[d,e]]
```   41% ?- rel_to_fun([], R).
42% ?- rel_to_fun([a-b, a-c, b-d, b-e], R).
43rel_to_fun(L, R):- reverse(L, L0),
44	rel_to_fun(L0, [], R).
45%
46rel_to_fun([], X, X).
47rel_to_fun([A-B|L], [A-U|V], R):-!,
48	rel_to_fun(L, [A-[B|U]|V], R).
49rel_to_fun([A-B|L], U, R):-!,
50	rel_to_fun(L, [A-[B]|U], R).
51
52% ?- zdd obj_id(a, X), obj_id(A, X).
```
on_frontier(+I, +J, +K) is det
True if node I is accessible directly by a link from a node less than J.
```   58% ?- setup_links_frontier(3,[1-2,2-3], _F), write(_F),
59%	on_frontier(3, 2, _F).
60% ?- setup_links_frontier(3,[1-2,2-3], _F), write(_F),
61%	on_frontier(3, 1, _F).
62
63on_frontier(I, J, F):- arg(I, F, K), K < J.```
on_frontier(+I, +J, +K) is det
True if node I is not accessible directly by a link from a node less than J.
```   69% ?- setup_links_frontier(3,[1-2,2-3], _F), write(_F),
70%	off_frontier(3, 1, _F).
71% ?- setup_links_frontier(3,[1-2,2-3], _F), write(_F),
72%	off_frontier(3, 2, _F).
73
74off_frontier(I, J, F):- arg(I, F, K), J =< K.```
F is unified with an integer vector of size N whose i-th element is the minimum j connected to i. If i is an orphant node, no change on i-th element. Use of F: if k is less than i-th element of F, there is no direct link from k to i. It is assumed that a node is an integer > 0.
```   84% ?- setup_links_frontier(3,[1-2,2-3], F), writeln(F).
85% ?- setup_links_frontier(3,[1-2,2-1, 2-3, 1-3], F), writeln(F).
86
88	initialize_frontier(F),
90
91% ?- X=f(_,_,_), initialize(X).
92initialize_frontier(V):- functor(V, _, N),
93	initialize_frontier(N, V), !.
94%
95initialize_frontier(0, _):-!.
96initialize_frontier(I, V):- setarg(I, V, I),
97	J is I - 1,
98	initialize_frontier(J, V).
99
100% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X).
101setup_frontier([], _).
102setup_frontier([I-J|L], F):-
103	update_frontier(I, J, F),
104	!,
105	setup_frontier(L, F).
106
107% ?- X=f(1,2), update_frontier(1,2, X).
108% ?- X=f(1,2,3), update_frontier(2, 3, X), update_frontier(1, 2, X).
109update_frontier(I, J, V):-
110	arg(I, V, A),
111	(	J < A -> setarg(I, V, J)
112	;	true
113	),
114	arg(J, V, B),
115	(	I < B -> setarg(J, V, I)
116	;	true
117	).
118
119
120
121		/**********************
122		*   sample queries    *
123		**********************/
124
125:- op(20, fx, #).  126#(S) :- fetch_state(S).
127
128% ?- spy(rectangular_benchimark).
129% ?- #S, rectangular_benchimark(rect(0,1), Z, S), card(Z, C, S).
130
131% ?- #S, rectangular_benchimark(rect(1,0), Z, S), card(Z, C, S).
132% ?- #S, rectangular_benchimark(rect(1,1), Z, S), card(Z, C, S).
133% ?- #S, rectangular_benchimark(rect(2,2), Z, S), card(Z, C, S).
134% ?- #S, rectangular_benchimark(rect(2,3), Z, S), card(Z, C, S).
135% ?- #S, rectangular_benchimark(rect(3,3), Z, S), card(Z, C, S).
136% ?- #S, rectangular_benchimark(rect(4,4), Z, S), card(Z, C, S).
137% ?- #S, rectangular_benchimark(rect(5,5), Z, S), card(Z, C, S).
138% ?- #S, rectangular_benchimark(rect(6,6), Z, S), card(Z, C, S).
139% ?- #S, rectangular_benchimark(rect(7,7), Z, S), card(Z, C, S).
140
141% ?- #S, time((rectangular_benchimark(rect(7,7), Z, S), card(Z, C, S))).
142%@ % 658,675,265 inferences, 49.654 CPU in 49.817 seconds (100% CPU, 13265356 Lips)
143%@ S = ..,
144%@ Z = 94322,
145%@ C = 789360053252 .
146% ?- #S, time((rectangular_benchimark(rect(8,8), Z, S), card(Z, C, S))).
147%@ % 7,729,793,561 inferences, 728.353 CPU in 731.728 seconds (100% CPU, 10612696 Lips)
148%@ S = ..,
149%@ Z = 390004,
150%@ C = 3266598486981642 .
151
152rectangular_benchimark(R, Z, S):- R = rect(W, H),
154		path_count_by_simple_frontier(Links, p(0,0)-p(W, H), Z, S).
155
156
157%  [2022/11/01]
158% ?- zdd rectangular_benchimark(rect(2,2), Y), card(Y, C).
159% ?- zdd rectangular_benchimark(rect(3,3), Y), card(Y, C).
160% ?- zdd rectangular_benchimark(rect(4,4), Y), card(Y, C).
161% ?- zdd rectangular_benchimark(rect(5,5), Y), card(Y, C).
162% ?- zdd rectangular_benchimark(rect(6,6), Y), card(Y, C).
163% ?- time((zdd rectangular_benchimark(rect(7,7), Y), card(Y, C))).
164%@ % 670,271,624 inferences, 47.721 CPU in 47.831 seconds (100% CPU, 14045498 Lips)
165%@ Y = 94322,
166%@ C = 789360053252 .
167% ?- time((zdd rectangular_benchimark(rect(8,8), Y), card(Y, C))).
168%@ % 3,548,844,694 inferences, 326.036 CPU in 327.345 seconds (100% CPU, 10884834 Lips)
169%@ Y = 390004,
170%@ C = 3266598486981642 .
171
172
173
174% ?- #S, time(rectangular_test(rect(10,10), Y, S)), card(Y, C, S).
175%@ % 99,075,935,814 inferences, 11358.338 CPU in 13619.622 seconds (83% CPU, 8722750 Lips)
176%@ S = ..,
177%@ Y = 6467210,
178%@ C = 1568758030464750013214100 .
179
180% ?- zdd X<<pow([a,b,c]), zdd_rand_path(X, P).
181
182% close_state is necesary for the folloing two queies, otherwise
183%	uncontrollable errors occurs.
184% ?- N=[a,b,c,d],
185%	(zdd power_links(N, B),
186%	choose_random_paths(1-4, 2, B, C, []),
187%	close_state),
188%	maplist(writeln, C),
189%	map_count_path(C).
190
191% ?- #S, K=2, N=5, numlist(1, N, Ns), power_links(Ns, B, S),
192%	choose_random_paths(1-N, K, B, C, [], S), close_state(S),
193%	maplist(writeln, C),
194%	map_count_path(C).
195
196map_count_path([]):-!.
197map_count_path([A|As]):- last(A, P),
198	count_path(st(A, P)), !, map_count_path(As).
199
200% ?- count_path(st([a-b], a-b)).
201% ?- count_path(st([a-b,b-c,a-c], a-c)).
202count_path(st(L,ST)):- open_state(S),
203		path_count_by_simple_frontier(L, ST, Z, S),
204		card(Z, C, S),
205		format("path count = ~w\n", [C]),
206		close_state(S).
207
208		/*******************************************
209		*     Random different pair from a list    *
210		*******************************************/
211
212% ?- random_dif_pair([a,a,b,b], A, B).
213% ?- random_dif_pair([], A, B).		% false
214% ?- random_dif_pair([a], A, B).	% false
215random_dif_pair(P, A, B):- sort(P, P0), length(P0, L),
216	L > 1,
217	random_ord_dif_pair(P0, A, B, L).
218
219%
220random_ord_dif_pair(P, A, B, L):-
221	I is random(L),
222	J is random(L),
223	(	I\==J ->
224		nth0(I, P, A),
225		nth0(J, P, B)
226	;	random_ord_dif_pair(P, A, B, L)
227	).
228
229% ?- elim_node([a,b,c, d], [a-b, a-c, b-c], R).
230% ?- elim_node([a,b,c, d], [a-b], R).
231elim_node([], _, []):-!.
232elim_node(Ns, [], Ns):-!.
233elim_node(Ns, [A-B|As], Ns0):-
234	elim_node_one(Ns, [A,B], Ns1),
235	elim_node(Ns1, As, Ns0).
236%
237elim_node_one([], _, []):-!.
238elim_node_one(Ns, [], Ns):-!.
239elim_node_one([A|Ns], Us, Ns0):-
240	(	select(A, Us, Us1) ->
241		elim_node_one(Ns, Us1, Ns0)
242	;	elim_node_one(Ns, Us, Ns1),
243		Ns0=[A|Ns1]
244	).
245
246% ?- zdd X<<pow([a-b, c-d]), choose_random_paths(2-2, 1,  X, P, []).
247% ?- zdd X<<pow([a-b, c-d]), choose_random_paths(2-2, 2,  X, P, []).
248% ?- zdd X<<pow([a-b, c-d]), choose_random_paths(0-2, 3,  X, P, []).
249
250choose_random_paths(_, 0, _, Ps, Ps, _):-!.
251choose_random_paths(IV, N, X, [P|Q], R, S):-
252	zdd_rand_path(X, P, [], S),
253	length(P, Len),
254	interval(IV, Len),
255	!,
256	N0 is N-1,
257	choose_random_paths(IV, N0, X, Q, R, S).
258choose_random_paths(IV, N, X, P, Q, S):-
259	choose_random_paths(IV, N, X, P, Q, S).
260%
261interval(I-J, K):- I=<K, K=<J.
262
263% ?- #S, power_links([a,b], B, S), psa(B, S), card(B, C, S).
264% ?- #S, power_links([a,b,c,d], B, S), psa(B, S), card(B, C, S).
266	findall(X-Y, (member(X, A), member(Y, A), X@<Y), L),
267	<<(B, pow(L), S).
268
269% ?- normal_mate_list([1-2], X).
270% ?- normal_mate_list([2-1, 1-2], X).
271normal_mate_list([], []).
272normal_mate_list([P|R], [P0|R0]):- P=I-J,
273	(	J@<I -> P0= J-I
274	;	P0 = P
275	),
276	normal_mate_list(R, R0).
277
278
279		/**************
280		*     main    *
281		**************/
282
283% ?- #S, path_count_by_simple_frontier([a-b], a-b, X, S), card(X, C, S).
284
285% ?- #S, path_count_by_simple_frontier([a-b, b-c, a-c], a-c, X, S), card(X, C, S).
286% ?- #S, path_count_by_simple_frontier([a-b, a-c, b-d, c-d], a-d, X, S), card(X, C, S).
287% ?- #S, path_count_by_simple_frontier([b-a, c-a, d-b, d-c], a-d, X, S), card(X, C, S).
288% ?- #S, path_count_by_simple_frontier([b-a, b-c, c-a, d-b, d-c], a-d, X, S), card(X, C, S).
289% ?- #S, path_count_by_simple_frontier([a-d, b-a, b-c, c-a, d-b, d-c], a-d, X, S), card(X, C, S).
290path_count_by_simple_frontier(Links, ST, X, S):-
292		path_count_by_simple_frontier(Links0, D, ST0, X, S).
293
294path_count_by_simple_frontier(Links, D, ST, Z, S):- Ctrl=[gc(link)],  % for default
295	path_count_by_simple_frontier(Ctrl, Links, D, ST, Z, S).
296%
297path_count_by_simple_frontier(Ctrl, Links, D, ST, Z, S):- ST = I-J,
298		findall(K-K, member(K, D), Init),
299		zdd_append(Init, 1, X, S),
300		Ctrl0=[end(J), start(I)|Ctrl],
302		prune_final(I, J, Y, Z, S).
303
304% ?- normal_links_with_st(a-d, [a-b, b-c, c-d], R, L, D).
305%@ R = 1-4,
306%@ L = [fr(3-4, 4), fr(2-3, 3), fr(1-2, 2)],
307%@ D = [1, 2, 3, 4].
308% ?- normal_links_with_st(a-c, [a-b, b-c, a-c], R, L, D).
309% ?- normal_links_with_st(a-d, [a-b, a-c, d-b, d-c], R, L, D).
316%	maplist(writeln, R).
317
318
319
321	open_state(S),
322	build_node_layers([J], Links, N),
323	reverse(N, N0),
324	number_node_layers(N0, 0, _, S),
330	memo(number_node(J)-J0, S),
331	memo(number_node(I)-I0, S),
333	close_state(S).
334%
335map_put_fr([], []).
336map_put_fr([I-J|R], [fr(I-J, J)|R0]):- map_put_fr(R, R0).
337
338
339
340		/****************************
341		*	 build layers of links  *
342		****************************/
343
344% ?- domain_of_links([a-b, b-c, a-c], Y).
346	findall( A, (	member(L, X),
347					( L = (A - _)
348					; L = (_ - A)
349					)
350				),
351		   Y0),
352   sort(Y0, Y).
353
354% ?- build_node_layers([d], [c-d, b-c, a-b], N).
355%@ N = [[d], [c, d], [b, c], [a, b]].
356build_node_layers(Ns, X, L):- build_link_node_layers(Ns, X, _, _, L, []).
357
358% ?- build_link_node_layers([d], [a-b, a-c, b-d, c-d], Unused, Layers, N, []).
359% ?- build_link_node_layers([d], [c-d, b-c, a-b], Unused, Layers, N, []).
360build_link_node_layers([], X, X, [], N, N):-!.
361build_link_node_layers(Ns, X, Y, [L|Ls], [Ns|N], N0):-
362	layer_links(Ns, X, X0, L),
364	subtract(Ns0, Ns, Ns1),
365	build_link_node_layers(Ns1, X0, Y, Ls, N, N0).
366
367% ?- #S, number_layers_frontier([[a-b]], L, 0, C, S).
368% ?- #S, number_layers_frontier([[a-b], [b-c, a-c]], L, 0, C, S).
369number_layers_frontier([], [], C, C, _).
370number_layers_frontier([L|Ls], [L0|Ls0], C, C0, S):-
371	number_links(L, L0, C, C1, S),
372	number_layers_frontier(Ls, Ls0, C1, C0, S).
373
374% ?- #S, number_node_layers([[a]], 0, C, S).
375% ?- #S, number_node_layers([[a,b], [b,c,a], []], 0, C, S).
376number_node_layers([], C, C, _).
377number_node_layers([Ns|R], C, C0, S):-
378	number_node_list(Ns, C, C1, S),
379	number_node_layers(R, C1, C0, S).
380
381% ?- #S, number_node_list([a], 0, C, S).
382% ?- #S, number_node_list([a,b, b,c,a], 0, C, S).
383number_node_list([], C, C, _):-!.
384number_node_list([N|Ns], C, C0, S):- number_node(N, C, C1, S),
385	number_node_list(Ns, C1, C0, S).
386
387% ?- layer_links([a,b], [a-b], L0, L1).
388% ?- layer_links([a,b], [a-b, c-d], L0, L1).
389% ?- layer_links([a,b], [a-b, b-c], L0, L1).
390layer_links(_, [], [], []):-!.
392	(	member(C, Ns),
393		(A = C; B = C)
394	),
395	!,
399
400% ?- #S, number_node(a, 0, C, S).
401number_node(N, C, C0, S):- number_node(N, _, C, C0, S).
402
403% ?- #S,  time((numlist(1, 100000, Ns), foldl(pred(S, ([I, C, C0]:-
404%	number_node(st(I), K, C, C0, S))), Ns, 0, R))).
405number_node(N, I, C, C0, S):- memo(number_node(N)-I, S),
406	(	nonvar(I) -> C0 = C
407	;	C0 is C+1,
408		I = C0
409	).
410
411% ?- #S, number_node_layers([[a],[b]], 0, C, S), number_links([a-b, b-a, a-a, b-a, a-b], L, S).
414	memo(number_node(A)-A0, S),
415	memo(number_node(B)-B0, S),
416	number_links(L, L0, S).
417
418% ?- #S, number_links([a-b], L, 0, C, S).
419% ?- #S, number_links([a-b, b-c], L, 0, C, S).
420number_links([], [], C, C, _).
421number_links([A-B|L], [A0-B0|L0], C, C0, S):-
422	number_node(A, A0, C, C1, S),
423	number_node(B, B0, C1, C2, S),
424	number_links(L, L0, C2, C0, S).
425
426		/*******************
427		*	 Helpers       *
428		*******************/
429
430% ?- mate_compare(C, a-c, b-a).
431% ?- predsort(mate_compare, [1-1, 1-2, 1-3, 2-2, 2-3, 2-4, 3-3, 3-4], X).
432%@ X = [1-1, 1-2, 2-2, 1-3, 2-3, 3-3, 2-4, 3-4].
433
434% ?- findall(A-B, (between(0, 10, B), between(0, B, A)), R),
435%  predsort(mate_compare, R, R0), maplist(writeln, R0).
436% assumeing first @=< second.
437mate_compare(C, A-B, X-Y):- compare(C0, B, Y),
438	(	C0=(=) -> compare(C, A, X)
439	;	C = C0
440	).
441
442% ?- arrow_symbol(_->_, F).
443% ?- arrow_symbol(a->b, F, X, Y).
444arrow_symbol( _ -> _).
445%
446arrow_symbol(A, A0):- functor(A, A0, 2).
447arrow_symbol(A, A0, A1, A2):- functor(A, A0, 2),
448		arg(1, A, A1),
449		arg(2, A, A2).
450
451% ?- composable_pairs_with_check(1-3, 2-3, 3-3, A, B).
452% ?- composable_pairs_with_check(1-3, 1-3, 2-3, A, B).
453% ?- composable_pairs_with_check(1-3, 1-3, 1-4, A, B).
454% ?- composable_pairs_with_check(1-3, 1-3, 1-1, A, B).
455% ?- composable_pairs_with_check(1-4, 2-2, 3-3, A, B).   % false
456composable_pairs_with_check(ST, X, Y, A, B):-
457	min_max_check(ST, X, Y),
458	composable_pairs(X, Y, A, B),
459	!.
460
461
462% ?- min_max_check( 1-3, 1-3,  2-3).
463% ?- min_max_check( 1-3, 1-3,  1-1).
464% ?- min_max_check( 1-3, 1-3,  1-3).
465% ?- min_max_check( 1-3, 2-3,  3-3).
466% ?- min_max_check( 1-3, 2-3,  2-2).
467min_max_check(_ - Max, _ - Max, U - V):-!,
468	(	V = Max -> U = Max; true ).
469min_max_check(Min - _, Min - _, U - V):-!,
470	(	V = Min -> U = Min; true ).
471min_max_check(_, _, _).
472
473% One of the most basic helpers.
474composable_pairs(A-B, A-C, B, C).
475composable_pairs(A-B, C-A, B, C).
476composable_pairs(B-A, A-C, B, C).
477composable_pairs(B-A, C-A, B, C).
478%
479normal_pair(A-B, U-V):-!, ( B @< A -> U=B, V=A; U=A, V=B ).
480normal_pair(A->B, U->V):- ( B @< A -> U=B, V=A; U=A, V=B ).
481
482% ?- rect_nodes(rect(0,2), Ns).
483% ?- rect_nodes(rect(10,10), Ns), length(Ns, L).
484rect_nodes(rect(W, H), Ns):-
485	findall(p(I,J),
486			 (	between(0, W, I),
487				between(0, H, J)
488			 ),
489			 Ns).
490
494	findall( p(I,J)-p(K,L),
495				 (	between(0, W, I),
496					between(0, H, J),
497					(  L=J, K is I + 1, K =< W
498					;  K=I, L is J + 1, L =< H
499					)
500				 ),
502
503		/************************
504		*     core predicates   *
505		************************/
506%
508add_links(Ctrl, [FR|Ls], X, Y, S):- FR=fr(U, F),
509	memberchk(end(End), Ctrl),
511	zdd_join(X, X1, X2, S),
512	(	( Ls = [] ; Ls = [fr(_, G)|_], G \== F ) ->   % step of adjacent frontiers found.
513		prune_by_classify_link(F, End, X2, X3, S)
514	;	X3 = X2		% Redundant pruning skipped.
515	),
516	(	memberchk(gc(link), Ctrl) ->
517%		format("at ~w with link ~w\n", [X3, U]),
518		zdd_slim(X3, X4, S),
519		garbage_collect
520	;	X4 = X3
521	),
523
524%
525add_link(_, _, X, 0, _):- X<2, !.
526add_link(FE, U, X, Y, S):- FE = F-E,
527	cofact(X, t(A, L, R), S),
529	classify_link(F, E, A, Case),
530	(	( Case = 0; Case = arrow ) ->	R0 = 0			% many hits.
531	;	Case = ignore -> add_link(FE, U, R, R0, S)		% no hits.
532	;	U = Ul-Ur,
533		(	A = U -> R0 = 0		%,  write(.)			% so so hits
534		; 	composable_pairs(U, A, U0, V0) ->
535			subst_node(FE, [Ul->Ur], U0, V0, R, R0, S)
536		;	add_link(FE, U, R, R1, S),
537			zdd_insert(A, R1, R0, S)
538		)
539	),
540	zdd_join(L0, R0, Y, S).
541%
544	cofact(X0, t(A-A, 0, X), S),
545	memo(frontier_vec-Id, S),
546	obj_id((M, V), Id, S),
547	M = (_, E),
548	xadd_links(M, A, Ns, X0, X1, S),
549	zdd_join(X0, X1, X2, S),
550	prune_by_frontier(A, X2, X3, E, V, S),
552
556	zdd_join(X, X0, X1, S),
557	xadd_links(M, A, Ns, X1, Y, S).
558
559strong_less_than(_-A, B-_):- A<B.
560%
561xadd_link(_, _, X, 0, _):- X<2, !.
563	cofact(X, t(A, L, R), S),
564	arrow_symbol(A, F),
565	(	F = (->) -> Y = 0
566	; 	xadd_link(M, U, L, L0, S),
567		(	U = A  -> R0 = 0	% cycle found
568		;   strong_less_than(U, A) -> R0 = 0  %
569		;  (	composable_pairs_with_check(M, U, A, V, W) ->
570				U = (Ul-Ur),
571			    xsubst_node(M, [Ul->Ur], V, W, R, R0, S)
572		   ;	xadd_link(M, U, R, R1, S),
573			    zdd_insert(A, R1, R0, S)
574		   )
575		),
576		zdd_join(L0, R0, Y, S)
577	).
578%
579xsubst_node(_, _, _, _, X, 0, _):- X < 2, !.
580xsubst_node(M, Es, A, P, X, Y, S):-	cofact(X, t(U, L, R), S), % replace A with P
581	arrow_symbol(U, F, Lu, Ru),
582	(	F = (->) ->  Y = 0
583	;	xsubst_node(M, Es, A, P, L, L0, S),
584		(	Ru = A	->
585			normal_pair(Lu-P, V),
586			zdd_ord_insert([V|Es], R, R0, S)
587		;	Lu = A	->
588			normal_pair(P-Ru, V),
589			zdd_ord_insert([V|Es], R, R0, S)
590		;	xsubst_node(M, Es, A, P, R, R1, S),
591			zdd_insert(U, R1, R0, S)
592		),
593		zdd_join(L0, R0, Y, S)
594	).
595
596%
597subst_node(_, _, _, _, X, 0, _):- X < 2, !.
598subst_node(FE, Es, A, P, X, Y, S):-	 FE = Fr-End,		% replace A with P
599	cofact(X, t(U, L, R), S),
600 	subst_node(FE, Es, A, P, L, L0, S),
601	classify_link(Fr, End, U, Case),
602	arrow_symbol(U, _, Lu, Ru),
603	(	( Case = 0 ; Case = arrow ) -> R0 = 0
604	;	Case = ignore ->
605		subst_node(FE, Es, A, P, R, R0, S)
606	;	(	Ru = A	->
607			normal_pair(Lu-P, V),
608			zdd_ord_insert([V|Es], R, R0, S)
609		;	Lu = A	->
610			normal_pair(P-Ru, V),
611			zdd_ord_insert([V|Es], R, R0, S)
612		;	subst_node(FE, Es, A, P, R, R1, S),
613			zdd_insert(U, R1, R0, S)
614		)
615	),
616	zdd_join(L0, R0, Y, S).
617
618		/********************
619	    *     prune mates   *
620		********************/
621
622% ?- zdd X<< +[*[a-b, a->b]], prune_final(a, b, X, Y), psa(X), psa(Y).
623
624prune_final(P, P, _, 1, _):-!.
625prune_final(_, _, X, 0, _):- X<2, !.
626prune_final(P, Q, X, Y, S):- cofact(X, t(A, L, R), S),
627	prune_final(P, Q, L, L0, S),
628	(	A = (_->_) -> R0 = 0
629	;  	A = P-Q -> prune_final0(R, R0, S)
630	;	A = V-V -> prune_final(P, Q, R, R0, S)
631	;	R0 = 0
632	),
633	zdd_join(L0, R0, Y, S).
634%
635prune_final0(X, X, _):- X<2, !.
636prune_final0(X, Y, S):- cofact(X, t(A, L, R), S),
637	prune_final0(L, L0, S),
638	(	A = (_->_) -> zdd_insert(A, R, R0, S)
639  	;	A = (B-B) -> prune_final0(R, R0, S)
640	;	R0 = 0
641	),
642	zdd_join(L0, R0, Y, S).
643
644		/***********************************
645		*     classify_link by frontier    *
646		***********************************/
647
648%  "A node P is on frontier" means that P may be touched by a remaining link in the future.
649
650% ?- on_frontier(3, 4). % true
651% ?- on_frontier(4, 3). % false
652on_frontier(P, F):- P @=< F.
653%
654classify_link(_, _, _->_, arrow):-!.
655classify_link(F, End, A-B,  Case):- on_frontier(A, F), !,
656   	(	on_frontier(B, F) -> Case = keep
657	;	B = End -> Case = keep
658	;	Case = 0
659	).
660classify_link(_, E, E-E, 0):-!.
661classify_link(_, _, A-A, ignore):-!.
662classify_link(_, _, _, 0).
663
664%
665prune_by_classify_link(_, _, X, X, _):- X<2, !.
666prune_by_classify_link(F, End, X, Y, S):- cofact(X, t(A, L, R), S),
667	prune_by_classify_link(F, End, L, L0, S),
668	classify_link(F, End, A, Case),
669	(	Case = arrow -> zdd_insert(A, R, R0, S)
670	;	Case = keep ->					% many hits.
671		prune_by_classify_link(F, End, R, R1, S),
672		zdd_insert(A, R1, R0, S)
673	;	Case = ignore ->				% many hits.
674		prune_by_classify_link(F, End, R, R0, S)
675	;	R0 = 0							% many bits.
676	),
677	zdd_join(L0, R0, Y, S).
678
679%
680prune_by_frontier(I, X, Y, S):- memo(frontier-(E, V), S),
681	prune_by_frontier(X, Y, I, E, V, S).```
prune_by_frontier(+X, -Y, +I, +E, +S) is det
Y is unified with pruned X. 1) Path which has E-E is removed when E is off_frontier. 2) A-A is removed from path that has A-A when A is off_frontier. 3) Path which has A-B with off_frontier A or B is removed.
```  690prune_by_frontier(X, X, _I, _E, _V, _):- X<2, !.
691prune_by_frontier(X, X, E, E, _, _):-!.
692prune_by_frontier(X, X, 1, _, _, _):-!.
693prune_by_frontier(X, Y, I, E, V, S):- cofact(X, t(A, L, R), S),
694	(	A = (_->_) -> Y = X
695	; 	A = (J-K),
696		prune_by_frontier(L, L0, I, E, V, S),
697		(	K = J ->
698			(	off_frontier(J, I, V) ->
699				(	J = E -> R0 = 0
700				;	prune_by_frontier(R, R0, I, E, V, S)
701				)
702			;	prune_by_frontier(R, R1, I, E, V, S),
703				zdd_insert(A, R1, R0, S)
704			)
705		;	K = E ->
706			(	off_frontier(J, I, V) -> R0 = 0
707			;	prune_by_frontier(R, R1, I, E, V, S),
708				zdd_insert(A, R1, R0, S)
709			)
710		;	on_frontier(J, I, V), on_frontier(K, I, V) ->
711			prune_by_frontier(R, R1, I, E, V, S),
712			zdd_insert(A, R1, R0, S)
713		;	R0 = 0
714		),
715		zdd_join(L0, R0, Y, S)
716	).
717
718		/*******************************
719		*  printing mate for  debug    *
720		*******************************/
721
722% ?- zdd X<< +[*[a-b],*[b-c]],  pmate(X).
723
724pmate(X, S):- setup_call_cleanup(
725				open_state(M),
726				(	drop_path(X, Y, S, M),
727					psa(Y, M)
728				),
729				close_state(M)).
730
731%
732drop_path(X, Y, _, _):- X<2, !, Y=X.
733drop_path(X, Y, S, M):- cofact(X, t(A, L, R), S),
734	drop_path(L, L0, S, M),
735	(	A=(_-_) ->
736		drop_path(R, R1, S, M),
737		zdd_insert(A, R1, R0, M)
738	;	R0 = 1
739	),
740	zdd_join(L0, R0, Y, M)```