% predicates auxiliary to demo.
%
aux_body_and_goals( Body, RestGoals, NewGoals ) :-
	append( Body, RestGoals, NewGoals ).

aux_goal_select( [Goal|Goals], Goal, Goals ).

aux_map_variables( InList, Active, OutList ) :-
	aux_map_vars( InList, Active, RecList ),
	flatten( RecList, FlatList ),
	keysort( FlatList, OutList ).

aux_map_vars( [PrlVAtom=PfdVOr|Vs], Active, [PrlVAtom-MapVal,Subs|PfdVs] ) :-
	( pfd_var(PfdVOr) -> 
		aux_pfd_var_to_vals( PfdVOr, Active, MapVal )
		;
		% then this wasnt instantiated to a pfd var,
		( compound( PfdVOr ) -> 
			% prolog variable has become a structure
			% which may include pfdvars that didnot appear
			% in the original query
			( is_list(PfdVOr) -> 
				aux_map_args( PfdVOr, Active, Subs )
				;
				PfdVOr =.. [_Name|Args],
				aux_map_args( Args, Active, Subs )
			),
			% MapVal =.. [Name|ActArgs]
			MapVal = PfdVOr
			;
			% generic, ie Var remains a var or is atomic
			MapVal = PfdVOr, 
			Subs = []
		)
	),
	aux_map_vars( Vs, Active, PfdVs ).
aux_map_vars( [], _Active, [] ).

aux_map_args( [], _Active, [] ).
aux_map_args( [H|T], Active, Subs ) :-
	( pfd_var(H) -> 
		aux_pfd_var_to_vals( H, Active, HDom ),
		Subs = [H-HDom|TSubs]
		;
		( compound(H) -> 
			( is_list(H) -> 
				aux_map_args( H, Active, HSubs )
				;
				H =.. [_Name|Args],
				aux_map_args( Args, Active, HSubs )
			),
			Subs = [HSubs|TSubs]
			;
			TSubs = Subs
		)
	),
	aux_map_args( T, Active, TSubs ).

aux_pfd_var_to_vals( PfdVar, Active, ItsPossVals ) :-
	key_member( PfdVar, ItsActData, Active ), 
	!,
	( atomic(ItsActData) -> 
		ItsPossVals = ItsActData
		;
		data_choose( dmn(ItsPossVals), ItsActData )
	).
aux_pfd_var_to_vals( PfdVar, Active, PVals ) :-
	throw( pfd(internal(no_data_for_var(PfdVar,Active,PVals))) ).

key_member( Key, El, [HKey-HEl|T] ) :-
	( Key @< HKey ->
		fail
		;
		( Key == HKey -> 
			El = HEl
			;
			key_member( Key, El, T )
		)
	).


aux_goal_tuple_to_list( (A,B), [PfdA|T] ) :-
	expand_pfd_goal( A, PfdA ),
	!,
	aux_goal_tuple_to_list( B, T ).
aux_goal_tuple_to_list( A, [PfdA] ) :-
	expand_pfd_goal( A, PfdA ),
	!.

% this should work, but double check due to,
% H @< Elem, and the unification,  H = Elem.
%
% aux_ord_del_element( Set, Elem, Acc, Nth, ResSet ) :-
% 
aux_ord_del_element( Set, Elem, Nth, ResSet ) :-
	aux_ord_del_element( Set, Elem, 1,  Nth, ResSet ).

aux_ord_del_element( [H|T], Elem, Acc, Nth, ResSet ) :-
	( H = Elem -> 
		Nth = Acc,
		ResSet = T
		;
		H @< Elem,
		NewAcc is Acc + 1,
		ResSet = [H|MoreSet],
		aux_ord_del_element( T, Elem, NewAcc, Nth, MoreSet )
	).

aux_add_element_on_nth( [], 1, Elem, [Elem] ).
aux_add_element_on_nth( [H|T], Nth, Elem, List ) :-
	( Nth > 1 ->
		List = [H|More],
		RedNth is Nth - 1,
		aux_add_element_on_nth( T, RedNth, Elem, More )
		;
		Nth =:= 1,
		List = [Elem,H|T]
	).

ensure_list( AtomOrList, List ) :-
	( is_list(AtomOrList) ->
		List = AtomOrList
		;
		List = [AtomOrList]
	).

% aux_solution( PfdVars ) :-
% print solution and ask for what to do next,
% if the predicate fails the system will backtrack,
% whereas on succeeds, no more solutions will be 
% tried for.
%
aux_solution( PfdVars ) :-
	nl, 	% newlinw a day takes the doctor ?
	( PfdVars = [] -> 
		Input is 10
		;
		write_ls_vars( PfdVars ), 
		write( ' ? ' ),
		% get0( Input ) % sicstus prompts if we move this.
        % fixme: next 2 lines for testing only
		( bb_get(pfd_not_interactive,true) ->
			Input is 0';
			;
			on_pl( swi(_Swi), (get_single_char(Input),nl) ), % swi
			on_pl( sicstus(_ASics), get_line([Input|_Tine1]) ),
			on_pl( yap(_Ayap), get_line([Input|_Tine2]) )
		)
	),
	/* 
	( Input =\= 10 -> 
		on_pl( sicstus(_ASics), skip_line )
		;
		true
	),
	*/
	( 0'; = Input ->
		fail
		;
        !,
		true
	).

aux_cartesian( [H|T], [HS|TS], [H-HS|Prs] ) :-
	aux_cartesian( T, TS, Prs ).
aux_cartesian( [], [], [] ).

retractall_but( Head, N ) :-
	findall( Head-Body,
		clause(Head,Body),
			Clauses ),
	is_list_of_n_vars( N, Vars ),
	append( Vars, _Sufix, Clauses ),
	retractall( Head ),
	assert_pairs( Vars ).

is_list_of_n_vars( 0, [] ) :- !.

is_list_of_n_vars( N, [H|T] ) :-
        N > 0,
        var( H ),
        N1 is N - 1,
        is_list_of_n_vars( N1, T ).

assert_pairs( [] ).
assert_pairs( [H-B|T] ) :-
	( B==true ->
		assertz( (H) )
		;
		assertz( (H:-B) )
	),
	assert_pairs( T ).

zip( [], [], [] ).
zip( [H1|T1], [H2|T2], [(H1,H2)|T3] ) :-
	zip( T1, T2, T3 ).

ord_zip( [], [], _Op, Pairs, Pairs ).
ord_zip( [H|T], [H1|T1], Op, Acc, Pairs ) :-
	ord_add_prob_pair( Acc, (H,H1), Op, NxAcc ), 
	ord_zip( T, T1, Op, NxAcc, Pairs ).

ord_add_prob_pair( [(Prh,ValH)|T], (Pr,Val), Op, OrdPairs ) :-
	Compare =.. [Op,Pr,Prh],
	call(Compare),
	!,
	OrdPairs = [(Pr,Val),(Prh,ValH)|T].
ord_add_prob_pair( [H|T], (Pr,Val), Op, [H|Rest] ) :-
	!,
	ord_add_prob_pair( T, (Pr,Val), Op, Rest ).
ord_add_prob_pair( [], (Pr,Val), _Op, [(Pr,Val)] ).

% best_polling( List, Inserts, Best ) :-
best_polling( [], Inserts, Best, ItsPrb ) :-
	% reverse( Inserts, Streshni ),
	% insert_progressive( Streshni, [], Best ).
	insert_progressive( Inserts, [], 1/1,  Best, ItsPrb ).
best_polling( [[(Prb,El)|PDmn]|T], AccInserts, Best, ItsPrb ) :-
	the_best( T, Prb, El, 2, 1, BPos, BProb ),
	nth1( BPos, [PDmn|T], _DelColumn, NxCand ),
	NxInserts = [BPos-(BProb,El)|AccInserts],
	best_polling( NxCand, NxInserts, Best, ItsPrb ).

the_best( [], Prb, _El, _Count, BPos, BPos, Prb ).
the_best( [H|T], Prb, El, Count, AccPos, BPos, BProb ) :-
	( (H=[(RivPrb,El)|_Dmn],RivPrb>Prb) -> 
		NxPrb = RivPrb,
		NxAccPos = Count
		;
		NxPrb = Prb,
		NxAccPos = AccPos
	),
	NxCount is Count + 1,
	the_best( T, NxPrb, El, NxCount, NxAccPos, BPos, BProb ).

insert_progressive( [], Whole, Prb, Whole, Prb ).
insert_progressive( [N-H|T], Acc, AccPrb, Whole, Prb ) :-
	H = (HPrb,_HPrb),
	rationals_multiplication( AccPrb, HPrb, NxPrb ),
	nth1( N, NxAcc, H, Acc ), 
	insert_progressive( T, NxAcc, NxPrb, Whole, Prb ).

print_probs_n_vals( pr_order, Probs, Set ) :-
	write( '[ /1000' ), nl,
	print_pfd_pr_order( Probs, Set ),
	write( ']' ), nl, nl.

print_pfd_pr_order( Probs, Set ) :-
	dbg( in_print(Probs,Set) ),
	% min_list( Prob, MaxProb ),
	rationals_sort( Probs, Sort ),
	reverse( Sort, Rever ),
	print_pfd_pr_order( Rever, Probs, Set ).
% print_pfd_pr_order( _Prob, _Set ).

print_pfd_pr_order( [H|T], Probs, Set ) :-
	nth1( Nth1, Probs, H, RemProb ),
	!, % only find first
	nth1( Nth1, Set, Val, RemSet ),
	dbg( after_nths(Nth1) ),
	% MaxNorm is integer( 1000 * MaxProb ),
	% write( '(' ), write( MaxNorm ), 
	N is H * 1000,
	write( '(' ), write( N ), write( ',' ),
	write( H ), write( ',' ),
	atom_chars( Atom, [Val] ),
	write( Atom ), write( '),' ),
	print_pfd_pr_order( T, RemProb, RemSet ).
print_pfd_pr_order( [], _Empty, Set ) :-
	nl,
	( Set == [] -> 
		true
		;
		write( spurious_set(Set) ), nl,
		abort
	).

write_ls_vars( [Fr-Fv,S|T] ) :-
	!,
	write( Fr ), write(=), write( Fv ),
	write( ',' ), nl,
	write_ls_vars( [S|T] ).
write_ls_vars( [Singleton-Val] ) :-
	write( Singleton ), write(=), write(Val).

singleton( [_H] ).
singleton( [H], H ).

must_be( TypePred, Goal, ArgNo ) :-
	( call(TypePred) -> 
		true
		;
		TypePred =.. [TypeName|Args],
		( singleton(Args,Culprit)-> 
			true
			;
			Culprit = Args
		),
		throw( pfd(std(
			type_error(Goal,ArgNo,TypeName,Culprit) 
				)) )
	).

% assume sorted.
collate_el_prb_pairs( [], [] ).
collate_el_prb_pairs( [El-Prb|T], [El-SumPrb|TPairs] ) :-
	collate_el_prb_pairs_1( T, El, Prb, NxTail, SumPrb ),
	collate_el_prb_pairs( NxTail, TPairs ).

% collate_el_prb_pairs_1( [], _El, Prb,  Prb ).
collate_el_prb_pairs_1( [El-ElPrb|T], El, AccPrb, RemT, Prb ) :-
	!,
	rationals_addition( AccPrb, ElPrb, NxAccPrb ),
	collate_el_prb_pairs_1( T, El, NxAccPrb, RemT, Prb ).
collate_el_prb_pairs_1( List, _El, Prb, List, Prb ).

memberchk_identical_list( [], _List ).
memberchk_identical_list( [H|T], List ) :-
	memberchk_identical( List, H ),
	memberchk_identical_list( T, List ).

memberchk_identical( [], _El ).
memberchk_identical( [H|T], El ) :-
	( H == El ->
		true
		;
		memberchk_identical( T, El )
	).

sieve_n_mark_pvars( [], Marks, Lvs, Lvs, Marks, _FdIs, [] ).
	% kv_decompose( Marks, Pvars, Marks ).
sieve_n_mark_pvars( [H|T], AcPMarks, AcLvs, Lvs, PMarks, FDVs, Marked ) :-
	( pfd_var(H, FDVs) -> 
		Marked  = [Mark|Tmrked],
		NxLvs = AcLvs,
		( id_memberchk_kv(AcPMarks,H-Mark) ->
			NxPMarks = AcPMarks
			;
			NxPMarks = [H-Mark|AcPMarks]
		)
		;
		( var(H) ->
			NxLvs = [H|AcLvs],
			NxPMarks = AcPMarks,
			Marked = [H|Tmrked]
			;
			( atomic(H) ->
				NxPMarks = AcPMarks,
				Marked  = [H|Tmrked],
				NxLvs = AcLvs
				;
				H =.. [Name|Args],
				sieve_n_mark_pvars( Args, AcPMarks, AcLvs, NxLvs, FDVs, NxPMarks, MarkedArgs ),
				Hmrked =.. [Name|MarkedArgs],
				Marked = [Hmrked|Tmrked]
			)
		)
	),
	sieve_n_mark_pvars( T, NxPMarks, NxLvs, Lvs, PMarks, FDVs, Tmrked ).

sieve_vars( [], [], [] ).
sieve_vars( [H|T], Vars, NoVars ) :-
	( var(H) ->
		Vars = [H|Tvars],
		NoVars = TnoVars
		;
		Vars = Tvars,
		NoVars = [H|TnoVars]
	),
	sieve_vars( T, Tvars, TnoVars ).

% 2003/02/08, this is being moved from compile time
% to introduction time. Variables are not allowed.
in_num_to_fraction( In, Caller, Fract ) :-
	in_num_to_fraction_1( In, Caller, Fract ),
	( Fract > 1 -> 
		write( 'Error: pi more than 1, in: ' ), 
		write( Caller ), nl,
		abort
		;
		( Fract < 0 -> 
			write( 'Error: pi less than 0, in: ' ), 
			write( Caller ), nl,
			abort
			;
			true
		)
	).
			
in_num_to_fraction_1( In, Caller, Fract ) :-
	( var(In) -> 
		write( 'Error: variable in pi, for constraint: ' ), 
		write( Caller ), nl,
		abort
		;
		( integer(In) ->
			Fract = In / 1
			;
			( arithmetic_to_rational( In, Fract, Lf, Rg, Rat, Rl, Rr ) -> 
				in_num_to_fraction_1( Lf, Caller, Rl ),
				in_num_to_fraction_1( Rg, Caller, Rr ),
				call( Rat )
				;
				write( 'Error: unrecognised expression, ' ), 
				write( In ), write( ' in pi of, ' ),
				write( Caller ), nl,
				abort
			)
		)
	).

				
in_num_to_fraction_old( In, Caller, Fract ) :-
	( var(In) -> 
		Fract = In
		;
		( In =:= 1 ->
			Fract = 1/1
			;
			( In =:= 0 ->
				Fract = 0/1
				;
				Fract = In
			)
		),
		( Fract = _Nm/_Dn ->
			( Fract =< 1 -> true ; 
				write( 'Error: pi more than 1, in: ' ), 
				write( Caller ), nl,
				abort
				;
				true
			)
			;
			write( 'Error: pi should be of the form Nom/Den, in: ' ), 
			write( Caller ), nl,
			abort
		)
	).

select_dichotomy( Elem, List, Selected, Other ) :-
	( select(Elem,List,NxList) -> 
		Selected = [Elem|Ts],
		select_dichotomy( Elem, NxList, Ts, Other )
		;
		Selected = [],
		Other = List
	).

kv_consolidate( [], [] ).
kv_consolidate( [K-V|T], [K-ConsV|R] ) :-
	select_dichotomy( K-_S, T, Sel, Other ),
	kv_decompose( [K-V|Sel], _SingletonKey, ConsV ),
	kv_consolidate( Other, R ).

kv_rat_additive_consolidation( [], [] ).
kv_rat_additive_consolidation( [K-V|T], Consol ) :-
	( select(K-V1,T,ResT) ->
		rationals_addition( V1, V, V2 ),
		Consol = Tconsol,
		Tail = [K-V2|ResT]
		;
		Consol = [K-V|Tconsol],
		Tail = T
	),
	kv_rat_additive_consolidation( Tail, Tconsol ).

kv_additive_consolidation( [], [] ).
kv_additive_consolidation( [K-V|T], Consol ) :-
	( select(K-V1,T,ResT) ->
		V2 is V1 + V,
		Consol = Tconsol,
		Tail = [K-V2|ResT]
		;
		Consol = [K-V|Tconsol],
		Tail = T
	),
	kv_additive_consolidation( Tail, Tconsol ).

kv_decompose( [], [], [] ).
kv_decompose( [K-V|T], [K|Tk], [V|Tv] ) :-
	kv_decompose( T, Tk, Tv ).

% 
kv_compose( [], [], [] ).
kv_compose( [Hk|Tks], [Hv|Tvs], [Hk-Hv|Tkvs] ) :-
	kv_compose( Tks, Tvs, Tkvs ).

true( _X ).

arithmetic_to_rational( (A + B), F, A, B, Rat, L, R ) :-
	Rat = rationals_addition( L, R, F ).
arithmetic_to_rational( (A * B), F, A, B, Rat, L, R ) :-
	Rat = rationals_multiplication( L, R, F ).
arithmetic_to_rational( (A - B), F, A, B, Rat, L, R ) :-
	Rat = rationals_subtraction( L, R, F ).
arithmetic_to_rational( (A / B), F, A, B, Rat, L, R ) :-
	Rat = rationals_division( L, R, F ).

register_mass_loss_function_for( Var ) :-	
	bb_get( vars_with_mass_loss_fun, Vars ),
	bb_put( vars_with_mass_loss_fun, [Var|Vars] ).

has_mass_lossing_function( Var ) :-
	bb_get( vars_with_mass_loss_fun, Vars ),
	id_memberchk( Vars, Var ).

kv_split_triple( [], [], [] ).
kv_split_triple( [A-B-C|T], [A-B|R], [A-C|M] ) :-
	kv_split_triple( T, R, M ).

domain_distros_consolidation( [], _DDistros, [] ).
domain_distros_consolidation( [H|T], DDistros, Conso ) :-
	single_element_probabilities_in_domains( DDistros, H, NxDDs, Prbs ),
	( Prbs = [] -> 
		Conso = TConso
		;
		rationals_add_list( Prbs, HPrb ),
		Conso = [H-HPrb|TConso]
	),
	domain_distros_consolidation( T, NxDDs, TConso ).

single_element_probabilities_in_domains( [], _El, [], [] ).
single_element_probabilities_in_domains( [H|T], El, [Hrm|Trms], Prbs ) :-
	( select(El-HPrb,H,Hrm) ->
		Prbs = [HPrb|TPrbs]
		;
		Hrm = [],
		Prbs = TPrbs
	),
	single_element_probabilities_in_domains( T, El, Trms, TPrbs ).

sieve_positions( [], _, _FullFd, [] ).
sieve_positions( [H|T], Idx, [HEl|TEls], SFd ) :-
	NxIdx is Idx + 1,
	( H =< Idx -> 
		NxPos = T,
		SFd = [HEl|TSFd]
		;
		NxPos = [H|T],
		SFd = TSFd
	),
	sieve_positions( NxPos, NxIdx, TEls, TSFd ).