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		/*******************
   19		*	 Helpers       *
   20		*******************/
   21%
   22normal_pair(A-B, B-A):- B @< A, !.
   23normal_pair(X, X).
   24%
   25ends_frontier(efr(E, Fr)):-
   26	b_getval(st, E),
   27	b_getval(frontier, Fr).
   28%
   29end_node(X):- b_getval(st, S-T),
   30	( X = S; X = T),
   31 	!.
   32% helper.
   33on_pair(I, J-K):- (K = I; J = I), !.
   34
   35off_pair(I, J-K):- I \== J, I \== K.
   36
   37% ?- rect_links(rect(1,1), Links).
   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
   48% ?- prepare_udg_normal(a-d, [a-b, b-c, c-d]),
   49%	b_getval(st, ST),
   50%	b_getval(frontier, Frontier), writeln(Frontier),
   51%	b_getval(links, Links),
   52%	b_getval(dom, Dom),
   53%	b_getval(coa, U).
   54
   55% ?- listing(rect_links).
   56
   57% ?- prepare_udg_reverse(a-d, [a-b, b-c, c-d]), show_udg_st.
   58% ?- prepare_udg(a-d, [a-b, b-c, c-d]), show_udg_st.
   59% ?- prepare_udg(a-d, [a-b, b-c, c-d]), show_udg_st.
   60% ?- rect_links(rect(2,2), Links), prepare_udg(p(0,0)-p(2,2), Links), show_udg_st.
   61
   62		/**************************************
   63		*     st  -- A-B  start-target        *
   64		*     links -- soted notmal link      *
   65		*     coa	  -- successors list      *
   66		*     frontier  -- frontier vector    *
   67		*     dom		-- list of nodes      *
   68		**************************************/
   69
   70prepare_udg(Links):-prepare_udg_reverse(Links).   % default
   71%
   72prepare_udg(ST, Links):- prepare_udg_reverse(Links),
   73	prepare_ends(ST, ST0),
   74	b_setval(st, ST0).
   75%
   76prepare_udg_normal(Links):- pred_prepare_udg(Links, prepare_udg_normal).
   77%
   78prepare_udg_normal(ST, Links):- pred_prepare_udg(ST, Links, prepare_udg_normal).
   79%
   80prepare_udg_reverse(Links):- pred_prepare_udg(Links, prepare_udg_reverse).
   81%
   82prepare_udg_reverse(ST, Links):- pred_prepare_udg(ST, Links, prepare_udg_reverse).
   83%
   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
   92%---- prune vector did not work !
   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
  103%
  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).

@ ERROR: Exported procedure show_udg/0 is not defined @ @ true. @ Context module: preudg. @ true. ?- zdd. ?- prepare_udg_normal([d-c, a-b, a-d, b-d], L, S, D, V), writeln(V). ?- prepare_udg_reverse([d-c, a-b, a-d, b-d], L, S, D, V), writeln(V).

  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).
  135%
  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).
  144%
  145reverse_right(X-L, X-ReverseL):- reverse(L, ReverseL).
  146%
  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),   % D is sorted
  153	length(D, N),
  154	completing_succs(Coa0, Coa, 1, N).
  155
  156%
  157intern_node_id(A, I):- memo(node_id(A)-I, memo_nodes).
  158%
  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
  170% ?-completing_succs([], Y, 1, 2).
  171% ?-completing_succs([2-[a]], Y, 1, 3).
  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
  178% ?- normal_mate_list([1-2], X).
  179% ?- normal_mate_list([2-1, 1-2], X).
  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).

 raise_rel_to_fun(+R, -F) is det

R is assumed. 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]]

  194% ?-  raise_rel_to_fun([], X).
  195% ?-  raise_rel_to_fun([a-b], X).
  196% ?-  raise_rel_to_fun([a-b, c-d], X).
  197% ?-  raise_rel_to_fun([a-b, a-d, c-d], X).
  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).
  203%
  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
  210% ?- domain_of_links([a-b, b-c, a-c], Y).
  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
  220% ?- open_memo(memo_nodes), node_id(a, 0, C).
  221node_id(N, C, C0):- node_id(N, _, C, C0).
  222
  223% ?- open_memo(memo_nodes),
  224%   numlist(1, 10000, Ns),
  225%	foldl(pred(( [I, C, C0]:- node_id(st(I), K, C, C0))), Ns, 0, R).
  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
  232% ?- open_memo(memo_nodes), intern_links([a-b, b-a], R).
  233intern_links(L, L0):- intern_links(L, L0, 0, _).
  234%
  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		/******************
  242		*     frontier    *
  243		******************/

 off_frontier(+I, +J, +F) is det

True if node I must not accessible directly by a link from a node less than J, w.r.t. the froniter vector F.

  250% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X), off_frontier(1, 3, X). %false
  251% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X), off_frontier(3, 2, X). %true
  252
  253off_frontier(I, J, F):- arg(I, F, K), K @< J.

 on_frontier(+I, +J, +F) is det

True if node I may be accessible directly by a link from a node less than J, w.r.t. the frontier vector F.

  260% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X), on_frontier(1, 3, X).
  261on_frontier(I, J, F):- arg(I, F, K), J @=< K.
  262
  263
  264% ?- X=f(1,2,3), setup_frontier_min([1-2,2-3], X).
  265%@ X = f(1, 1, 2).
  266% ?- X=f(3,3,3), setup_frontier_min([1-2,2-3], X).
  267%@ X = f(3, 1, 2).
  268% ?- X=f(0,0,0), setup_frontier_max([1-2,2-3], X).
  269%@ X = f(0, 1, 2).
  270
  271setup_frontier(L, V):- setup_frontier_max(L, V).
  272
  273%
  274setup_frontier_max([], _).
  275setup_frontier_max([I-J|L], V):-
  276	lower_max_array(I, J, V),
  277	!,
  278	setup_frontier_max(L, V).
  279%
  280setup_frontier_min([], _).
  281setup_frontier_min([I-J|L], V):-
  282	lower_min_array(I, J, V),
  283	!,
  284	setup_frontier_min(L, V).
  285%
  286lower_max_array(I, J, V):- arg(J, V, A),
  287	(	I > A -> setarg(J, V, I)
  288	;	true
  289	).
  290%
  291lower_min_array(I, J, V):- arg(J, V, A),
  292	(	I < A -> setarg(J, V, I)
  293	;	true
  294	).
  295
  296
  297% ?- zdd.
  298% experimantal for prune-vector: did not work!
  299% reason: despite that adding nodes, live block may be getting dead,
  300%	they keeps alive because of ignoring this and local applicaiton of pruning .[2025/06/08]
  301% ?- prepare_udg(a-b, [a-b]), setup_prune_vector(Pvec), writeln(Pvec).
  302% ?- rect_links(rect(2,2), Links), prepare_udg(p(0,0)-p(2,2), Links), show_udg_st.
  303
  304% ?- rect_links(rect(3,3), Links), prepare_udg(Links), setup_prune_vector(Pvec), writeln(Pvec).
  305% ?- rect_linkks(rect(500,500), Links), prepare_udg(Links), time(setup_prune_vector(Pvec)).
  306% ?- rect_links(rect(1000,1000), Links), prepare_udg(Links), time(setup_prune_vector(Pvec)).
  307%@ % 30,044,023 inferences, 3.075 CPU in 3.744 seconds (82% CPU, 9769791 Lips)
  308%@ Links = [p(0, 0)-p(1, 0), p(0, 0)-p(0, 1), p(0, 1)-p(1, 1), p(0, 1)-p(0, 2), p(0, 2)-p(1, 2), p(0, 2)-p(0, 3), p(0, 3)-p(1, 3), p(..., ...)-p(..., ...), ... - ...|...],
  309%@ Pvec = #(..).
  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).
  320%
  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)