2%   File   : list_utilities.pl
    3%   Author : Bob Welham, Lawrence Byrd, and R.A.O'Keefe
    4%   Updated: 7 February 2001
    5%   Purpose: list processing utilities
    6
    7% Extended with some higher-order utilities by Neil Smith, 2001
    8
    9%   This module requires
   10%	select/3	(from set_utilities.Pl) for perm/2
   11%	listtoset/2	(from set_utilities.Pl) for remove_dups/2
   12
   13:- module(list_utilities, 
   14      [ correspond/4,			%   Elem <- List x List -> Elem
   15	delete/3,			%   List x Elem -> List
   16	removeallL/3,			%   Elem x List -> List
   17	last/2,				%   List -> Elem
   18	nextto/3,			%   Elem, Elem <- List
   19	nmember/3,			%   Elem <- Set -> Integer
   20	nmembers/3,			%   List x Set -> Set
   21	nth0/3,				%   Integer x List -> Elem
   22	nth0/4,				%   Integer x List -> Elem x List
   23	nth1/3,				%   Integer x List -> Elem
   24	nth1/4,				%   Integer x List -> Elem x List
   25	numlist/3,			%   Integer x Integer -> List
   26	perm/2,				%   List -> List
   27	perm2/4,			%   Elem x Elem -> Elem x Elem
   28	remove_dups/2,			%   List -> Set
   29	same_length/2,			%   List x List ->
   30	select/4,			%   Elem x List x Elem -> List
   31	shorter_list/2,			%   List x List ->
   32	subseq/3,			%   List -> List x List
   33	subseq0/2,			%   List -> List
   34	subseq1/2,			%   List -> List
   35	sumlist/2,			%   List -> Integer
   36	zip/3,				%   List x List -> List
   37	zip_with/4			%   ListA x ListB x (a x b -> c) -> ListC
   38      ]).   39
   40
   41:- ensure_loaded((utils_for_swi)).   42%:- ensure_loaded((utils_oset)).
   43:- ensure_loaded((utils_higher_order)).   44
   45:- index(zip/3, [1,2,3]).	% optimization imperative at end of file (LPA Prolog specific)
   46:- index(zip_with/4, [1,2,4]).	% optimization imperative at end of file (LPA Prolog specific)
   47
   48
   49/***************
   50 * modes
   51 *	correspond(?, +, +, ?),
   52 *	delete(+, +, -),
   53 *	removeallL(+, +, -),
   54 *	last(?, ?),
   55 *	nextto(?, ?, ?),
   56 *	nmember(?, +, ?),
   57 *	nmembers(+, +, -),
   58 *	nth0(+, +, ?),
   59 *	nth0(+, ?, ?, ?),
   60 *	nth1(+, +, ?),
   61 *	nth1(+, ?, ?, ?),
   62 *	numlist(+, +, ?),
   63 *	perm(?, ?),
   64 *	perm2(?,?, ?,?),
   65 *	remove_dups(+, ?),
   66 *	rev(?, ?),
   67 *	same_length(?, ?),
   68 *	select(?, ?, ?, ?),
   69 *	shorter_list(?, +),
   70 *	subseq(?, ?, ?),
   71 *	subseq0(+, ?),
   72 *	subseq1(+, ?),
   73 *	sumlist(+, ?),
   74 *	sumlist(+, +, ?).
   75 *****************/
   76
   77
   78
   79%   correspond(X, Xlist, Ylist, Y)
   80%   is true when Xlist and Ylist are lists, X is an element of Xlist, Y is
   81%   an element of Ylist, and X and Y are in similar places in their lists.
   82
   83correspond(X, [X|_], [Y|_], Y) :- !.
   84correspond(X, [_|T], [_|U], Y) :-
   85	correspond(X, T, U, Y).
   86
   87%   delete(List, Elem, Residue)
   88%   is true when List is a list, in which Elem may or may not occur, and
   89%   Residue is a copy of List with all elements equal to Elem deleted.
   90% Superceded by LPA's removeall
   91
   92delete([], _, []) :- !.
   93delete([Kill|Tail], Kill, Rest) :- !,
   94	delete(Tail, Kill, Rest).
   95delete([Head|Tail], Kill, [Head|Rest]) :- !,
   96	delete(Tail, Kill, Rest).
   97
   98
   99%    removeallL(Elems, List, Residue)
  100%    is true when Elems and List are lists, and Residue is a copy of 
  101%    List in which all occurrences of each element in Elems have been removed
  102%    Members of Elems need not occur in List
  103
  104removeallL([], X, X).
  105removeallL([A|As], Bs, Cs):-
  106	%removeall(A, Bs, SmallBs),
  107        delete(Bs,A,SmallBs),
  108	removeallL(As, SmallBs, Cs).
  109
  110
  111%   last(Last, List)
  112%   is true when List is a List and Last is its last element.  This could
  113%   be defined as last(X,L) :- append(_, [X], L).
  114
  115last(Last, [Last]) :- !.
  116last(Last, [_|List]) :-
  117	last(Last, List).
  118
  119
  120%   nextto(X, Y, List)
  121%   is true when X and Y appear side-by-side in List.  It could be written as
  122%	nextto(X, Y, List) :- append(_, [X,Y], List).
  123%   It may be used to enumerate successive pairs from the list.
  124
  125nextto(X,Y, [X,Y|_]).
  126nextto(X,Y, [_|List]) :-
  127	nextto(X,Y, List).
  128
  129
  130%   nmember(Elem, List, Index) Possible Calling Sequences
  131%   nmember(+,+,-) or nmember(-,+,+) or nmember(-,+,-).
  132%   True when Elem is the Indexth member of List.
  133%   It may be used to select a particular element, or to find where some
  134%   given element occurs, or to enumerate the elements and indices togther.
  135
  136nmember(Elem, [Elem|_], 1).
  137nmember(Elem, [_|List], N) :-
  138	nmember(Elem, List, M),
  139		N is M+1.
  140
  141% nmembers(+Indices, +Answers, -Ans) or nmembers(-Indices, +Answers, +Ans)
  142% (But not nmembers(-,+,-), it loops.)
  143% Like nmember/3 except that it looks for a list of arguments in a list
  144% of positions.
  145% eg.   nmembers([3,5,1], [a,b,c,d,e,f,g,h], [c,e,a]) is true 
  146
  147nmembers([], _, []).
  148nmembers([N|Rest], Answers, [Ans|RestAns]) :-
  149	nmember(Ans, Answers, N),
  150		nmembers(Rest, Answers, RestAns).
  151
  152
  153%   nth0(+N, +List, ?Elem) is true when Elem is the Nth member of List,
  154%   counting the first as element 0.  (That is, throw away the first
  155%   N elements and unify Elem with the next.)  It can only be used to
  156%   select a particular element given the list and index.  For that
  157%   task it is more efficient than nmember.
  158%   nth1(+N, +List, ?Elem) is the same as nth0, except that it counts from
  159%   1, that is nth(1, [H|_], H).
  160
  161nth0(0, [Head|_], Head) :- !.
  162
  163nth0(N, [_|Tail], Elem) :-
  164	nonvar(N),
  165	M is N-1,
  166	nth0(M, Tail, Elem).
  167
  168nth0(N,[_|T],Item) :-		% Clause added KJ 4-5-87 to allow mode
  169	var(N),			% nth0(-,+,+)
  170	nth0(M,T,Item),
  171	N is M + 1.
  172
  173
  174nth1(1, [Head|_], Head) :- !.
  175
  176nth1(N, [_|Tail], Elem) :-
  177	nonvar(N),
  178	M is N-1,			% should be succ(M, N)
  179	nth1(M, Tail, Elem).
  180
  181nth1(N,[_|T],Item) :-		% Clause added KJ 4-5-87 to allow mode
  182	var(N),			% nth1(-,+,+)
  183	nth1(M,T,Item),
  184	N is M + 1.
  185
  186
  187%   nth0(+N, ?List, ?Elem, ?Rest) unifies Elem with the Nth element of List,
  188%   counting from 0, and Rest with the other elements.  It can be used
  189%   to select the Nth element of List (yielding Elem and Rest), or to 
  190%   insert Elem before the Nth (counting from 1) element of Rest, when
  191%   it yields List, e.g. nth0(2, List, c, [a,b,d,e]) unifies List with
  192%   [a,b,c,d,e].  nth1 is the same except that it counts from 1.  nth1
  193%   can be used to insert Elem after the Nth element of Rest.
  194
  195nth0(0, [Head|Tail], Head, Tail) :- !.
  196
  197nth0(N, [Head|Tail], Elem, [Head|Rest]) :-
  198	nonvar(N),
  199	M is N-1,
  200	nth0(M, Tail, Elem, Rest).
  201
  202nth0(N, [Head|Tail], Elem, [Head|Rest]) :-	% Clause added KJ 4-5-87
  203	var(N),					% to allow mode
  204	nth0(M, Tail, Elem, Rest),		% nth0(-,+,+,?).
  205	N is M+1.
  206
  207
  208nth1(1, [Head|Tail], Head, Tail) :- !.
  209
  210nth1(N, [Head|Tail], Elem, [Head|Rest]) :-
  211	nonvar(N),
  212	M is N-1,
  213	nth1(M, Tail, Elem, Rest).
  214
  215nth1(N, [Head|Tail], Elem, [Head|Rest]) :-	% Clause added KJ 4-5-87
  216	var(N),					% to allow mode
  217	nth1(M, Tail, Elem, Rest),		% nth1(-,+,+,?).
  218	N is M+1.
  219
  220%   numlist(Lower, Upper, List)
  221%   is true when List is [Lower, ..., Upper]
  222%   Note that Lower and Upper must be integers, not expressions, and
  223%   that if Upper < Lower numlist will FAIL rather than producing an
  224%   empty list.
  225
  226numlist(Upper, Upper, [Upper]) :- !.
  227numlist(Lower, Upper, [Lower|Rest]) :-
  228	Lower < Upper,
  229	Next is Lower+1,
  230	numlist(Next, Upper, Rest).
  231
  232
  233
  234%   perm(List, Perm)
  235%   is true when List and Perm are permutations of each other.  Of course,
  236%   if you just want to test that, the best way is to keysort/2 the two
  237%   lists and see if the results are the same.  Or you could use list_to_bag
  238%   (from BagUtl.Pl) to see if they convert to the same bag.  The point of
  239%   perm is to generate permutations.  The arguments may be either way round,
  240%   the only effect will be the order in which the permutations are tried.
  241%   Be careful: this is quite efficient, but the number of permutations of an
  242%   N-element list is N!, even for a 7-element list that is 5040.
  243
  244perm([], []).
  245perm(List, [First|Perm]) :-
  246	select(First, List, Rest),	%  tries each List element in turn
  247	perm(Rest, Perm).
  248
  249
  250
  251%   perm2(A,B, C,D)
  252%   is true when {A,B} = {C,D}.  It is very useful for writing pattern
  253%   matchers over commutative operators.  It is used more than perm is.
  254
  255perm2(X,Y, X,Y).
  256perm2(X,Y, Y,X).
  257
  258
  259%   remove_dups(List, Pruned)
  260%   removes duplicated elements from List.  Beware: if the List has
  261%   non-ground elements, the result may surprise you.
  262
  263remove_dups(List, Pruned) :-
  264	sort(List, Pruned).
  265
  266
  267%   same_length(?List1, ?List2)
  268%   is true when List1 and List2 are both lists and have the same number
  269%   of elements.  No relation between the values of their elements is
  270%   implied.
  271%   Modes same_length(-,+) and same_length(+,-) generate either list given
  272%   the other; mode same_length(-,-) generates two lists of the same length,
  273%   in which case the arguments will be bound to lists of length 0, 1, 2, ...
  274
  275same_length([], []).
  276same_length([_|List1], [_|List2]) :-
  277	same_length(List1, List2).
  278
  279
  280%   select(X, Xlist, Y, Ylist)
  281% >> NB  This is select/4, not select/3 !!
  282%   is true when X is the Kth member of Xlist and Y the Kth element of Ylist
  283%   for some K, and apart from that Xlist and Ylist are the same.  You can
  284%   use it to replace X by Y or vice versa.
  285
  286select(X, [X|Tail], Y, [Y|Tail]).
  287select(X, [Head|Xlist], Y, [Head|Ylist]) :-
  288	select(X, Xlist, Y, Ylist).
  289
  290
  291%   shorter_list(Short, Long)
  292%   is true when Short is a list is strictly shorter than Long.  Long
  293%   doesn't have to be a proper list provided it is long enough.  This
  294%   can be used to generate lists shorter than Long, lengths 0, 1, 2...
  295%   will be tried, but backtracking will terminate with a list that is
  296%   one element shorter than Long.  It cannot be used to generate lists
  297%   longer than Short, because it doesn't look at all the elements of the
  298%   longer list.
  299
  300shorter_list([], [_|_]).
  301shorter_list([_|Short], [_|Long]) :-
  302	shorter_list(Short, Long).
  303	
  304
  305
  306%   subseq(Sequence, SubSequence, Complement)
  307%   is true when SubSequence and Complement are both subsequences of the
  308%   list Sequence (the order of corresponding elements being preserved)
  309%   and every element of Sequence which is not in SubSequence is in the
  310%   Complement and vice versa.  That is,
  311%   length(Sequence) = length(SubSequence)+length(Complement), e.g.
  312%   subseq([1,2,3,4], [1,3,4], [2]).  This was written to generate subsets
  313%   and their complements together, but can also be used to interleave two
  314%   lists in all possible ways.  Note that if S1 is a subset of S2, it will
  315%   be generated *before S2 as a SubSequence and *after it as a Complement.
  316
  317subseq([], [], []).
  318subseq([Head|Tail], Sbsq, [Head|Cmpl]) :-
  319	subseq(Tail, Sbsq, Cmpl).
  320subseq([Head|Tail], [Head|Sbsq], Cmpl) :-
  321	subseq(Tail, Sbsq, Cmpl).
  322
  323
  324
  325%   subseq0(Sequence, SubSequence)
  326%   is true when SubSequence is a subsequence of Sequence, but may
  327%   be Sequence itself.   Thus subseq0([a,b], [a,b]) is true as well
  328%   as subseq0([a,b], [a]).
  329
  330%   subseq1(Sequence, SubSequence)
  331%   is true when SubSequence is a proper subsequence of Sequence,
  332%   that is it contains at least one element less.
  333
  334%   ?- setof(X, subseq0([a,b,c],X), Xs).
  335%   Xs = [[],[a],[a,b],[a,b,c],[a,c],[b],[b,c],[c]] 
  336%   ?- bagof(X, subseq0([a,b,c,d],X), Xs).
  337%   Xs = [[a,b,c,d],[b,c,d],[c,d],[d],[],[c],[b,d],[b],[b,c],[a,c,d],
  338%	  [a,d],[a],[a,c],[a,b,d],[a,b],[a,b,c]] 
  339
  340subseq0(List, List).
  341
  342subseq0(List, Rest) :-
  343	subseq1(List, Rest).
  344
  345
  346subseq1([_|Tail], Rest) :-
  347	subseq0(Tail, Rest).
  348
  349subseq1([Head|Tail], [Head|Rest]) :-
  350	subseq1(Tail, Rest).
  351
  352
  353%   sumlist(Numbers, Total)
  354%   is true when Numbers is a list of integers, and Total is their sum.
  355
  356sumlist(Numbers, Total):-
  357	foldl1(Numbers, [X, Y, Z]^(Z is X + Y), Total).
  358
  359
  360%   zip(Xs, Ys, XYs)
  361%   is true if each XY = X - Y
  362
  363zip([], [], []).
  364zip([X|Xs], [Y|Ys], [X - Y|XYs]):-
  365	zip(Xs, Ys, XYs).
  366
  367
  368%   zip_with(Xs, Ys, Pred, Zs)
  369%   is true if Pred(X, Y, Z) is true for all X, Y, Z.
  370
  371zip_with([], [], _, []).
  372zip_with([X|Xs], [Y|Ys], Pred, [Z|Zs]):-
  373	lpa_apply(Pred, [X, Y, Z]),
  374	zip_with(Xs, Ys, Pred, Zs).
  375
  376
  377
  378:- optimize(zip/3).  379:- optimize(zip_with/4).