/************************************************************************* * * * 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 * * * *************************************************************************/ /** * @file setof.yap * @author VITOR SANTOS COSTA * @date Thu Nov 19 10:45:32 2015 * * @brief Setof and friends. * * */ /** @{ @defgroup Sets Collecting Solutions to a Goal @ingroup builtins 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) :- must_be_of_type( list_or_partial_list, Template ), '$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). /** @} */