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),
   21	number_links(Links, Links1, S),
   22	normal_mate_list(Links1, Links2),
   23	predsort(mate_compare, Links2, Links3),
   24	reverse(Links3, Links4),
   25	Links0 =  Links4,
   26	memo(number_node(J)-J0, S),
   27	memo(number_node(I)-I0, S),
   28	domain_of_links([I0-J0|Links4], D),
   29	rel_to_fun(Links0, Succs),
   30	close_state(S),
   31	setup_links_frontier(J0, Links0, Vec),
   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.

 setup_links_frontier(+N, +Links, -F) is det

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
   87setup_links_frontier(N, Links, F):- functor(F, #, N),
   88	initialize_frontier(F),
   89	setup_frontier(Links, 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),
  153		rect_links(R, Links),
  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).
  265power_links(A, B, 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):-
  291		normal_links_with_st(ST, Links, ST0, Links0, D),
  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],
  301		add_links(Ctrl0, Links, X, Y, S),
  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).
  310% ?- N=100, rect_links(rect(N,N), Links),
  311%	time((normal_links_with_st(p(0,0)-p(N,N), Links, ST, R, D))).
  312% ?- N=1, rect_links(rect(N,N), Links),
  313%	time((normal_links_with_st(p(0,0)-p(N,N), Links, ST, R, D))).
  314% ?- N=2, rect_links(rect(N,N), Links),
  315%	time((normal_links_with_st(p(0,0)-p(N,N), Links, ST, R, D))),
  316%	maplist(writeln, R).
  317
  318
  319
  320normal_links_with_st(I-J, Links, I0-J0, Links0, D):-
  321	open_state(S),
  322	build_node_layers([J], Links, N),
  323	reverse(N, N0),
  324	number_node_layers(N0, 0, _, S),
  325	number_links(Links, Links1, S),
  326	normal_mate_list(Links1, Links2),
  327	predsort(mate_compare, Links2, Links3),
  328	reverse(Links3, Links4),
  329	map_put_fr(Links4, Links0),
  330	memo(number_node(J)-J0, S),
  331	memo(number_node(I)-I0, S),
  332	domain_of_links([I0-J0|Links4], D),
  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).
  345domain_of_links(X, 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),
  363	domain_of_links(L, Ns0),
  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(_, [], [], []):-!.
  391layer_links(Ns, [A-B|Links], Links0, [A-B|Layer]):-
  392	(	member(C, Ns),
  393		(A = C; B = C)
  394	),
  395	!,
  396	layer_links(Ns, Links, Links0, Layer).
  397layer_links(Ns, [L|Links], [L|Links0], Layer):-
  398	layer_links(Ns, Links, Links0, Layer).
  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).
  412number_links([], [], _).
  413number_links([A-B|L], [A0-B0|L0], 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
  491% ?- rect_links(rect(1,1), Links).
  492% ?- rect_links(rect(10,10), Links),length(Links, L).
  493rect_links(rect(W, H), Links):-
  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				 ),
  501				 Links).
  502
  503		/************************
  504		*     core predicates   *
  505		************************/
  506%
  507add_links(_, [], X, X, _).
  508add_links(Ctrl, [FR|Ls], X, Y, S):- FR=fr(U, F),
  509	memberchk(end(End), Ctrl),
  510	add_link(F-End, U, X, X1, S),
  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	),
  522	add_links(Ctrl, Ls, X4, Y, S).
  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),
  528	add_link(FE, U, L, L0, 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%
  542xadd_links([], X, X, _).
  543xadd_links([A-Ns|Ls], X, Y, S):-
  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),
  551	xadd_links(Ls, X3, Y, S).
  552
  553xadd_links(_, _, [], X, X, _).
  554xadd_links(M, A, [B|Ns], X, Y, S):-
  555	xadd_link(M, A-B, X, X0, S),
  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, !.
  562xadd_link(M, U, X, Y, S):-
  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)