home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / huprolog / Source / SET_OF < prev   
Encoding:
Text File  |  1990-06-03  |  12.5 KB  |  366 lines
  1. %   File   : SETOF.PL
  2. %   Author : R.A.O'Keefe
  3. %   Updated: 17 November 1983
  4. %   Purpose: define set_of/3, bag_of/3, findall/3, and findall/4
  5. %   Needs  : Not.Pl
  6.  
  7. ?- op(800,xfy,^).
  8.  
  9. _ ^ G :- G.
  10.  
  11. /*  This file defines two predicates which act like setof/3 and bagof/3.
  12.     I have seen the code for these routines in Dec-10 and in C-Prolog,
  13.     but I no longer recall it, and this code was independently derived
  14.     in 1982 by me and me alone.
  15.  
  16.     Most of the complication comes from trying to cope with free variables
  17.     in the Filter; these definitions actually enumerate all the solutions,
  18.     then group together those with the same bindings for the free variables.
  19.     There must be a better way of doing this.  I do not claim any virtue for
  20.     this code other than the virtue of working.  In fact there is a subtle
  21.     bug: if setof/bagof occurs as a data structure in the Generator it will
  22.     be mistaken for a call, and free variables treated wrongly.  Given the
  23.     current nature of Prolog, there is no way of telling a call from a data
  24.     structure, and since nested calls are FAR more likely than use as a
  25.     data structure, we just put up with the latter being wrong.  The same
  26.     applies to negation.
  27.  
  28.     Would anyone incorporating this in their Prolog system please credit
  29.     both me and David Warren;  he thought up the definitions, and my
  30.     implementation may owe more to subconscious memory of his than I like
  31.     to think.  At least this ought to put a stop to fraudulent claims to
  32.     having bagof, by replacing them with genuine claims.
  33.  
  34.     Thanks to Dave Bowen for pointing out an amazingly obscure bug: if
  35.     the Template was a variable and the Generator never bound it at all
  36.     you got a very strange answer!  Now fixed, at a price.
  37. */
  38.  
  39. /*
  40. :- public
  41.         findall/3,              %   Same effect as C&M p152
  42.         findset/3
  43.         findall/4,              %   A variant I have found very useful
  44.         bag_of/3,               %   Like bagof (Dec-10 manual p52)
  45.         set_of/3.               %   Like setof (Dec-10 manual p51)
  46.  
  47. */
  48.  
  49. %   findall(Template, Generator, List)
  50. %   is a special case of bagof, where all free variables in the
  51. %   generator are taken to be existentially quantified.  It is
  52. %   described in Clocksin & Mellish on p152.  The code they give
  53. %   has a bug (which the Dec-10 bagof and setof predicates share)
  54. %   which this has not.
  55. %
  56. %  findset is the same except that it returns a set rather than a bag. 
  57.  
  58. findall(Template, Generator, List) :-
  59.         save_instances(-Template, Generator),
  60.         list_instances([], List).
  61.  
  62. findset(Template, Generator, List) :-
  63.         save_instances(-Template, Generator),
  64.         list_instances([], BList),
  65.         ksort( BList, List ).
  66.  
  67.  
  68.  
  69. %   findall(Template, Generator, SoFar, List) :-
  70. %       findall(Template, Generator, Solns),
  71. %       append(Solns, SoFar, List).
  72. %   But done more cheaply.
  73.  
  74. findall(Template, Generator, SoFar, List) :-
  75.         save_instances(-Template, Generator),
  76.         list_instances(SoFar, List).
  77.  
  78.  
  79. %   set_of(Template, Generator, Set)
  80. %   finds the Set of instances of the Template satisfying the Generator.
  81. %   The set is in ascending order (see compare/3 for a definition of
  82. %   this order) without duplicates, and is non-empty.  If there are
  83. %   no solutions, set_of fails.  set_of may succeed more than one way,
  84. %   binding free variables in the Generator to different values.  This
  85. %   predicate is defined on p51 of the Dec-10 Prolog manual.
  86.  
  87. set_of(Template, Filter, Set) :-
  88.         bag_of(Template, Filter, Bag),
  89.         ksort(Bag, Set).
  90.  
  91.  
  92.  
  93. %   bag_of(Template, Generator, Bag)
  94. %   finds all the instances of the Template produced by the Generator,
  95. %   and returns them in the Bag in they order in which they were found.
  96. %   If the Generator contains free variables which are not bound in the
  97. %   Template, it assumes that this is like any other Prolog question
  98. %   and that you want bindings for those variables.  (You can tell it
  99. %   not to bother by using existential quantifiers.)
  100. %   bag_of records three things under the key '.':
  101. %       the end-of-bag marker          -
  102. %       terms with no free variables   -Term
  103. %       terms with free variables   Key-Term
  104. %   The key '.' was chosen on the grounds that most people are unlikely
  105. %   to realise that you can use it at all, another good key might be ''.
  106. %   The original data base is restored after this call, so that set_of
  107. %   and bag_of can be nested.  If the Generator smashes the data base
  108. %   you are asking for trouble and will probably get it.
  109. %   The second clause is basically just findall, which of course works in
  110. %   the common case when there are no free variables.
  111.  
  112. bag_of(Template, Generator, Bag) :-
  113.         free_variables(Generator, Template, [], Vars),
  114.         Vars \== [],
  115.         !,
  116.         Key =.. [.|Vars],
  117.         functor(Key, ., N),
  118.         save_instances(Key-Template, Generator),
  119.         list_instances(Key, N, [], OmniumGatherum),
  120.         keyksort(OmniumGatherum, Gamut), !,
  121.         concordant_subset(Gamut, Key, Answer),
  122.         Bag = Answer.
  123. bag_of(Template, Generator, Bag) :-
  124.         save_instances(-Template, Generator),
  125.         list_instances([], Bag),
  126.         Bag \== [].
  127.  
  128.  
  129.  
  130. %   save_instances(Template, Generator)
  131. %   enumerates all provable instances of the Generator and records the
  132. %   associated Template instances.  Neither argument ends up changed.
  133.  
  134. save_instances(Template, Generator) :-
  135.         asserta('s s'( - ) ),
  136.         call(Generator),
  137.         asserta('s s'( Template ) ),
  138.         fail.
  139. save_instances(_, _).
  140.  
  141.  
  142. %   list_instances(SoFar, Total)
  143. %   pulls all the -Template instances out of the data base until it
  144. %   hits the - marker, and puts them on the front of the accumulator
  145. %   SoFar.  This routine is used by findall/3-4 and by bag_of when
  146. %   the Generator has no free variables.
  147.  
  148. list_instances(SoFar, Total) :-
  149.         retract( 's s'( Term ) ),
  150.         !,          %   must not backtrack
  151.         list_instances(Term, SoFar, Total).
  152.  
  153.  
  154. list_instances(-, SoFar, Total) :- !,
  155.         Total = SoFar.          %   = delayed in case Total was bound
  156. list_instances(-Template, SoFar, Total) :-
  157.         list_instances([Template|SoFar], Total).
  158.  
  159.  
  160.  
  161. %   list_instances(Key, NVars, BagIn, BagOut)
  162. %   pulls all the Key-Template instances out of the data base until
  163. %   it hits the - marker.  The Generator should not touch recordx(.,_,_).
  164. %   Note that asserting something into the data base and pulling it out
  165. %   again renames all the variables; to counteract this we use replace_
  166. %   key_variables to put the old variables back.  Fortunately if we
  167. %   bind X=Y, the newer variable will be bound to the older, and the
  168. %   original key variables are guaranteed to be older than the new ones.
  169. %   This replacement must be done @i<before> the keysort.
  170.  
  171. list_instances(Key, NVars, OldBag, NewBag) :-
  172.         retract( 's s'( Term ) ), 
  173.         !,          %  must not backtrack!
  174.         list_instances(Term, Key, NVars, OldBag, NewBag).
  175.  
  176.  
  177.         list_instances(-, _, _, AnsBag, AnsBag) :- !.
  178.         list_instances(NewKey-Term, Key, NVars, OldBag, NewBag) :-
  179.                 replace_key_variables(NVars, Key, NewKey), !,
  180.                 list_instances(Key, NVars, [NewKey-Term|OldBag], NewBag).
  181.  
  182.  
  183.  
  184. %   There is a bug in the compiled version of arg in Dec-10 Prolog,
  185. %   hence the rather strange code.  Only two calls on arg are needed
  186. %   in Dec-10 interpreted Prolog or C-Prolog.
  187.  
  188. replace_key_variables(0, _, _) :- !.
  189. replace_key_variables(N, OldKey, NewKey) :-
  190.         arg(N, NewKey, Arg),
  191.         nonvar(Arg), !,
  192.         M is N-1,
  193.         replace_key_variables(M, OldKey, NewKey).
  194. replace_key_variables(N, OldKey, NewKey) :-
  195.         arg(N, OldKey, OldVar),
  196.         arg(N, NewKey, OldVar),
  197.         M is N-1,
  198.         replace_key_variables(M, OldKey, NewKey).
  199.  
  200.  
  201.  
  202. %   concordant_subset([Key-Val list], Key, [Val list]).
  203. %   takes a list of Key-Val pairs which has been keysorted to bring
  204. %   all the identical keys together, and enumerates each different
  205. %   Key and the corresponding lists of values.
  206.  
  207. concordant_subset([Key-Val|Rest], Clavis, Answer) :-
  208.         concordant_subset(Rest, Key, List, More),
  209.         concordant_subset(More, Key, [Val|List], Clavis, Answer).
  210.  
  211.  
  212. %   concordant_subset(Rest, Key, List, More)
  213. %   strips off all the Key-Val pairs from the from of Rest,
  214. %   putting the Val elements into List, and returning the
  215. %   left-over pairs, if any, as More.
  216.  
  217. concordant_subset([Key-Val|Rest], Clavis, [Val|List], More) :-
  218.         Key == Clavis,
  219.         !,
  220.         concordant_subset(Rest, Clavis, List, More).
  221. concordant_subset(More, _, [], More).
  222.  
  223.  
  224. %   concordant_subset/5 tries the current subset, and if that
  225. %   doesn't work if backs up and tries the next subset.  The
  226. %   first clause is there to save a choice point when this is
  227. %   the last possible subset.
  228.  
  229. concordant_subset([],   Key, Subset, Key, Subset) :- !.
  230. concordant_subset(_,    Key, Subset, Key, Subset).
  231. concordant_subset(More, _,   _,   Clavis, Answer) :-
  232.         concordant_subset(More, Clavis, Answer).
  233.  
  234.  
  235. %   In order to handle variables properly, we have to find all the 
  236. %   universally quantified variables in the Generator.  All variables
  237. %   as yet unbound are universally quantified, unless
  238. %       a)  they occur in the template
  239. %       b)  they are bound by X^P, setof, or bagof
  240. %   free_variables(Generator, Template, OldList, NewList)
  241. %   finds this set, using OldList as an accumulator.
  242.  
  243. free_variables(Term, Bound, VarList, [Term|VarList]) :-
  244.         var(Term),
  245.         term_is_free_of(Bound, Term),
  246.         list_is_free_of(VarList, Term),
  247.         !.
  248. free_variables(Term, Bound, VarList, VarList) :-
  249.         var(Term),
  250.         !.
  251. free_variables(Term, Bound, OldList, NewList) :-
  252.         explicit_binding(Term, Bound, NewTerm, NewBound),
  253.         !,
  254.         free_variables(NewTerm, NewBound, OldList, NewList).
  255. free_variables(Term, Bound, OldList, NewList) :-
  256.         functor(Term, _, N),
  257.         free_variables(N, Term, Bound, OldList, NewList).
  258.  
  259. free_variables(0, Term, Bound, VarList, VarList) :- !.
  260. free_variables(N, Term, Bound, OldList, NewList) :-
  261.         arg(N, Term, Argument),
  262.         free_variables(Argument, Bound, OldList, MidList),
  263.         M is N-1, !,
  264.         free_variables(M, Term, Bound, MidList, NewList).
  265.  
  266. %   explicit_binding checks for goals known to existentially quantify
  267. %   one or more variables.  In particular \+ is quite common.
  268.  
  269. explicit_binding(\+ Goal,              Bound, fail,     Bound      ) :- !.
  270. explicit_binding(not(Goal),            Bound, fail,     Bound      ) :- !.
  271. explicit_binding(Var^Goal,             Bound, Goal,     Bound+Var) :- !.
  272. explicit_binding(findall(Var,Goal,Set),  Bound, Goal-Set, Bound+Var) :- !.
  273. explicit_binding(findset(Var,Goal,Bag),  Bound, Goal-Bag, Bound+Var) :- !.
  274. explicit_binding(set_of(Var,Goal,Set), Bound, Goal-Set, Bound+Var) :- !.
  275. explicit_binding(bag_of(Var,Goal,Bag), Bound, Goal-Bag, Bound+Var) :- !.
  276.  
  277.  
  278. term_is_free_of(Term, Var) :-
  279.         var(Term), !,
  280.         Term \== Var.
  281. term_is_free_of(Term, Var) :-
  282.         functor(Term, _, N),
  283.         term_is_free_of(N, Term, Var).
  284.  
  285. term_is_free_of(0, Term, Var) :- !.
  286. term_is_free_of(N, Term, Var) :-
  287.         arg(N, Term, Argument),
  288.         term_is_free_of(Argument, Var),
  289.         M is N-1, !,
  290.         term_is_free_of(M, Term, Var).
  291.  
  292.  
  293. list_is_free_of([Head|Tail], Var) :-
  294.         Head \== Var,
  295.         !,
  296.         list_is_free_of(Tail, Var).
  297. list_is_free_of([], _).
  298.  
  299. %   File   : SORTS.PL
  300. %   Author : R.A.O'Keefe
  301. %   Updated: 23 July 1984 and by KJ 11-8-87
  302. %   Purpose: Specify generalised sorting routines.
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309. ksort(  [], [], _,_).
  310. ksort( [X], [X], _,_ ).
  311. ksort( [X,Y|L], Sorted, Key, Order ) :-
  312.         halve(L, [Y|L], Front, Back),
  313.         ksort( [X|Front], F, Key, Order) ,
  314.         ksort( Back, B, Key, Order ),
  315.         merge( F, B, Sorted, Key, Order).
  316.  
  317.  
  318. halve([_,_|Count], [H|T], [H|F], B) :- !,
  319.         halve(Count, T, F, B).
  320. halve(_, B, [], B).
  321.  
  322.  
  323. merge( [H1|T1], [H2|T2], [Hm|Tm], Key, Order) :- !,
  324.         compare( Key, H1, H2, R ),
  325.         (   R=(<), !, Hm = H1, merge( T1, [H2|T2], Tm, Key, Order)
  326.         ;   R=(>), !,  Hm = H2, merge( [H1|T1], T2, Tm, Key, Order)
  327.         ;   Order=(<=), !,  Hm = H2, merge( [H1|T1], T2, Tm, Key , Order)
  328.         ;   !, Hm = H1, merge( T1, T2, Tm, Key, Order)
  329.         ).
  330. merge( [], L, L , _, _) :- !.
  331. merge( L, [], L, _, _).
  332.  
  333.  
  334.  
  335. compare(0, X, Y, R ) :- 
  336.         ( X @< Y, !, R=(<) ) ;
  337.         ( Y @< X, !, R=(>) ) ;
  338.         R=(=).
  339.     
  340. compare(N, X, Y, R) :-
  341.         arg(N, X, Xn),
  342.         arg(N, Y, Yn),
  343.         ( Xn @< Yn, !, R=(<) ) ;
  344.         ( Yn @< Xn, !, R=(>) ) ;
  345.         R=(=).
  346.         
  347.  
  348.  
  349. keyksort(R, S) :-
  350.         ksort( R, S, 1, =< ).
  351.  
  352.  
  353. mksort(R, S) :-
  354.         ksort( R, S, 0, =<).
  355.  
  356.  
  357. ksort(R, S) :-
  358.         ksort( R, S, 0, <).
  359.  
  360.  
  361. merge(A, B, M) :-
  362.         merge( A, B, M, 0, =<).
  363.  
  364.  
  365.  
  366.