:- lib(ordsets).	
          % list_to_ord_set/2, ord_add_element/3, ord_memberchk/2.

:- lib( kv_to_ord_k_v/3 ).

% [1-[],2-[1],3-[2,5],4-[],5-[4],6-[4],7-[3],8-[3,6]]

% Collapse == true ->  edges that appear in both direction will 1 link
%
band_bn( Bn, Collapse, [Pless,NoPorC,Cless] ) :-
	sieve_parentless( Bn, SivPless, WithParents ),
     ( Collapse == true -> 
	     clear_bidirectional( WithParents, NoBiWPar )
          ;
	     WithParents = NoBiWPar
     ),
	list_to_ord_set( SivPless, OrdSivPless ),
	kv_to_ord_k_v( WithParents, OrdCh, OrdPa ),
	induce_parentless( OrdPa, OrdCh, OrdSivPless, Pless, Induced ), 
	add_induced_parentless( Induced, Bn, CompBn ),
	sieve_childless( NoBiWPar, CompBn, Cless, NoPorC ).

add_induced_parentless( [], Bn, Bn ).
add_induced_parentless( [H|T], Bn, CompBn ) :-
	add_induced_parentless( T, [H-[]|Bn], CompBn ).

% this is meant to cope with essential graphs.
% use it as a trap to illegal bns otherwise.
clear_bidirectional( [], [] ).
clear_bidirectional( [Node-Parents|T], [Node-DblParents|R] ) :-
	clear_parents_from_remaining( Parents, Node, T, DblParents, Cleared ),
	clear_bidirectional( Cleared, R ).

clear_parents_from_remaining( [], _, Clear, [], Clear ).
clear_parents_from_remaining( [H|T], Node, Pairs, [DblH|DblT], Clear ) :-
	( reverse_edge_exists_in( Pairs, H, Node, NxPairs ) ->
		DblH = dbl(H)
		; 
		DblH = H, NxPairs = Pairs
	),
	clear_parents_from_remaining( T, Node, NxPairs, DblT, Clear ).

reverse_edge_exists_in( Pairs, H, Node, NxPairs ) :-
	select( H-HParents, Pairs, RemPairs ),
	select( Node, HParents, RedParents ),
	ord_add_element( RemPairs, H-RedParents, NxPairs ).

sieve_parentless( [], [], [] ).
sieve_parentless( [H|T], Pless, WithParents ) :-
	( H = Node-[] -> 
		Pless = [Node|Tpl],
		WithParents = Twp
		;
		Pless = Tpl,
		WithParents = [H|Twp]
	),
	sieve_parentless( T, Tpl, Twp ).

induce_parentless( [], _OrdCh, Pless, Pless, [] ).
induce_parentless( [H|T], OrdCh, AccPless, Pless, Ind ) :-
	% should change this to ord_memberchk/2 if SICStus supports this.
	( ord_memberchk(H,OrdCh) ->
		NextPless = AccPless, Ind = TInd
		;
		ord_add_element( AccPless, H, NextPless ),
		Ind = [H|TInd]
	),
	induce_parentless( T, OrdCh, NextPless, Pless, TInd ).

sieve_childless( [], _Bn, [], [] ).
sieve_childless( [Node-Parents|T], Bn, WPorC, Cless ) :-
	( childless(Bn,Node) -> 
		WPorC = [Node-Parents|Tporc],
		Cless = Tcl
		;
		WPorC = Tporc,
		Cless = [Node-Parents|Tcl]
	),
	sieve_childless( T, Bn, Tporc, Tcl ).

childless( [], _B ).
childless( [_A-Parents|T], B ) :-
	\+ ord_memberchk( B, Parents ), 
	childless( T, B ).