🚀 go-pugleaf

PROLOG Digest             Monday, 1 Dec 1986       Volume 4 : Issue 80

Today's Topics:
                     LP Library - Utility Update
----------------------------------------------------------------------

Date: 25 Nov 86 07:06:00 EST
From: John Cugini <cugini@nbs-vms.ARPA>
Subject: update of utility library

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%%     NBS/ICST Prolog Utility Library
%%     version date: Nov. 25, 1986
%%
%%     developed by:
%%
%%     John Cugini <cugini@nbs-vms.arpa>
%%     Institute for Computer Sciences and Technology
%%     National Bureau of Standards
%%
%%     Product of US Government: not subject to copyright
%%
%%  This file contains various utility predicates, some commonly used,
%%  some not.  They deal with lists, structures, I/O, sets, numeric
%%  facilities, and some extensions of logic and control.  This library
%%  is written in and for the C-Prolog dialect of Prolog.
%%
%%  Many of these predicates expect certain of their arguments to be
%%  instantiated upon invocation.  When such restrictions apply it is
%%  usually the leading arguments which are thought of as input (and
%%  hence instantiated), and the trailing arguments as output (and hence
%%  allowed to be uninstantiated).
%%
%%  There is a coding convention: the user-callable version of the
%%  predicate has a plain name.  If this predicate needs sub-predicates,
%%  based on whether certain arguments are instantiated or not, the names
%%  of the sub-predicates are formed by appending a string of c,v, or
%%  x's, where c indicates argument must be constant (instantiated), v
%%  that it must be a variable, and x that it may be either.
%%
%%  Further, each main predicate is preceded by documentation lines,
%%  which describe the declarative meaning of the predicate, and which
%%  arguments must be instantiated.
%%
%%  The overall organization of the library is:
%%
%%      Basic predicates
%%      Lists
%%      Structures
%%      Input/Output
%%      Sets
%%      Numeric
%%      Control
%%      Extended Logic
%%
%%  Each section is prefaced by a header with lots of asterisks

%%  ************ Basic Predicates *************

%%  The following predicates test the type of the term passed
%%  to them, using the terminology of the C-Prolog manual.

term(Term).
simple(Term)   :- atomic(Term); var(Term).
compound(Term) :- not(simple(Term)).
literal(Term)  :- nonvar(Term),
                  functor(Term, Name, _),
                  atom(Name).
float(Term)    :- number(Term), not(integer(Term)).
rational(Term) :- integer(Term); ratio(Term).
ratio(Num/Den) :- integer(Num), integer(Den).

%%  constant_term(Term) iff Term is currently instantiated and all
%%  of its arguments, sub-arguments, etc. are constant.

constant_term(Term) :-
  atomic(Term) -> true;
                  (nonvar(Term),
                   Term =.. [Functor | Args],
                   all(constant_term, Args)).

%%  instantiation(Term, Type) iff Type describes the instantiation state
%%  of Term: constant (completely ground), partial, or var.

instantiation(Term, Type) :-
  var(Term)           -> Type = var;
  constant_term(Term) -> Type = constant;
                         Type = partial.

%%  ************* Lists **************

%%  islist(X) iff X is a list.  (Really just checks for [] or that
%%  main functor is '.').

islist([]) :- !.
islist([_|_]).

%%  is_real_list(X) iff X is a properly formed list.  Does not allow
%%  "dotted" lists, a la [a|b], as does islist.

is_real_list([]) :- !.
is_real_list([_ | Rest]) :- is_real_list(Rest).

%%  non_null_list(List) iff List is a real list containing at least
%%  one element.

non_null_list([_ | Rest]) :- is_real_list(Rest).

%%  member(Elem, List) iff Elem is a member of List.

member(Elem, [Elem | _]).
member(Elem, [_ | Rest_of_list]) :- member(Elem, Rest_of_list).

%%  member_rest(Elem, List, Rest) iff Elem is a member of List and
%%  Rest is the rest of the list following Elem.

member_rest(Elem, [Elem | Rest], Rest).
member_rest(Elem, [_ | Rest], Rest_rest) :-
  member_rest(Elem, Rest, Rest_rest).

%%  append(First_part, Second_part, List) iff List is the
%%  concatenation of the first two arguments.

append([], List, List).
append([Elem | First_part], Second_part, [Elem | List]) :-
  append(First_part, Second_part, List).

%%  append_n(L1, L2) iff L1 is a list of lists, which, if concatenated,
%%  is L2.  When L1 is var, no null lists are generated for it, even
%%  though logically they could appear anywhere.  Thus, this isn't
%%  symmetric, in that L1=[[],[1]] will generate L2=[1], but not
%%  vice-versa.  Note especially that L1=[[]] will generate L2=[], but
%%  not the reverse.  L1 and L2 can be partially instantiated, and this
%%  usually works.  NG if both args are var.

%% avoid generating the null list in arg1.

append_n([List1], List2) :-
  not((var(List1), List2 == [])),
  List1=List2.

append_n([SL1, SL2 | Rest], List) :-
  (var(SL1) -> V=t; V=f),
  append(SL1, Right_part, List),
  not((V=t, SL1=[])),
  append_n([SL2 | Rest], Right_part).

%%  delete(Elem, Old_list, New_list) iff New_list equals Old_list except
%%  for the removal of all occurrences of Elem.  NG if arg2 is var.

delete(Elem, Old, New) :-
   (var(Elem) -> (remove_dupl(Old, Smaller_old),
                  member(Elem, Smaller_old)
                 );
                  Elem=X        %  dummy statement to fill else-part
   ),
   delete_c(Elem, Old, New).

delete_c(_, [], []).
delete_c(Elem1, [Elem2 | Rest_of_old], New_list) :-
   Elem1 = Elem2 -> (delete_c(Elem1, Rest_of_old, New_list)
                    );
                    (New_list = [Elem2 | Rest_of_new],
                     delete_c(Elem1, Rest_of_old, Rest_of_new)
                    ).

%%  delete_all(Del_list, Old_list, New_list) iff New_list equals Old_list
%%  except for the removal of any occurrences of any elements of Del_list.
%%  NG if arg1 or 2 is var.

delete_all([], L, L).
delete_all([E | R_del], Old_list, New_list) :-
   delete(E, Old_list, M),
   delete_all(R_del, M, New_list).

%%  remove_dupl(List, Shriven_list) iff Shriven_list equals List
%%  in same order, sans leading duplicate members.  Ie, only the
%%  rightmost of duplicate members remain.  NG if arg1 is var.

remove_dupl([],[]).
remove_dupl([Elem | Rest_list], Rest_shriven) :-
  member(Elem, Rest_list),
  !,
  remove_dupl(Rest_list, Rest_shriven).
remove_dupl([Elem | Rest_list], [Elem | Rest_shriven]) :-
  remove_dupl(Rest_list, Rest_shriven).

%%  no_dupls(List) iff List is a list with no duplicate elements.
%%  NG if arg1 is var.

no_dupls([]).
no_dupls([Elem | Rest]) :-
   not(member(Elem, Rest)),
   no_dupls(Rest).

%% ordered(List) iff List is a list whose elements are in non-
%% decreasing order.  NG if List is var.

ordered([]).
ordered([Elem]).
ordered([Elem1, Elem2 | Rest]) :-
  Elem1 @=< Elem2,
  !,
  ordered([Elem2 | Rest]).

%%  last(Elem, List) iff Elem is the last element in List.

last(Elem, [Elem]).
last(Elem, [_ | Rest]) :- last(Elem, Rest).

%%  next_to(X,Y,L) iff X and Y are adjacent in list L.

next_to(X, Y, [X,Y | _]).
next_to(X, Y, [_ | Rest]) :- next_to(X, Y, Rest).

%%  reverse(List1, List2) iff List1 is List2 in reverse order.
%%  NG if arg1 is var.

reverse([], []) :- !.
reverse([Head | Tail], List) :-
  reverse(Tail, Liat), append(Liat, [Head], List).

%%  efface(Elem, Old_list, New_list) iff New_list = Old_list
%%  with first occurrence of Elem removed.  NG if more than
%%  one arg is var.

efface(Elem, [Elem | Rest], Rest) :- !.
efface(Elem, [Non_elem | Old_rest], [Non_elem | New_rest]) :-
  not(Elem = Non_elem),
  efface(Elem, Old_rest, New_rest).

%%  insert(Elem, List, Bigger_list) iff Bigger_list = List plus
%%  Elem inserted somewhere.  NG if all args are var.

insert(Elem, List, [Elem | List]).
insert(Elem, [Non_elem | List], [Non_elem | Bigger_list]) :-
   insert(Elem, List, Bigger_list).

%%  subst(Old_elem, Old_list, New_elem, New_list) iff New_list equals
%%  Old_list except for the substitution of New_elem for any
%%  occurrences of Old_elem.  NG for arg1;2;3 var.

subst(_, [], _, []).
subst(Old_elem, [Old_elem | Rest_of_old],
      New_elem, [New_elem | Rest_of_new]) :-
         !, subst(Old_elem, Rest_of_old, New_elem, Rest_of_new).
subst(Old_elem, [Non_elem | Rest_of_old],
      New_elem, [Non_elem | Rest_of_new]) :-
            subst(Old_elem, Rest_of_old, New_elem, Rest_of_new).

%%  prefix(Part, Whole) iff Part is a leading substring of Whole.

prefix([], _).
prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :-
  prefix(Rest_of_part, Rest_of_whole).

%%  suffix(Part, Whole) iff Part is a trailing substring of Whole.

suffix(List, List) :- islist(List).
suffix(Part, [Elem | Rest_of_whole]) :- suffix(Part, Rest_of_whole).

%%  trim(List, Elem, Ans) iff Ans is List with all leading and
%%  trailing occurrences of Elem removed.  NG if arg1 or arg2
%%  is var.

trim(List, Elem, Ans) :-
  trim_left(List, Elem, Temp),
  trim_right(Temp, Elem, Ans).

%%  trim_left(List, Elem, Ans) iff Ans is List with all leading
%%  occurrences of Elem removed.  NG if arg1 or arg2 is var.

trim_left([Elem | Rest], Elem, Ans) :-
  trim_left(Rest, Elem, Ans), !.
trim_left(List, _, List).

%%  trim_right(List, Elem, Ans) iff Ans is List with all trailing
%%  occurrences of Elem removed.  NG if arg1 or arg2 is var.

trim_right([],  _, [])  :- !.
trim_right([Elem | Rest], Elem, []) :-
  trim_right(Rest, Elem, []), !.
trim_right([Arb | Rest], Elem, [Arb | Rest_Trim]) :-
  trim_right(Rest, Elem, Rest_Trim).

%%  sublist(List, Start, End, Sublist) iff Sublist is a contiguous
%%  sub-list within List, starting at position Start, and ending at
%%  position End.  Note that [] is a valid sublist, so for
%%  List = [1,2], valid solutions are:
%%
%%         Start  End   Sublist
%%         1      0     []
%%         1      1     [1]
%%         1      2     [1,2]
%%         2      1     []
%%         2      2     [2]
%%         3      2     []
%%
%%  NG if arg1 is var.

sublist(List, Start, End, Sublist) :-
  prefix(Sublist, List),
  Start = 1,
  length(Sublist, End).

sublist([Elem | Rest], Start, End, Sublist) :-
  sublist(Rest, Startx, Endx, Sublist),
  Start is Startx + 1,
  End is Endx + 1.

%%   matchlist(List1, List2, Common, New1, New2) iff List1 and
%%   List2 are sorted instantiated lists (possibly with repetitions)
%%   and Common is a list of their matching elements, and New1 and New2
%%   are List1 and List2 minus the matching elements in Common, eg:
%%   matchlist([1,2,3,3,3,4,5,5,6], [3,3,4,4,5,5], [3,3,4,5,5],
%%             [1,2,3,6],           [4]) is true.  NG if Arg1 or Arg2
%%   is var or unsorted.

matchlist([], List2, [], [], List2) :- !.

matchlist([Elem | Rest], [], [], [Elem | Rest], []) :- !.

matchlist([Elem | Rest1], [Elem | Rest2], [Elem | Com_Rest], New1, New2) :-
  matchlist(Rest1, Rest2, Com_Rest, New1, New2), !.

matchlist([El1 | Rest1], [El2 | Rest2], Com, New1, New2) :-
  (El1 @< El2 ->
     (matchlist(Rest1, [El2 | Rest2], Com, New_Rest1, New2),
                       New1 = [El1 | New_Rest1]);
     (matchlist([El1 | Rest1], Rest2, Com, New1, New_Rest2),
                       New2 = [El2 | New_Rest2])
  ),
  !.


%%  list_length(List, Number) iff List has Number elements.
%%  NG if arg1 is var.  Note that, apparently, C-Prolog has an
%%  undocumented evaluable predicate, length(List, Number).

list_length([], 0).
list_length([Elem | Rest], Number) :-
  list_length(Rest, N_minus),
  Number is N_minus + 1.

%%  position(List, Elem, Number) iff Elem is in position Number
%%  in the List.  NG if arg1 is var.

position([Elem | Rest], Elem, 1).
position([_    | Rest], Elem, Number) :-
   var(Number) -> (position(Rest, Elem, N_minus),
                   Number is N_minus + 1);
                  (N_minus is Number - 1,
                   position(Rest, Elem, N_minus),
                   !).

%%  repeat_list(Elem, Number, List) iff List is a list of Elem
%%  repeated Number times.  No var restrictions.

repeat_list(Elem, Number, List) :-
  (nonvar(Number), var(List)) ->
      repeat_list_xcv(Elem, Number, List);
      repeat_list_xxx(Elem, Number, List).

repeat_list_xcv(Elem, 0, []).
repeat_list_xcv(Elem, N, [Elem | Rest]) :-
  N_minus is N - 1,
  !,
  N_minus > -1,
  repeat_list_xcv(Elem, N_minus, Rest).

repeat_list_xxx(Elem, 0, []).
repeat_list_xxx(Elem, N, [Elem | Rest]) :-
  repeat_list_xxx(Elem, N_minus, Rest),
  N is N_minus + 1.

%%  permute(List1, List2) iff List1 is a permutation of List2.
%%  NG if arg1 is var.

permute(Whole, [Elem | Rest_of_part]) :-
     islist(Whole),
     member(Elem, Whole),
     efface(Elem, Whole, Reduced_whole),
     permute(Reduced_whole, Rest_of_part).

permute([], []).

%%  reduce(Bin_op, List, Ans) iff Ans is the result of applying
%%  Bin_op, left-associatively, to the elements of List.   NG if
%%  arg1 or arg2 is var, or if List contains fewer than two
%%  elements. If ID is an identity element for Bin_op, and the List
%%  may contain only one element, invoke with: reduce(Bin_op, [ID |
%%  List], Ans).   To allow a null list to return ID, invoke
%%  with: reduce(Bin_op, [ID, ID | List], Ans).

reduce(Bin_op, [El1, El2 | Rest], Ans) :-
  Callit =.. [Bin_op, El1, El2, Temp],
  Callit,
  (Rest = [] ->
     Ans = Temp;
     reduce(Bin_op, [Temp | Rest], Ans)
  ).

%%  maplist(Pred, Old, New) iff for each corresponding element in
%%  Old and New, Pred(Old, New) is true.  NG if arg1 is var.

maplist(_, [], []).
maplist(Pred, [Elem_old | Rest_of_old], [Elem_new | Rest_of_new]) :-
  Pred_call =.. [Pred, Elem_old, Elem_new],  %  constructs  predicate
  Pred_call,                         %  invokes constructed predicate
  maplist(Pred, Rest_of_old, Rest_of_new).

%%  maplist_2(Pred, L1, L2, L3) iff L1, L2, and L3 are lists of equal length
%%  and for each element (E1, E2, E3) in corresponding positions in the
%%  lists, Pred(E1, E2, E3) is true.  Thus, E3 should be a function of E1
%%  and E2 - if there is more than one solution, only the first will be
%%  used.  NG if arg1 is var.  Whether arg2 or arg3 can be var depends on
%%  the nature of Pred.

maplist_2(_, [], [], []).
maplist_2(Pred, [Elem1 | Rest1], [Elem2 | Rest2], [Elem3 | Rest3]) :-
  Pred_call =.. [Pred, Elem1, Elem2, Elem3],
  Pred_call,
  !,
  maplist_2(Pred, Rest1, Rest2, Rest3).

%%  for_all(Op_list, Pre_list, Post_list) iff a predicate is
%%  successfully invoked for each member of Op_List.  Each
%%  predicate is formed by pre-pending Pre_list to a member
%%  of Op_List, appending Post_list to it, and then forming
%%  the corresponding functor.
%%
%%  Thus, for_all([a,b,c], [wiggle,x], [y]) will invoke:
%%       wiggle(x, a, y)
%%       wiggle(x, b, y)
%%       wiggle(x, c, y).
%%
%%  and for_all([number, atomic], [], [A]) will invoke:
%%       number(A)
%%       atomic(A).

for_all([], _, _).
for_all([Op | Rest_Ops], Pre_list, Post_list) :-
  append(Pre_list, [Op | Post_list], Pred_list),
  Pred =.. Pred_list,
  !,
  Pred,
  for_all(Rest_Ops, Pre_list, Post_list).

%%  maxlist(List, Max) iff Max is the highest value in a List of numbers.
%%  NG if arg1 is var.

maxlist([Elem], Elem).
maxlist([Elem | Rest], Max) :-
   maxlist(Rest, Rmax),
   (Elem > Rmax -> Max = Elem; Max = Rmax).

%%  minlist(List, Min) iff Min is the lowest value in a List of numbers.
%%  NG if arg1 is var.

minlist([Elem], Elem).
minlist([Elem | Rest], Min) :-
   minlist(Rest, Rmin),
   (Elem < Rmin -> Min = Elem; Min = Rmin).

%%  bestlist(List, Pred, Best) iff Best is the best value in a List,
%%  according to some binary predicate Pred(A,B), which succeeds iff
%%  A is better than B.  NG if arg1 or arg2 is var.

bestlist([Elem], _, Elem).
bestlist([Elem | Rest], Pred, Best) :-
   bestlist(Rest, Pred, Rbest),
   Call =.. [Pred, Elem, Rbest],
   (Call -> Best = Elem; Best = Rbest).

%%  all(Pred, List) iff Pred is a single-place predicate true of
%%  all members of the list.  NG if either arg is var.

all(Pred, []) :- atom(Pred).

all(Pred, [Elem | Rest]) :-
  Callit =.. [Pred, Elem],
  Callit,
  all(Pred, Rest).

%%  some(Pred, List) iff Pred is a single-place predicate true of
%%  at least one member of the list.  NG if either arg is var.

some(Pred, List) :- atom(Pred), some_cx(Pred, List).

some_cx(Pred, [Elem | Rest]) :-
  (Callit =.. [Pred, Elem],
   Callit);
  some_cx(Pred, Rest).

%%  notall(Pred, List) iff Pred is a single-place predicate false of
%%  at least one member of the list.  NG if either arg is var.

notall(Pred, List) :- atom(Pred), not(all(Pred,List)).

%%  none(Pred, List) iff Pred is a single-place predicate true of
%%  none of the members of the list.  NG if either arg is var.

none(Pred, List) :- atom(Pred), not(some(Pred,List)).

%%  string_of(Alphabet, String) iff String is a list composed of
%%  elements of the non-redundant non-null Alphabet.
%%  NG if both args are var.

string_of(Alphabet, String) :-
  var(Alphabet) -> remove_dupl(String, Alphabet);
                   (Alphabet = [_|_],       %  ie non-null
                    no_dupls(Alphabet),
                    string_of_cv(Alphabet, String)
                   ).

string_of_cv(Alphabet, []).
string_of_cv(Alphabet, [Elem | Rest]) :-
  string_of_cv(Alphabet, Rest),
  member(Elem, Alphabet).

%%  sort_all(In_list, Out_list) iff Out_list is a sorting of In_list,
%%  saving duplicates.  The Xing allows the use of keysort, which
%%  doesn't delete duplicates.

sort_all(In, Out) :-
  sort_all_xit(In, Xed_list),
  keysort(Xed_list, Sorted_xed_list),
  sort_all_xit(Out, Sorted_xed_list).

%%  sort_all_xit(List, Xed_list) iff each element of list is matched
%%  by an xed element in Xed_list.

sort_all_xit([],[]).
sort_all_xit([Elem | In_rest], [Elem-x | Out_rest]) :-
  sort_all_xit(In_rest, Out_rest), !.

%%  tot_sort(In_list, Out_list) iff Out_list is a total sorting
%%  of In_list.  This means that not only are the elements of
%%  In_list sorted, but that any of those elements which are lists
%%  are also transformed by sorting, and so on.  Thus:
%%  tot_sort([1,[a3,a2,a3,a1],2,1], [1,2,[a1,a2,a3]]). Recall that
%%  sort eliminates duplicates, and so Out_list might be shorter
%%  than In_list.  Tot_sort can be thought of as providing a
%%  normalized form for multi-level sets.  NG if arg1 is var.

tot_sort(In, Out) :-
  norm_elem(In, Normalized_list),
  sort(Normalized_list, Out).

%%  norm_elem(In, Out) iff Out is the same list as In, except that
%%  any elements of In which are themselves lists, are transformed
%%  by tot_sorting.  NG if arg1 is var.

norm_elem([],[]).
norm_elem([In_elem | In_rest], [Out_elem | Out_rest]) :-
  (islist(In_elem) -> tot_sort(In_elem, Out_elem); In_elem = Out_elem),
  norm_elem(In_rest, Out_rest),
  !.

%%  ordered_merge(List1, List2, List3) iff List3 is the ordered merging
%%  of List1 and List2.  If more than one arg is var, returns only a
%%  single solution.  To find all decompositions of a list into two
%%  lists, use merge.  NG if all args are var.

ordered_merge([], List, List) :-
  islist(List),
  !.

ordered_merge([Elem1 | Rest1], [], [Elem1 | Rest1]) :- !.

ordered_merge([Elem1 | Rest1], [Elem2 | Rest2], [Elem1 | Rest3]) :-
  (var(Elem2) -> true; Elem1 @< Elem2),
  !,
  ordered_merge(Rest1, [Elem2 | Rest2], Rest3).

ordered_merge(List1, [Elem2 | Rest2], [Elem2 | Rest3]) :-
  ordered_merge(List1, Rest2, Rest3).

%%  merge(List1, List2, List3) iff List3 is a random merge of List1 and
%%  List2, ie, order is preserved within List1 and List2 but not between
%%  them.  This is like a combination: pick 2 of 5.  Eg, for
%%  List1=[1,2,3], and List2=[a,b], List3 can be [1,2,a,3,b],
%%  [a,1,2,b,3],... NG if List3 and (List1 or List2) are var.

merge([], List, List) :- islist(List).

merge([Elem | Rest], [], [Elem | Rest]).

%  pick from List1
merge([Elem1 | Rest1], [Elem2 | Rest2], [Elem1 | Rest3]) :-
  merge(Rest1, [Elem2 | Rest2], Rest3).

%  pick from List2
merge([Elem1 | Rest1], [Elem2 | Rest2], [Elem2 | Rest3]) :-
  merge([Elem1 | Rest1], Rest2, Rest3).

%%  ***************** Structures ****************

%%  full_name(Term, Name) iff Name is the name of Term, which may be
%%  atomic or compound.  NG if both args are var.

full_name(Term, Name) :-
  atomic(Term),
  !,
  name(Term, Name).

full_name(Term, Name) :-
  var(Term),
  telling(Cur_output),
  tell('x.x'),
  print_string(Name),
  print_string("."),
  told,
  tell(Cur_output),
  seeing(Cur_input),
  see('x.x'),
  read(Term),
  seen,
  !,
  see(Cur_input).

full_name(Term, Name) :-
  Term =.. [Functor, Arg1 | Arglist],
  name(Functor, Func_name),
  full_name(Arg1, Arg1_name),
  full_name_list(Arglist, Arglist_name),
  append_n([Func_name, "(", Arg1_name, Arglist_name, ")"], Name).

full_name_list([], []) :- !.
full_name_list([Arg1 | Arg_rest], Arglist_name) :-
  full_name(Arg1, Arg1_name),
  full_name_list(Arg_rest, Arg_rest_name),
  append_n([",", Arg1_name, Arg_rest_name], Arglist_name).

%%   tree_position(Term, Subterm, Location) iff Term is a
%%   non-variable containing Subterm, at the Location, which
%%   is a list of numbers corresponding to position, eg, for
%%   Term = a(b,c,d(e,f),g), the solutions are:
%%
%%    Subterm             Location
%%    -------             --------
%%    a(b,c,d(e,f),b)     []
%%    b                   [1]
%%    c                   [2]
%%    d(e,f)              [3]
%%    e                   [3,1]
%%    f                   [3,2]
%%    g                   [4]

tree_position(Term, Sub, []) :-
  nonvar(Term),
  Term = Sub.
tree_position(Term, Sub, [Number | Sub_pos]) :-
  Term =.. [Func | Args],
  position(Args, Elem, Number),
  tree_position(Elem, Sub, Sub_pos).

%%  contains(Term, Sub) iff Term is a non-variable containing Sub,
%%  either immediately or indirectly.  NG if arg1 is var.

contains(Term, Sub) :-
  nonvar(Term),
  Term = Sub.
contains(Term, Sub) :-
  Term =.. [Func | Args],
  member(Elem, Args),
  contains(Elem, Sub).

%%  compound_contains(Term, Tester, Count) iff Count is the number of
%%  terms, compound or atomic, within Term for which Tester is true.
%%  Tester is either the name of a unary predicate, or a list of predicate
%%  name, followed by arguments.

compound_contains(Term, Tester, Count) :-
  (Tester = [Pred | Args] -> true;
                             (Pred = Tester, Args = [])),
  Test =.. [Pred, Term | Args],
  !,
  (Test -> N=1; N=0),
  (simple(Term) -> Count = N;
                   (Term =.. [Functor | Arglist],
                    compound_contains_list(Arglist, Pred, Args, Subcount),
                    Count is Subcount + N)).

compound_contains_list([], _, _, 0).
compound_contains_list([Elem | Rest], Pred, Args, Subcount) :-
  compound_contains(Elem, [Pred | Args], Elemcount),
  compound_contains_list(Rest, Pred, Args, Restcount),
  Subcount is Elemcount + Restcount.

%%  atomic_contains(Term, Tester, Count) iff Count is the number of
%%  atomic terms or vars within Term for which Tester is true.  Tester is
%%  either the name of a unary predicate, or a list of predicate
%%  name, followed by arguments.

atomic_contains(Term, Tester, Count) :-
  (Tester = [Pred | Args] -> true;
                             (Pred = Tester, Args = [])),
  !,
  (simple(Term) -> (Test =.. [Pred, Term | Args],
                      (Test -> Count=1; Count=0)
                   );
                   (Term =.. Termlist,
                    atomic_contains_list(Termlist, Pred, Args, Count)
                   )).

atomic_contains_list([], _, _, 0).
atomic_contains_list([Elem | Rest], Pred, Args, Count) :-
  atomic_contains(Elem, [Pred | Args], Elemcount),
  atomic_contains_list(Rest, Pred, Args, Restcount),
  Count is Elemcount + Restcount.

%%  ************* Input and Output *************

%%  readline(List) iff user enters characters of list, followed
%%  by a carriage return (whose ASCII code is 10, under VMS).

readline(List) :-
  get0(Char),
  (Char=10 -> List = [];
     (Char=26 -> List = end_of_file;
                (List = [Char | Rest], readline(Rest))
  )  ).

%%   user_pick(List, Selection) iff Selection is a member of the list
%%   chosen by the user.  NG if arg1 is var.

user_pick(List, Selection) :-
  List = [E | R],
  nl, print('Select one of the following: '),
  user_pick_1(List, 1),
  nl,
  print('Enter the number of your preferred entry, '),
  print('terminated by a period.'),
  nl,
  print('Anything besides a valid number will select none of the above.'),
  nl,
  read(Num),
  !,
  integer(Num),
  position(List, Selection, Num).

user_pick_1([], _).
user_pick_1([Elem | Rest], N) :-
  nl, print('  '),
  (N < 10 -> print(' '); true),
  print(N),
  print(' - '),
  print(Elem),
  N1 is N+1,
  user_pick_1(Rest, N1).

%%  user_yes_no(Prompt) iff the user responds affirmatively to the Prompt.
%%  The Prompt should be a yes or no type question, suitable for printing,
%%  user_yes_no('Do you wish to continue?').  The current input stream
%%  is assumed to be set correctly.

user_yes_no(Prompt) :-
  nl, print(Prompt),
  print('  (respond with "y." or "n.")'), nl,
  read(Ans),
  !,
  (Ans = y -> true;
    (Ans = n -> (!,fail);
      (user_yes_no(Prompt)
  ) ) ).

%%  print_string(S) succeeds if S is a list of printable integers, and
%%  it prints the string as a side-effect to the current output stream.

print_string([]).
print_string([Elem | Rest]) :-
  integer(Elem),
  Elem > 31,
  Elem < 127,
  put(Elem),
  print_string(Rest).

%%  tree_print(Term) prints term in tree-fashion, indented by two.

tree_print(Term) :-
  nl,
  tree_print_sub(Term,0,'  ').

tree_print_sub(Term, Depth, Prefix) :-
  print_prefix(Depth, Prefix),
  (var(Term) -> (Name = Term, Arglist = []);
                Term =.. [Name | Arglist]),
  print(Name), nl,
  Depth_plus is Depth+1,
  print_args(Arglist, Depth_plus, Prefix).

print_prefix(0,_).
print_prefix(Depth, Prefix) :-
  Depth > 0,
  print(Prefix),
  Depth_minus is Depth-1,
  print_prefix(Depth_minus, Prefix).

print_args([],             Depth, _).
print_args([First | Rest], Depth, Prefix) :-
  tree_print_sub(First, Depth, Prefix),
  print_args(Rest, Depth, Prefix).

%%  tree_list_print(Term) prints Term just like tree_print, except that
%%  it keeps lists flat (at the same level), rather than indenting.
%%  Further it uses '[' and ']' to delimit the lists instead of the
%%  true internal functor '.'.

tree_list_print(Term) :-
  nl,
  tree_list_print_sub(Term,0,'  ').

tree_list_print_sub(Term, Depth, Prefix) :-
  print_prefix(Depth, Prefix),
  (var(Term) -> (Name = Term, Arglist = []);
     (non_null_list(Term) ->
         (Name = '[', Term = Arglist);
         Term =.. [Name | Arglist]
  )  ),
  print(Name), nl,
  D_plus is Depth+1,
  list_print_args(Arglist, D_plus, Prefix),
  (Name == '[' -> (print_prefix(Depth, Prefix), print(']'), nl); true).

list_print_args([],             Depth, _).
list_print_args([First | Rest], Depth, Prefix) :-
  tree_list_print_sub(First, Depth, Prefix),
  list_print_args(Rest, Depth, Prefix).

%%  *************** Sets ****************

%%  Following predicates treat lists as sets.  Note that only
%%  outer brackets are interpreted as set-constructors.  Any inner
%%  nested brackets are interpreted as ordered lists - thus these
%%  sets are "flat"; they do not contain other sets.  Eg, the
%%  set: [a,b,[1,2,1]] has a list as its 3rd element and is
%%  distinct from: [a,b,[2,1]], but *not* from [b,b,[1,2,1],a,a],
%%  since duplication and order at the highest (set) level are
%%  insignificant.
%%
%%  To treat lists as multi-level sets, perform tot_sort on them, eg
%%  both [a,b,[1,2,1]] and [a,b,[2,1]] map to: [a,b,[1,2]], which
%%  may be thought of as a normalized form for multi-level sets.
%%
%%  Thus, the only easy choice is to treat all inner brackets as
%%  list-constructors (default) or as set-constructors (using
%%  tot_sort).  To explicitly distinguish and therefore allow
%%  both kinds, a structure must be set up, something like:
%%  set(List) to be interpreted as a set.  Then, eg:
%%
%%  set([1,2,[d,d,c,a]])      : 3rd element is list
%%
%%  set([1,2,set([d,d,c,a])]) : 3rd element is set
%%
%%  [1,2,1]                   : (ordered) list of 3 integers
%%
%%  set([1,2,1])              : (unordered) set of 2 integers (= set([1,2]))
%%
%%  Set structure would accept unordered/duplicate elements, but
%%  assume their insignificance.  Conversion predicate might be:
%%
%%  set_list(Set, List) :- Set =.. [set, List], is_real_list(List).

%%  subset(Part, Whole) iff Part is an subset of Whole.
%%  NG if both args are var.

subset(Part, Whole) :-
  var(Whole) -> (var(Part) -> fail;
                              subset_cv(Part, Whole)
                );
                (remove_dupl(Whole, Shorn_whole),
                 (var(Part) -> subset_vc(Part, Shorn_whole);
                               subset_cc(Part, Shorn_whole))
                ).

subset_vc([Elem | Rest_part], [Elem | Rest_whole]) :-
  subset_vc(Rest_part, Rest_whole).
subset_vc(        Rest_part,  [Elem | Rest_whole]) :-
  subset_vc(Rest_part, Rest_whole).
subset_vc([],[]).

subset_cv(Part, Whole) :- remove_dupl(Part, Whole).

subset_cc([], Whole) :- islist(Whole).
subset_cc([Elem | Rest_of_part], Whole) :-
  member(Elem, Whole),
  subset_cc(Rest_of_part, Whole).

%%  intersection(S1, S2, Ans) iff Ans is the intersection of S1 and S2.
%%  NG if arg1;2 is var.

intersection(S1, S2, Ans) :-
   remove_dupl(S1, Better_S1),
   (var(Ans) -> intersection_1(Better_S1, S2, Ans);
                intersection_2(Better_S1, S2, Ans)
   ).

intersection_1([], S2, []).
intersection_1([E | R1], S2, Ans) :-
   member(E, S2) -> (Ans = [E | RA],
                     intersection_1(R1, S2, RA)
                    );
                     intersection_1(R1, S2, Ans).

intersection_2(S1, S2, Ans) :-
   intersection_1(S1, S2, X),
   set_equal(X, Ans).

%%  union(S1, S2, Ans) iff Ans is the union of S1 and S2.
%%  NG if arg1;2 is var.

union(S1, S2, Ans) :-
   var(Ans) -> union_1(S1, S2, Ans);
               union_2(S1, S2, Ans).

union_1(S1, S2, Ans)  :- append(S1, S2, X),
                         remove_dupl(X, Ans).

union_2(S1, S2, Ans) :- union_1(S1, S2, X),
                        set_equal(X, Ans).

%%  set_diff(S1, S2, Ans) iff Ans is the set difference S1 - S2.
%%  NG if arg1;2 is var.

set_diff(S1, S2, Ans) :-
   remove_dupl(S1, Better_S1),
   (var(Ans) -> set_diff_1(Better_S1, S2, Ans);
                set_diff_2(Better_S1, S2, Ans)
   ).

set_diff_1(S1, S2, Ans) :- delete_all(S2, S1, Ans).

set_diff_2(S1, S2, Ans) :- set_diff_1(S1, S2, X),
                           set_equal(X, Ans).

%%  set_equal(A,B) iff A and B contain the same elements (set equality).

set_equal(A, B) :-
  nonvar(A), nonvar(B), set_equal_cc(A, B);
     var(A),    var(B), A = B;
     var(A), nonvar(B), remove_dupl(B, A);
  nonvar(A),    var(B), remove_dupl(A, B).

set_equal_cc(A, B) :- subset(A,B), subset(B,A).

%%   disjoint(A,B) iff A and B have no common element.
%%   NG if arg1;2 is var.

disjoint(A,B) :- not(joint(A,B)).

%%   joint(A,B) iff A and B have at least one common element.
%%   NG if arg1;2 is var.

joint(A,B) :- member(E,A), member(E,B).

%%  set_plus(S1, S2, Both) iff S1 and S2 are disjoint, and their
%%  union equals Both.  NG if Both and (S1 or S2) are var.

set_plus(S1, S2, Both) :-
  nonvar(S1) -> (nonvar(S2) -> set_plus_ccx(S1, S2, Both);
                               set_plus_vxc(S2, S1, Both)
                );
                set_plus_vxc(S1, S2, Both).

set_plus_ccx(S1, S2, Both) :- disjoint(S1, S2), union(S1, S2, Both).

set_plus_vxc(S1, S2, Both) :-
  nonvar(Both),
  subset(S2, Both),
  set_diff(Both, S2, S1).

%%  powerset(Set, Power) iff Power is the power set of Set, ie, a list
%%  of all subsets of Set.  NG if arg1 is var.

powerset(Set, Power) :-
  remove_dupl(Set, Shrunk_set),
  powerset_xx(Shrunk_set, Power).

powerset_xx([], [[]]).
powerset_xx([Elem | Rest], Power) :-
  powerset_xx(Rest, Sub_Power),
  double_list(Elem, Sub_Power, Power).

double_list(New_elem, [Single], [Single, [New_elem | Single]]) :- !.
double_list(New_elem, [Elem | Rest], [Elem, [New_elem | Elem] | List]) :-
  double_list(New_elem, Rest, List).

%%  Here's an alternative version of powerset, perhaps a bit less
%%  efficient, but easier to understand.  It is deliberately
%%  commented out, so as not to conflict with the above.
%%  NG if arg1 is var.
%%
%%  powerset(Set, Power) :- setof(Sub, subset(Sub, Set), Power).

%%  partition(S1, S2) iff S2 is a partition of S1, ie S2 is a set of
%%  non-null pairwise disjoint sets, whose union = S1.
%%  NG if both args are var.

partition(S1, S2) :-
  nonvar(S1), nonvar(S2),        partition_cc(S1,      S2);
     var(S1), nonvar(S2),        partition_vc(S1,      S2);
  nonvar(S1),    var(S2),
       remove_dupl(S1, Slim_S1), partition_cv(Slim_S1, S2).

partition_vc(S1, S2) :-
  not(member([], S2)),      %  partition members must be non-null
  append_n(S2, S1),         %  take all elements of all members
  no_dupls(S1).             %  ensure pairwise disjoint

partition_cc(S1, S2) :-
  partition_vc(Test, S2),
  set_equal(Test, S1).

partition_cv([Elem], [[Elem]]).
partition_cv([Elem | Rest], S2) :-
  partition_cv(Rest, Sub_S2),      %  take a partition of set minus elem
  ( S2 = [[Elem] | Sub_S2];        %  either add a new singleton member
                                   %  containing elem
    (insert(Sub_S2_Elem, Sub_S2_Less_1, Sub_S2),
                                   %  or take one of the old members
     S2 = [[Elem | Sub_S2_Elem] | Sub_S2_Less_1]
    )                              %  and add elem to it
  ).

%%  closure2(List1, Pred2, List2) iff List2 is the closure of List1
%%  according to the binary predicate Pred2, for which the first
%%  operand is the "old" element and the second is the "new" or
%%  generated element.  NG if arg1 or arg2 is var.

closure2(List1, Pred2, List2) :-
  sort(List1, Sorted_list1),
  (setof(Arg2, Arg1^Test^(member(Arg1, Sorted_list1),
                          Test =.. [Pred2, Arg1, Arg2],
                          Test),
         New_list)
    ->
     (append(Sorted_list1, New_list, Combined_list),
      sort(Combined_list, Sorted_combined_list),
      (Sorted_combined_list = Sorted_list1
           -> List2 = Sorted_combined_list;
              closure2(Sorted_combined_list, Pred2, List2)
     ));
     List2 = Sorted_list1
  ).

%%  closure3(List1, Pred3, List2) iff List2 is the closure of List1
%%  according to the ternary predicate Pred3, for which the first 2
%%  operands are the "old" elements and the third is the "new" or
%%  generated element.  NG if arg1 or arg2 is var.

closure3(List1, Pred3, List2) :-
  sort(List1, Sorted_list1),
  (setof(Arg3, Arg1^Arg2^Test^(member(Arg1, Sorted_list1),
                               member(Arg2, Sorted_list1),
                               Test =.. [Pred3, Arg1, Arg2, Arg3],
                               Test),
         New_list)
     ->
       (append(Sorted_list1, New_list, Combined_list),
        sort(Combined_list, Sorted_combined_list),
        (Sorted_combined_list = Sorted_list1
             -> List2 = Sorted_combined_list;
                closure3(Sorted_combined_list, Pred3, List2)
       ));
       List2 = Sorted_list1
  ).

%%  **************** Numeric ****************

%%  numvar(X, Limit) iff X and Limit are non-negative integers,
%%  with X =< Limit.  In generative mode, solutions are produced
%%  from zero to higher values.  Either, both, or neither argument
%%  may be instantiated.  NG if arg1 is fraction and arg2 var.

numvar(X,Limit) :- var(Limit),    natural(Limit), numvar(X, Limit).
numvar(X,Limit) :- nonvar(Limit), natural(X), ((X>Limit, !, fail); true).

%%  natural(X) iff X is a non-negative integer.

natural(X) :- nonvar(X), integer(X), X>=0;
              var(X), gen_integer(X, 0).

%%  gen_integer(X,Seed) generates integers, incrementing from Seed.
%%  NG if arg1 is nonvar or arg2 is var.

gen_integer(X, Seed) :-
  var(X),
  integer(Seed),
  gen_integer_vc(X, Seed).

gen_integer_vc(X, Seed) :-
  X is Seed;
  (New_seed is Seed+1,
   gen_integer_vc(X, New_seed)).

%%  random(Max, N) instantiates N to a random integer between
%%  1 and Max.  NG if arg1 is var.

seed(13).

random(R,N) :-
        retract(seed(S)),
        N is (S mod R) +1,
        NewSeed is (125*S+1) mod 4096,
        asserta(seed(NewSeed)),!.

%%  rationalize(Exprs, R_Exprs) iff Exprs is a numeric expression,
%%  and R_Exprs is a mostly evaluated form of the expression.
%%  Rational numbers are preserved and reduced to lowest terms,
%%  or integers if possible.  If no floating-point numbers are in
%%  the expression, the results are exact, except for raising to a
%%  fractional power.  NG if Exprs is not a fully instantiated
%%  numeric expression.  Routines for handling exponentiation
%%  override some C-Prolog defaults.  X^0 always equals 1, even for
%%  0^0.  A negative base is allowed with an integer power, so
%%  (-2)^4 = 16, and (-2)^5 = -32.  Negative powers are handled
%%  correctly, eg, 2^(-3) = 1/8, (-2)^(-3) = -1/8, (2/3)^(-3) =
%%  27/8. A negative base to a fractional power fails, as does zero
%%  to a negative power.

rationalize(Exprs, Exprs) :- number(Exprs), !.

%%  handle plus and minus unary ops

rationalize(-(Exprs), R_Exprs) :- rationalize(Exprs*(-1), R_Exprs).

rationalize(+(Exprs), R_Exprs) :- rationalize(Exprs, R_Exprs).

%%  all other unary ops to be handled by regular evaluation.

rationalize(Exprs, R_Exprs) :-
  Exprs =.. [Un_op, Opnd1],
  Un_op \== '+',
  Un_op \== '-',
  rationalize(Opnd1, R_Opnd1),
  Eval =.. [Un_op, R_Opnd1],
  R_Exprs is Eval.

%%  handle binary ops

rationalize(Exprs, R_Exprs) :-
  Exprs =.. [Bin_op, Opnd1, Opnd2],
  rationalize(Opnd1, R_Opnd1),
  rationalize(Opnd2, R_Opnd2),
  (plain_eval(Bin_op, R_Opnd1, R_Opnd2)
        -> (Eval =.. [Bin_op, R_Opnd1, R_Opnd2], R_Exprs is Eval, !);
           (rationalize_1(Bin_op, R_Opnd1, R_Opnd2, R_Exprs), !)
  ).

%%  plain_eval is true if the expression can be evaluated directly,
%%  either because: 1) the result will be exact (eg integer subtraction),
%%  or 2) the result is (probably) not rational anyway (eg, when
%%  a floating-point number is an operand, or raising to a fractional
%%  power).

plain_eval(Bin_op, R_Opnd1, R_Opnd2) :-
  not(member(Bin_op, [+,-,*,/,^])).

plain_eval(Bin_op, R_Opnd1, R_Opnd2) :-
  Bin_op \== '^',
  (float(R_Opnd1); float(R_Opnd2)).

plain_eval(Bin_op, R_Opnd1, R_Opnd2) :-
  integer(R_Opnd1), integer(R_Opnd2),
  member(Bin_op, [+,-,*]).

plain_eval(^, Base, Power) :-
  Base > 0,
  (not(integer(Power));
   Power =:= 0;
   float(Base);
   (number(Base), Power > 0)
  ).

rationalize_1(^, 0, Power, _) :-
  Power < 0,
  nl, print('Error: raising zero to negative power.'), nl,
  !, fail.

rationalize_1(^, 0, Power, 0) :-
  Power > 0.

rationalize_1(^, _, 0, 1).

rationalize_1(^, Base, Power, R_Exprs) :-
  Base < 0,
  not(integer(Power)),
  nl, print('Error: raising negative to fractional power.'), nl,
  !, fail.

rationalize_1(^, Base, Power, R_Exprs) :-
  Base < 0,
  float(Base),
  Mag is (-Base) ^ Power, !,
  (Power mod 2 =:= 0 -> R_Exprs is  Mag;
                        R_Exprs is -Mag).

rationalize_1(Bin_op, R_Opnd1, R_Opnd2, R_Exprs) :-
  (integer(R_Opnd1) -> (Num1 = R_Opnd1, Den1 = 1);
                        Num1/Den1 = R_Opnd1),
  (integer(R_Opnd2) -> (Num2 = R_Opnd2, Den2 = 1);
                        Num2/Den2 = R_Opnd2),
  rationalize_2(Bin_op, Num1, Den1, Num2, Den2, Num, Den),
  (Den =:= 0 -> (nl, print('Error: divide by zero'), nl,
                 !, fail
                );
                reduced(Num/Den, R_Exprs)
  ),
  !.

rationalize_2(+, Num1, Den1, Num2, Den2, Num, Den) :-
  Num is Num1*Den2 + Num2*Den1,
  Den is Den1*Den2.

rationalize_2(-, Num1, Den1, Num2, Den2, Num, Den) :-
  Num is Num1*Den2 - Num2*Den1,
  Den is Den1*Den2.

rationalize_2(*, Num1, Den1, Num2, Den2, Num, Den) :-
  Num is Num1*Num2,
  Den is Den1*Den2.

rationalize_2(/, Num1, Den1, Num2, Den2, Num, Den) :-
  Num is Num1*Den2,
  Den is Den1*Num2.

rationalize_2(^, Num1, 1, Num2, 1, Num, Den) :-
  abs(Num1, Base),
  abs(Num2, Power),
  Mag is Base^Power,
  ((Num1 >= 0; Power mod 2 =:= 0) -> Sign = 1; Sign = -1),
  (Num2 < 0 -> (Num = Sign,      Den = Mag);
               (Num is Sign*Mag, Den = 1)).

rationalize_2(^, Num1, Den1, Num2, 1, Num, Den) :-
  rationalize_2(^, Num1, 1, Num2, 1, NumNum, NumDen),
  rationalize_2(^, Den1, 1, Num2, 1, DenNum, DenDen),
  Num is NumNum*DenDen,
  Den is NumDen*DenNum,
  !.

%%   reduced(Exprs, R_Exprs) iff R_Exprs is Exprs reduced to
%%   lowest terms.  R_Exprs is an integer if the denominator
%%   would be 1.  NG if arg1 is var.

reduced(Exprs,Exprs) :- integer(Exprs), !.
reduced(Num/Den, Ans) :-
  Num mod Den =:= 0,
  Ans is Num/Den, !.
reduced(Num_In/Den_In, Num_Out/Den_Out) :-
  gcd(Num_In, Den_In, GCD),
  Num_Temp is Num_In/GCD,
  Den_Temp is Den_In/GCD,
  (Den_Temp < 0 -> (Num_Out is -Num_Temp, Den_Out is -Den_Temp);
                   (Num_Out is  Num_Temp, Den_Out is  Den_Temp)
  ),
  !.

%%  gcd(X, Y, Ans) iff Ans is the greatest common divisor of the
%%  integers X and Y.  NG if arg1 or arg2 is var.

gcd(X, 0, X) :- !.
gcd(0, X, X) :- !.
gcd(X, Y, Ans) :-
  L is Y mod X,
  gcd(L, X, Ans), !.

%%  abs(X, Y) iff Y is the absolute value of X.  Ng if arg1 is var.

abs(X,Y) :-
  X < 0 -> Y is -X; Y is X.

%%  ***************** Control ****************

%%  loop(Pred) repeatedly invokes Pred until it fails.  Loop always
%%  fails and so is executed only for side-effects.  If Pred has
%%  several clauses, enclose in parens.  A typical use might be:
%%     loop((pred(X,Y), write(X), write('  '), write(Y), nl)).
%%  to write out all solutions.

loop(Pred) :-
  repeat,
  (Pred; (!, fail)),     %   Pred succeeds, or kill loop
  fail.                  %   Force repetition.

%%  invoke(Pred_list) creates a predication from Pred_list and
%%  invokes it.  Pred_list must be instantiated.  The reason for
%%  the 2nd arg is that otherwise invoke will quit after first
%%  success with all nonvars.  Even if all args are nonvar,
%%  users may wish to re-invoke by re-instantiating Pred_list.

invoke(Pred_list, Pred_call) :- Pred_call=..Pred_list, Pred_call.

%%  ************* Extended Logic **************

%%  counter_eg(If, Then) iff there exists some instantiation of If
%%  and Then such that If is true and Then is false.  If and Then
%%  must be predicates.  Their arg-lists may contain vars, but the
%%  predicates themselves must be specified.  Eg:
%%  counter_eg((gender(X,male), gender(Y,female)), taller(X,Y)).
%%  may be understood as "Are there any counter-examples to the rule
%%  that if X is male and Y is female, then X is taller than Y?"

counter_eg(If, Then) :- If, not(Then).

%%  implies(If, Then) iff If and Then form a true implication for
%%  this DB, ie there are no counter-examples.

implies(If, Then) :- not(counter_eg(If, Then)).

%%  The following stuff is meant to provide some capability for expressing
%%  disjunction and negation.  The three predicates visible at the user
%%  level are:
%%
%%    or(L) - to ask if this is a true disjunction; defined herein, but
%%            invoked by the user.
%%
%%    ground_or(L) - to tell the system that this is a true disjunction,
%%            ie, at least one disjunct is true.  Defined by the user
%%            as part of the DB.
%%
%%    false(P) - says that P is definitely false (not just not provable,
%%            a la "not" in normal Prolog).  Defined by the user as part
%%            of the DB.
%%
%%    start_or. - the user has to invoke this to fire up the system,
%%            before he starts asking things.
%%
%%  eg, if the user, in the DB, says:
%%
%%    ground_or([e,f,g,h,i]).
%%    false(f).
%%    false(g).
%%    ground_or([a,b,c]) :- d.
%%    d.
%%    false(b).
%%    false(a) :- w; d.
%%
%%  and then invokes start_or, the system will be able to conclude
%%  that the following succeed:
%%
%%    c.                    (because (a or b or c) is true and a and b are
%%                           both false)
%%    or([x1,d,x2]).        (because d is a true disjunct)
%%    or([f,g,t,h,r,e,i]).  (because it contains a true disjunct: [e,f,g,h,i]).
%%    or([e,h,i])           (because its residue from [e,f,g,h,i] is [f,g] all
%%                           of which are false.)
%%
%%  It's probably not wise for "ground_or" itself to depend on "or".


%%  or(L) iff L is a list of disjuncts, at least one of which is true.
%%  NG if L is var.

or(L) :- nonvar(L), L = [_|_], (or_1(L); or_2(L); or_3(L)).

%%  or_1 tries to find a true individual disjunct.
%%  or_2 tries to find a subset of L already known to be true.
%%  or_3 tries to find a superset of L already known to be true,
%%       and then show the rest are false.

or_1([E | R]) :- E; or_1(R).
or_2(L1)      :- ground_or(L2), subset(L2, L1).
or_3(L)       :- ground_or(Ground_list),
                 set_plus(L, Residue, Ground_list),
                 false_list(Residue).

%%  false_list(L) iff all members of L are provably false.

false_list([]).
false_list([E1 | Rest]) :- false(E1), false_list(Rest).

%%  start_or always fails, but in the meantime, it builds clauses
%%  for each disjunct of the ground_or's.

start_or :-
  clause(ground_or(Disjuncts), Antecedents),
  set_plus([One_disjunct], Rest, Disjuncts),
  assertz((One_disjunct :- Antecedents, false_list(Rest))),
  fail.

%%  Some meta-logical facilities coming up.

%%  kb_object(Type, Head, Tail) iff there is a clause "Head :- Tail."
%%  in the current program.  If the Tail=true, and the Head is
%%  composed of all constants, Type = fact, otherwise Type = rule.

kb_object(Type, Head, Tail) :-
  current_predicate(_, Head),
  clause(Head, Tail),
  ((Tail = true, constant_term(Head)) -> Type = fact;
                                         Type = rule).

%%  assert1(Term) iff there is exactly one matching instance of Term
%%  asserted in the DB.  Term should be at least partially instantiated.

assert1(Term) :-
  repeat,
  (retract(Term) -> fail;
                    assert(Term)
  ),
  !.

%%  ed allows for some very primitive run-time program modification.
%%  The user can enter terms, facts or rules, without the "extra"
%%  parentheses needed by assert, and ed then asserts and writes out
%%  the term for later editing into the permanent program.

ed :-
   nl, print('Enter fact or rule ([] to quit).'), nl,
   read(T),
   (T = [] -> true; (ed_1(T), !, ed)).

ed_1(T) :-
  assert(T),
  tell('x.tmp'),
  nl, writeq(T), put(46), nl,
  tell(user).

%%   End of Prolog Utilities
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

------------------------------

End of PROLOG Digest
********************