
lists.pl -- List ManipulationThis library provides commonly accepted basic predicates for list manipulation in the Prolog community. Some additional list manipulations are built-in. See e.g., memberchk/2, length/2.
The implementation of this library is copied from many places. These include: "The Craft of Prolog", the DEC-10 Prolog library (LISTRO.PL) and the YAP lists library. Some predicates are reimplemented based on their specification by Quintus and SICStus.
 member(?Elem, ?List)
    member(X, [One]).
 append(?List1, ?List2, ?List1AndList2)
 append(+ListOfLists, ?List)
 prefix(?Part, ?Whole)append(Part, _, Whole).
 select(?Elem, ?List1, ?List2)
 selectchk(+Elem, +List, -Rest) is semidet
 select(?X, ?XList, ?Y, ?YList) is nondet?- select(b, [a,b,c,b], 2, X). X = [a, 2, c, b] ; X = [a, b, c, 2] ; false.
 selectchk(?X, ?XList, ?Y, ?YList) is semidet
 nextto(?X, ?Y, ?List)
 delete(+List1, @Elem, -List2) is det\+ Elem \=
H, which implies that Elem is not changed.
 nth0(?Index, ?List, ?Elem)
 nth1(?Index, ?List, ?Elem)
 nth0(?N, ?List, ?Elem, ?Rest) is det?- nth0(I, [a,b,c], E, R). I = 0, E = a, R = [b, c] ; I = 1, E = b, R = [a, c] ; I = 2, E = c, R = [a, b] ; false.
?- nth0(1, L, a1, [a,b]). L = [a, a1, b].
 nth1(?N, ?List, ?Elem, ?Rest) is det
 last(?List, ?Last)semidet if List is a list and multi if List is
a partial list.
 proper_length(@List, -Length) is semidet
proper_length(List, Length) :-
      is_list(List),
      length(List, Length).
 same_length(?List1, ?List2)
 reverse(?List1, ?List2)
 permutation(?Xs, ?Ys) is nondet
If both Xs and Ys are provided and both lists have equal length
the order is |Xs|^2. Simply testing whether Xs is a permutation
of Ys can be achieved in order log(|Xs|) using msort/2 as
illustrated below with the semidet predicate is_permutation/2:
is_permutation(Xs, Ys) :- msort(Xs, Sorted), msort(Ys, Sorted).
The example below illustrates that Xs and Ys being proper lists is not a sufficient condition to use the above replacement.
?- permutation([1,2], [X,Y]). X = 1, Y = 2 ; X = 2, Y = 1 ; false.
 flatten(+NestedList, -FlatList) is det[] is distinct
from '[]'.
Ending up needing flatten/2 often indicates, like append/3 for appending two lists, a bad design. Efficient code that generates lists from generated small lists must use difference lists, often possible through grammar rules for optimal readability.
 clumped(+Items, -Pairs)Item-Count pairs that represents the run
length encoding of Items. For example:
?- clumped([a,a,b,a,a,a,a,c,c,c], R). R = [a-2, b-1, a-4, c-3].
 subseq(+List, -SubList, -Complement) is nondet
 max_member(-Max, +List) is semidet
 min_member(-Min, +List) is semidet
 max_member(:Pred, -Max, +List) is semidet?- max_member(@=<, X, [6,1,8,4]). X = 8.
 min_member(:Pred, -Min, +List) is semidet?- min_member(@=<, X, [6,1,8,4]). X = 1.
 sum_list(+List, -Sum) is det
 max_list(+List:list(number), -Max:number) is semidet
 min_list(+List:list(number), -Min:number) is semidet
 numlist(+Low, +High, -List) is semidet
 is_set(@Set) is semidetlog(N) and the predicate may cause a
resource-error. There are no other error conditions.
 list_to_set(+List, ?Set) is detlog(N).
 intersection(+Set1, +Set2, -Set3) is det
 union(+Set1, +Set2, -Set3) is det
 subset(+SubSet, +Set) is semidet
 subtract(+Set, +Delete, -Result) is detThe following predicates are exported, but not or incorrectly documented.