path-count-by-mate-frontier.pl

    1:- module(udgpc, [udg_path_count/5, udg_path_count/4]).    2
    3:- use_module(pac(basic)).    4:- use_module(zdd('zdd-array')).    5:- use_module(zdd(zdd)).    6:- use_module(pac(op)).    7
    8:- set_prolog_flag(toplevel_print_anon, false).

udg_path_count(+A, +B, +Ls, -C, +S) is det: C is unified with the number of paths which connects A and B in a given undirected graph Ls in the form of a list of unordered links. Working zdd state S is fetched, and if it is not yet opened, S is unified with new state. This is all done by fetch_state/1.

   17% ?- udg_path_count(a, b, [a-b], C).
   18% ?- udg_path_count(a, b, [a-b,b-c,a-c], C).
   19% ?- udg_path_count(a, d, [a-b,c-d], C).
   20% ?- W=3, H=3, rect_grid_graph(W, H, _L),
   21%	time(udg_path_count(p(0,0), p(W, H), _L, C)).
   22% ?- W=7, H=7, rect_grid_graph(W, H, _L),
   23%	time(udg_path_count(p(0,0), p(W, H), _L, C)).
   24% ?- _W=3, _H=3, rect_grid_graph(_W, _H, _L),
   25%	remove_links(_L, [p(1,1),p(2,2)], _L0),
   26%	udg_path_count(p(0,0), p(_W, _H), _L0, C).
   27
   28udg_path_count(A, B, L, C, S):-
   29	links_to_mate(A, B, L, X, S),
   30	card(X, C, S).

udg_path_count(+A, +B, +Ls, -C) is det: This is almost alias of udg_path_count(A, B, Ls, C, S), preparing S by fetch_state(S) to use this udg_path_count/4 as a zdd command.

   37udg_path_count(A, B, L, C):- fetch_state(S),
   38							 udg_path_count(A, B, L, C, S).
   39
   40% ?- list_vector([1,2,3], V), writeln(V).
   41list_vector(L, V):-  V =.. [#|L].

compare_minimax(Min, Max, -C, +X, +Y) is det: compare X with Y assuming Min and Max is the minimum and maximum, respectively.

   47% ?- compare_minimax(z,a,C,z,a).
   48compare_minimax(_, _, =, X, X):-!.
   49compare_minimax(Min, Max, <, Min, Max):-!.
   50compare_minimax(Min, Max, >, Max, Min):-!.
   51compare_minimax(Min, _, <, Min, _):-!.
   52compare_minimax(Min, _, >, _, Min):-!.
   53compare_minimax(_, Max, >, Max, _):-!.
   54compare_minimax(_, Max, <, _, Max):-!.
   55compare_minimax(_, _, C, X, Y):- compare(C, X, Y).
   56
   57%
   58lte_minimax(A, B, X, Y):- compare_minimax(A, B, C, X, Y), C == (<).

sort_minimax(+Min, +Max, +X, -Y) is det: predicate sort with the compare_minimax(Min, Max).

   63% ?- sort_minimax(z, a, [a, b, c, z], S).
   64% ?- sort_minimax(z, a, [a, c, b, z], S).
   65sort_minimax(Min, Max, X, Y):- predsort(compare_minimax(Min, Max), X, Y).

keysort_minimax(+Min, +Max, +X, -Y) is det: predicate keysort with the compare_minimax(Min, Max).

   70% ?- keysort_minimax(a, b, [b-[u,v], a-[x, y]], S).
   71%@ S = [a-[x, y], b-[u, v]].
   72keysort_minimax(Min, Max, X, Y):-
   73	predsort(keycompare_minimax(Min, Max), X, Y).
   74
   75% ?- predsort(keycompare_minimax(z, a), [a-[], z-[]], S).
   76keycompare_minimax(Min, Max, C, X-_, Y-_):-
   77	compare_minimax(Min, Max, C, X, Y).

links_to_udg(+Min, +Max, +Ls, -UDG) is det: Convert links Ls into its equivlent undirected numbered graph UDG which is a list of pairs N-S, where N is a node and S is the set of successors U of N with N < U in the sense of compare_minimax(Min, Max) above.

   85% ?- links_to_udg(a,b,[a-b], U).
   86% ?- links_to_udg(a,b,[], U).
   87% ?- links_to_udg(a,c,[a-b, b-c], U).
   88% ?- links_to_udg(a,c,[a-b, b-c, a-c], U, V).

links_to_udg(+Min, +Max, +Links, -F, -G) is det: Links is a list of links x-y with x<y, and G is successor version of Links which child is always greater than its root. F is unified with a vector with args <F1, ..., Fn> such that Fi is the minimum such that Fi_th node of G has a link to i-th node of G. In particular, Fi=0 means that there is no link to i-th node. F is used for pruning inactive mates.

   99links_to_udg(Min, Max, Ls, F, H):-
  100	findall(N, ( member(L, Ls), ( L = N-_; L = _-N)), Nodes),
  101	sort_minimax(Min, Max,[Min, Max|Nodes], AllNodes),
  102	normalize_links(Min, Max, Ls, Ls0),
  103	findall(Y-S, (	member(Y, AllNodes),
  104					findall(Z,  (	member(M, Ls0),
  105									( M = Z-Y; M = Y-Z)
  106								),
  107							S)
  108				 ),
  109			F0),
  110	findall(Y-U, (	member(Y, AllNodes),
  111					findall(W, member(Y-W, Ls0), U)
  112				 ),
  113			H0),
  114	sort_udg(Min, Max, F0, F1),
  115	number_nodes_graph(AllNodes, F1, F2),
  116	maplist(pick_frontier, F2, F3),
  117	list_vector(F3, F),
  118	sort_udg(Min, Max, H0, H1),
  119	number_nodes_graph(AllNodes, H1, H).

number_nodes_graph(+Ns, +X, -Y) is det: map a graph X into Y such that each occurrence n in Ns is mapped to an integer k such that k-th element of Ns is n.

  125% ?- number_nodes_graph([a,b,c], [a-[b],b-[a,b]], R).
  126number_nodes_graph(Ns, X, Y):-
  127	length(Ns, N),
  128	numlist(1, N, L),
  129	zip(Ns, L, Assoc),
  130	subst_graph(X, Assoc, Y).

subst_graph(+G, +Assoc, -H) is det: Apply substitution Assoc to a graph G to get renamed version of G.

  135subst_graph([],_,[]).
  136subst_graph([A-S|L], Assoc, [A0-S0|L0]):-
  137	memberchk(A-A0, Assoc),
  138	subst_list(Assoc, S, S0),
  139	subst_graph(L, Assoc, L0).
  140%
  141subst_list(_, [], []):-!.
  142subst_list(As, [X|Y], [X0|Y0]):-
  143	memberchk(X-X0, As),
  144	subst_list(As, Y, Y0).
  145
  146%	normalize_links(+Min, +Max, +Links, -L) is det.
  147%	Swap all liks a-b in Links to b-a if b < a in
  148%	the sense of compare_minimax(Min, Max).
  149
  150% ?- normalize_links(b, a,[a-b], L).
  151% ?- normalize_links(b, a,[a-b, b-a], L).
  152% ?- normalize_links(b, a,[a-b, b-a, d-c], L).
  153% ?- normalize_links(a, c,[a-b, b-c, a-c], L).
  154% ?- normalize_links(c, a,[a-b, b-c, a-c], L).
  155normalize_links(Min, Max, L, M):-
  156	maplist(normal_link(Min, Max), L, M0),
  157	sort(M0, M).
  158%
  159normal_link(Min, Max, A-B, B-A):- lte_minimax(Min, Max, B, A), !.
  160normal_link(_, _, X, X).

sort_udg(+Min, +Max, +U, -V) is det: V is unified with sorted version of UDG U including each list of successors. compare_minimax(Min, Max) is used as he comparison predicate.

  167% ?- sort_udg(z, a, [a-[z,b], b-[a,z], z-[]], X).
  168sort_udg(Min, Max, X, Y):-
  169	predsort(keycompare_minimax(Min, Max), X, X0),
  170	maplist(sort_udg_successors(Min, Max), X0, Y).
  171
  172% ?- sort_udg_successors(z, a, x-[a, z, a, z, b], R).
  173sort_udg_successors(Min, Max, X-A, X-B):- sort_minimax(Min, Max, A, B).
  174
  175% reverse successors.
  176reverse_successors(X-A, X-B):- reverse(A, B).
  177
  178		/*******************
  179		*   Tiny helpers   *
  180		*******************/
  181
  182% ?- arrow_symbol(_->_, F).
  183% ?- arrow_symbol(a->b, F, X, Y).
  184arrow_symbol( _ -> _).
  185%
  186arrow_symbol(A, A0):- functor(A, A0, 2).
  187arrow_symbol(A, A0, A1, A2):- functor(A, A0, 2),
  188		arg(1, A, A1),
  189		arg(2, A, A2).
  190%
  191mate_less_than(_ - A, B -_):- A @< B.
  192
  193% One of the most basic helpers.
  194composable_pairs(A-B, A-C, B, C).
  195composable_pairs(A-B, C-A, B, C).
  196composable_pairs(B-A, A-C, B, C).
  197composable_pairs(B-A, C-A, B, C).
  198%
  199normal_pair(A-B, U-V):-!, ( B @< A -> U=B, V=A; U=A, V=B ).
  200normal_pair(A->B, U->V):- ( B @< A -> U=B, V=A; U=A, V=B ).
  201
  202
  203		/****************************************************
  204		*     replace_end/bypass:  Most basic operations.   *
  205		****************************************************/

subst_end(+Es, +A, +P, +X, -Y, +S) is det: Replace each mate A-U and U-A with P-U and U-P in S, keeping obtained mates normal, and merge the list Es of links Es into such paths. Each path of X such that A does not appear in X is removed from X. Y is unified with the result.
?- zdd X<< {[c-d]}, subst_end([a->c], c, a, X, Y), psa(X), psa(Y).

  214subst_end(_, _, _, X, 0, _):- X<2, !.
  215subst_end(Es, A, P, X, Y, S):-		% replace A with P
  216	cofact(X, t(U, L, R), S),
  217	arrow_symbol(U, U0,Ul,Ur),
  218	(	U0 = (->) -> Y = 0
  219	;	subst_end(Es, A, P, L, L0, S),
  220		(	Ur = A	->
  221			normal_pair(Ul-P, V),
  222			zdd_ord_insert([V|Es], R, R0, S)
  223		;	Ul = A	->
  224			normal_pair(Ur-P, V),
  225			zdd_ord_insert([V|Es], R, R0, S)
  226		;	subst_end(Es, A, P, R, R1, S),
  227			zdd_insert(U, R1, R0, S)
  228		),
  229		zdd_join(L0, R0, Y, S)
  230	).

F is unified with the minimum I in L such that I @< R when it exists, otherwise F done with 0.

  236pick_frontier(R-L, F):- pick_frontier(L, R, F).
  237%
  238pick_frontier([], _, 0).
  239pick_frontier([I|Is], R, F):-
  240	(	I @< R -> F=I
  241	;	pick_frontier(Is, R, F)
  242	).
  243
  244% ?- links_to_mate(a, g, [a-b, b-c, c-d, d-e, e-f, f-a,
  245%	f-c, d-g, g-h, h-e], X, S),
  246%	psa(X, S), card(X, C, S).
  247
  248% ?- links_to_mate(a, e, [a-b, b-c, c-d, d-e, e-f, f-g, g-h, h-a,
  249%	i-b, i-h, i-d, i-f], X, S),
  250%	psa(X, S), card(X, C, S).
  251
  252links_to_mate(A, B, Links, X, S):-links_to_mate(A, B, Links, X, [], S).

links_to_mate(+Min, +Max, +Links, -X, +Ctrl, +S) is det: X is unified with (id number of ) family of lists of mates for paths allowed in the graph given by Links which connects Min and Max. Ctrl is control information on gc about when gc should be performed.

  259links_to_mate(A, B, Links, X, Ctrl, S):-
  260	links_to_udg(A, B, Links, F, H),
  261	maplist(reverse_successors, H, H1),
  262	reverse(H1, Dg),
  263	fetch_state(S),
  264	udg_to_mate(Ctrl, F, Dg, 1, X0, S),
  265	functor(F, _, Max),
  266	prune_final(Max, X0, X, S).

udg_to_mate(+Ctrl, +F, +UDG, +X, -Y, +S) is det: Family X of mates and paths is updated with each link in order given in the list UDG, and finally Y is unified with the obtained family.

  273udg_to_mate(_, _, [], X, X, _):-!.
  274udg_to_mate(Ctrl, F, [N-Ps|UDG], X, Y, S):-
  275	add_node(N, Ps, X, X0, S),
  276	ctrl_gc(Ctrl, N, X0, X1, S),
  277	functor(F, _, Max),
  278	prune_mates(N, F-Max, X1, X2, S),
  279	udg_to_mate(Ctrl, F, UDG, X2, Y, S).

ctrl_gc(+Ctrl, +P, +X, -Y, +S) is det: gc is peformed on the state S according to given control information. Eor example unused hash table is reclaimed.

  285ctrl_gc(Ctrl, P, X, Y, S):-!,
  286	(	memberchk(gc(K), Ctrl) ->
  287		GC = gc(K)
  288	;	GC = nogc
  289	),
  290	gc(GC, P, X, Y, S).
  291%
  292gc(gc(each), P, X, Y, S):-!,
  293	format("GC at ~w \n", [P]),
  294	zdd_slim(X, Y, S),
  295	garbage_collect.
  296gc(gc(K), P, X, Y, S):- K>0, !,
  297	(	P//K =:= 0  ->
  298		format("GC at ~w \n", [P]),
  299		zdd_slim(X, Y, S),
  300		garbage_collect
  301	;	Y = X
  302	).
  303gc(_, _, X, X, _). % no gc, otherwise

add_node(+N, +Ps, +X, -Y, +S) is det: Extend X by adding a new node N and links N-U for U in Ps, and Y is unified with the extended one.

  310% ?- zdd add_node(a, [], 1, X), psa(X).
  311% ?- zdd add_node(b, [], 1, X), add_node(a, [b], X, Y), psa(Y).
  312% ?- zdd add_node(b, [], 1, X), add_node(a, [b], X, Y),
  313%	add_node(c, [a,b], Y, Z), psa(Z).
  314
  315add_node(N, Ps, X, Y, S):- % psa(X, S),
  316	zdd_insert(N-N, X, X1, S),  % add node N first.
  317	add_links(Ps, N, X1, Y, S).
  318
  319%
  320add_links([], _, X, X, _):-!.
  321add_links([P|Ps], N, X, Y, S):-
  322	add_link(N-P, X, X1, S),
  323	zdd_join(X, X1, X2, S),
  324	add_links(Ps, N, X2, Y, S).

add_link(+U, +X, -Y, +S) is det: Extend X by adding a link U, and Y is unified with the extended one.

  330% ?- zdd X<<{[a-b, c-d]}, psa(X), add_link(b-c, X, Y), psa(Y).
  331% ?- zdd X<< {[a-b, c-d], [e-f]}, psa(X), add_link(b-c, X, Y), psa(Y).
  332% ?- ( zdd X<< {[a-b, c-d], [a-a, b-b], [e-f]}, psa(X), add_link(b-c, X, Y), psa(Y) ).
  333% ?- zdd X<< {[a-a, b-b, c-c]}, psa(X), add_link(b-c, X, Y), psa(Y).
  334
  335add_link(_ , X, 0, _):- X<2, !.
  336add_link(U, X, Y, S):-	cofact(X, t(A, L, R), S),
  337	(	arrow_symbol(A) -> Y = 0
  338	; 	add_link(U, L, L0, S),
  339		U = Ul-Ur,
  340		(	mate_less_than(U, A) -> R0 = 0
  341		; 	A = U -> R0 = 0	  % cycle found.
  342		; 	composable_pairs(U, A, U0, V0) ->
  343			subst_end([Ul->Ur], U0, V0, R, R0, S)
  344		;	add_link(U, R, R1, S),
  345			zdd_insert(A, R1, R0, S)
  346		),
  347		zdd_join(L0, R0, Y, S)
  348	).

link_on_frontier(+U, +K, +F) is det: test the link U=I-J whether both of nodes I and J are on frontier K consulting F of list of frontiers.

  355% ?- link_on_frontier(4-5, 2, #(1,3,1,2,2)).
  356% ?- link_on_frontier(4-5, 2, #(1,3,1,3,2)).
  357% ?- link_on_frontier(4-5, 2, #(1,3,1,3,3)).
  358
  359link_on_frontier(I-J, K, F):-  % I \== J assumed.
  360		node_on_frontier(I, K, F),
  361		node_on_frontier(J, K, F).

node_on_frontier(+I, +K, +F) is det: test whether the node I is on frontier at K consulting F of frontier list.

  367node_on_frontier(I, K, F):- arg(I, F, Hi),
  368		( Hi > 0, Hi =< K; I=K),
  369		!.

prune_mates(+P, +Ctrl, +X, -Y, +S) is det: removing unused nodes and pruning branches which having inactive mates. Y is unified with the slimmed one.

  375prune_mates(_, _, X, X, _):- X<2, !.
  376prune_mates(P, Ctrl, X, Y, S):- cofact(X, t(A, L, R), S),
  377	Ctrl = F-Max,
  378	(  arrow_symbol(A) -> Y = X
  379	;  prune_mates(P, Ctrl, L, L0, S),
  380	   (	link_on_frontier(A, P, F) ->
  381			prune_mates(P, Ctrl, R, R1, S),
  382		    zdd_insert(A, R1, R0, S)
  383	   ; 	A = Max-Max -> R0 = 0
  384       ;	A = Ar-Max, node_on_frontier(Ar, P, F) ->
  385			prune_mates(P, Ctrl, R, R1, S),
  386			zdd_insert(A, R1, R0, S)
  387   	   ;	A = U-U, node_on_frontier(U, P, F) ->
  388			prune_mates(P, Ctrl, R, R1, S),
  389			zdd_insert(A, R1, R0, S)
  390	   ;	A = U-U -> prune_mates(P, Ctrl, R, R0, S)
  391	   ;	R0 = 0
  392	   ),
  393	   zdd_join(L0, R0, Y, S)
  394	).

prune_mates(+P, +X, -Y, +S) is det: removing unused nodes and pruning branches having inactive mates. Y is unified with the slimmed one.

  400% prune_final/4
  401prune_final(_, X, 0, _):- X<2, !.
  402prune_final(Max, X, Y, S):- cofact(X, t(A, L, R), S),
  403	(	arrow_symbol(A) -> Y = 0
  404	;	prune_final(Max, L, L0, S),
  405		(   A = 1-Max -> prune_final(R, R0, S)
  406		;	A = U-U -> prune_final(Max, R, R0, S)
  407		;	R0 = 0
  408		),
  409		zdd_join(L0, R0, Y, S)
  410	).
  411
  412% prune_final/3
  413prune_final(X, X, _):- X<2, !.
  414prune_final(X, Y, S):- cofact(X, t(A, L, R), S),
  415	(	arrow_symbol(A) -> Y = X
  416	;	prune_final(L, L0, S),
  417		(	A = U-U -> prune_final(R, R0, S)
  418		;	R0 = 0
  419		),
  420		zdd_join(L0, R0, Y, S)
  421	).

remove_links(+In, +Ns, -Out) is det: Remove links whose end in Bs, and Out is unified with the rusult.

  427% ?- remove_links([1-2, 2-3], [3], L).
  428remove_links(L, Ns, L0):-
  429	findall(A-B, (	member(A-B, L),
  430					\+ memberchk(A, Ns),
  431					\+ memberchk(B, Ns)
  432				 ),
  433			L0).

rect_grid_graph(+W, +H, -Links) is det: Links is unified with the list of links P-Q with grid node P, Q in the rect(W, H) such that Hamitonian distance is 1.

  441rect_grid_graph(W,H,Links):-
  442	findall(P-Q,
  443			(	P=p(I,J),
  444				between(0, W, I),
  445				between(0, H, J),
  446				Q=p(K, L),
  447				(  K is I + 1, K =< W, L = J
  448				;  L is J + 1, L =< H, K = I
  449				)
  450			),
  451			Links)