yap-6.3/pl/setof.yap

/*************************************************************************
*									 *
*	 YAP Prolog 	%W% %G%
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		setof.pl						 *
* Last rev:								 *
* mods:									 *
* comments:	set predicates						 *
*									 *
*************************************************************************/


/** @defgroup Sets Collecting Solutions to a Goal
@ingroup YAPBuiltins
@{

When there are several solutions to a goal, if the user wants to collect all
the solutions he may be led to use the data base, because backtracking will
forget previous solutions.

YAP allows the programmer to choose from several system
predicates instead of writing his own routines.  findall/3 gives you
the fastest, but crudest solution. The other built-in predicates
post-process the result of the query in several different ways:



 
*/

:- system_module( '$_setof', [(^)/2,
        all/3,
        bagof/3,
        findall/3,
        findall/4,
        setof/3], []).

:- use_system_module( '$_boot', ['$catch'/3]).

:- use_system_module( '$_errors', ['$do_error'/2]).

%   The "existential quantifier" symbol is only significant to bagof
%   and setof, which it stops binding the quantified variable.
%   op(200, xfy, ^) is defined during bootstrap.

% this is used by the all predicate

:- op(50,xfx,same).

_^Goal :-
	'$execute'(Goal).


%   findall/3 is a simplified version of bagof which has an implicit
%   existential quantifier on every variable.


/** @pred  findall( _T_,+ _G_,- _L_) is iso 


Unifies  _L_ with a list that contains all the instantiations of the
term  _T_ satisfying the goal  _G_.

With the following program:

~~~~~
a(2,1).
a(1,1).
a(2,2).
~~~~~
the answer to the query

~~~~~
findall(X,a(X,Y),L).
~~~~~
would be:

~~~~~
X = _32
Y = _33
L = [2,1,2];
no
~~~~~

 
*/

findall(Template, Generator, Answers) :-
	( '$is_list_or_partial_list'(Answers) ->
		true
	;
		'$do_error'(type_error(list,Answers), findall(Template, Generator, Answers))
	),
	'$findall'(Template, Generator, [], Answers).


% If some answers have already been found
/** @pred  findall( _T_,+ _G_,+ _L_,- _L0_)

Similar to findall/3, but appends all answers to list  _L0_.

 
*/
findall(Template, Generator, Answers, SoFar) :-
	'$findall'(Template, Generator, SoFar, Answers).

% starts by calling the generator,
% and recording the answers
'$findall'(Template, Generator, SoFar, Answers) :-
	nb:nb_queue(Ref),
	(
	  '$execute'(Generator),
	  nb:nb_queue_enqueue(Ref, Template),
	 fail
	;
	 nb:nb_queue_close(Ref, Answers, SoFar)
	).



% findall_with_key is very similar to findall, but uses the SICStus
% algorithm to guarantee that variables will have the same names.
%
'$findall_with_common_vars'(Template, Generator, Answers) :-
	nb:nb_queue(Ref),
	(
	  '$execute'(Generator),
	  nb:nb_queue_enqueue(Ref, Template),
	  fail
	;
	  nb:nb_queue_close(Ref, Answers, []),
	  '$collect_with_common_vars'(Answers, _)
	).

'$collect_with_common_vars'([], _).
'$collect_with_common_vars'([Key-_|Answers], VarList) :-
	'$variables_in_term'(Key, _, VarList),
	'$collect_with_common_vars'(Answers, VarList).
	
% This is the setof predicate
/** @pred  setof( _X_,+ _P_,- _B_) is iso 


Similar to `bagof( _T_, _G_, _L_)` but sorts list
 _L_ and keeping only one copy of each element.  Again, assuming the
same clauses as in the examples above, the reply to the query

~~~~~
setof(X,a(X,Y),L).
~~~~~
would be:

~~~~~
X = _32
Y = 1
L = [1,2];
X = _32
Y = 2
L = [2];
no
~~~~~




 */
setof(Template, Generator, Set) :-
	( '$is_list_or_partial_list'(Set) ->
		true
	;
		'$do_error'(type_error(list,Set), setof(Template, Generator, Set))
	),
	'$bagof'(Template, Generator, Bag),
	'$sort'(Bag, Set).

% And this is bagof

% Either we have excess of variables
% and we need to find the solutions for each instantiation
% of these variables

/** @pred  bagof( _T_,+ _G_,- _L_) is iso 


For each set of possible instances of the free variables occurring in
 _G_ but not in  _T_, generates the list  _L_ of the instances of
 _T_ satisfying  _G_. Again, assuming the same clauses as in the
examples above, the reply to the query

~~~~~
bagof(X,a(X,Y),L).

would be:
X = _32
Y = 1
L = [2,1];
X = _32
Y = 2
L = [2];
no
~~~~~

 
*/
bagof(Template, Generator, Bag) :-
	( '$is_list_or_partial_list'(Bag) ->
		true
	;
		'$do_error'(type_error(list,Bag), bagof(Template, Generator, Bag))
	),
	'$bagof'(Template, Generator, Bag).

'$bagof'(Template, Generator, Bag) :-
	'$free_variables_in_term'(Template^Generator, StrippedGenerator, Key),
	%format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]),
	( Key \== '$' ->
		'$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0),
		'$keysort'(Bags0, Bags),
		'$pick'(Bags, Key, Bag)
	;
		'$findall'(Template, StrippedGenerator, [], Bag0),
		Bag0 \== [],
		Bag = Bag0
	).


% picks a solution attending to the free variables
'$pick'([K-X|Bags], Key, Bag) :-
	'$parade'(Bags, K, Bag1, Bags1),
	'$decide'(Bags1, [X|Bag1], K, Key, Bag).

'$parade'([K-X|L1], Key, [X|B], L) :- K == Key, !,
	'$parade'(L1, Key, B, L).
'$parade'(L, _, [], L).

%
% The first argument to decide gives if solutions still left;
% The second gives the solution currently found;
% The third gives the free variables that are supposed to be bound;
% The fourth gives the free variables being currently used.
% The fifth  outputs the current solution.
%
'$decide'([], Bag, Key0, Key, Bag) :- !,
	Key0=Key.
'$decide'(_, Bag, Key, Key, Bag).
'$decide'(Bags, _, _, Key, Bag) :-
	'$pick'(Bags, Key, Bag).

% as an alternative to setof you can use the predicate all(Term,Goal,Solutions)
% But this version of all does not allow for repeated answers
% if you want them use findall	
/** @pred  all( _T_,+ _G_,- _L_) 


Similar to `findall( _T_, _G_, _L_)` but eliminate
repeated elements. Thus, assuming the same clauses as in the above
example, the reply to the query

~~~~~
all(X,a(X,Y),L).
~~~~~
would be:

~~~~~
X = _32
Y = _33
L = [2,1];
no
~~~~~

Note that all/3 will fail if no answers are found.

 
*/
all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
all(T,G,S) :- 
	'$init_db_queue'(Ref),
	( '$catch'(Error,'$clean_findall'(Ref,Error),_),
	  '$execute'(G),
	  '$db_enqueue'(Ref, T),
	  fail
        ;
	  '$$set'(S,Ref)
        ).

% $$set does its best to preserve space
'$$set'(S,R) :- 
       '$$build'(S0,_,R),
        S0 = [_|_],
	S = S0.

'$$build'(Ns,S0,R) :- '$db_dequeue'(R,X), !,
	'$$build2'(Ns,S0,R,X).
'$$build'([],_,_).

'$$build2'([X|Ns],Hash,R,X) :-
	'$$new'(Hash,X), !,
	'$$build'(Ns,Hash,R).
'$$build2'(Ns,Hash,R,_) :-
	'$$build'(Ns,Hash,R).

'$$new'(V,El) :- var(V), !, V = n(_,El,_).
'$$new'(n(R,El0,L),El) :- 
	compare(C,El0,El),
	'$$new'(C,R,L,El).

'$$new'(=,_,_,_) :- !, fail.
'$$new'(<,R,_,El) :- '$$new'(R,El).
'$$new'(>,_,L,El) :- '$$new'(L,El).


'$$produce'([T1 same X1|Tn],S,X) :- '$$split'(Tn,T1,X1,S1,S2),
	( S=[T1|S1], X=X1;
	  !, produce(S2,S,X) ).

'$$split'([],_,_,[],[]).
'$$split'([T same X|Tn],T,X,S1,S2) :- '$$split'(Tn,T,X,S1,S2).
'$$split'([T1 same X|Tn],T,X,[T1|S1],S2) :- '$$split'(Tn,T,X,S1,S2).
'$$split'([T1|Tn],T,X,S1,[T1|S2]) :- '$$split'(Tn,T,X,S1,S2).

/**
@}
*/