Did you know ... Search Documentation:
Pack list_util -- prolog/list_util.pl
PublicShow source
 lazy_findall(:Template, +Goal, -List:list) is det
Like findall/3 but List is constructed lazily. This allows it to be used when Goal produces many (or infinite) solutions.

Goal is always executed at least once, even if it's not strictly necessary. Goal may be executed in advance, even if the associated value in List has not been demanded yet. This should only be important if Goal performs side effects whose timing is important to you.

If you don't consume all of List, it's likely that a worker thread will be left hanging. This is a temporary implementation detail which we hope to resolve.

 lines(+Source, -Lines:list(string)) is det
Lines is a lazy list of lines from Source. Source can be one of:
  • file(Filename) - read lines from a file
  • stream(Stream) - read lines from a stream

After the last line has been read, all relevant streams are automatically closed.

Each line in Lines does not contain the line terminator.

 split(?Combined:list, ?Separator, ?Separated:list(list)) is det
True if lists in Separated joined together with Separator form Combined. Can be used to split a list into sublists or combine several sublists into a single list.

For example,

?- portray_text(true).

?- split("one,two,three", 0',, Parts).
Parts = ["one", "two", "three"].

?- split(Codes, 0',, ["alpha", "beta"]).
Codes = "alpha,beta".
 take(+N:nonneg, ?List:list, ?Front:list) is det
True if Front contains the first N elements of List. If N is larger than List's length, List=Front.

For example,

?- take(2, [1,2,3,4], L).
L = [1, 2].

?- take(2, [1], L).
L = [1].

?- take(2, L, [a,b]).
L = [a, b|_G1055].
 split_at(+N:nonneg, ?Xs:list, ?Take:list, ?Rest:list)
True if Take is a list containing the first N elements of Xs and Rest contains the remaining elements. If N is larger than the length of Xs, Xs = Take.

For example,

?- split_at(3, [a,b,c,d], Take, Rest).
Take = [a, b, c],
Rest = [d].

?- split_at(5, [a,b,c], Take, Rest).
Take = [a, b, c],
Rest = [].

?- split_at(2, Xs, Take, [c,d]).
Xs = [_G3219, _G3225, c, d],
Take = [_G3219, _G3225].

?- split_at(1, Xs, Take, []).
Xs = Take, Take = [] ;
Xs = Take, Take = [_G3810].
 take_while(:Goal, +List1:list, -List2:list) is det
True if List2 is the longest prefix of List1 for which Goal succeeds. For example,
even(X) :- 0 is X mod 2.

?- take_while(even, [2,4,6,9,12], Xs).
Xs = [2,4,6].
 drop(+N:nonneg, ?List:list, ?Rest:list) is det
drop(+N:positive_integer, -List:list, +Rest:empty_list) is multi
True if Rest is what remains of List after dropping the first N elements. If N is greater than List's length, Rest = [].

For example,

?- drop(1, [a,b,c], L).
L = [b, c].

?- drop(10, [a,b,c], L).
L = [].

?- drop(1, L, [2,3]).
L = [_G1054, 2, 3].

?- drop(2, L, []).
L = [] ;
L = [_G1024] ;
L = [_G1024, _G1027].
 drop_while(:Goal, +List1:list, -List2:list) is det
True if List2 is the suffix remaining after take_while(Goal,List1,_). For example,
even(X) :- 0 is X mod 2.

?- drop_while(even, [2,4,6,9,12], Xs).
Xs = [9,12].
 span(:Goal, +List:list, -Prefix:list, -Suffix:list) is det
span(:Goal, +List:list, +Prefix:list, -Suffix:list) is semidet
span(:Goal, +List:list, -Prefix:list, +Suffix:list) is semidet
span(:Goal, +List:list, +Prefix:list, +Suffix:list) is semidet
True if Prefix is the longest prefix of List for which Goal succeeds and Suffix is the rest. For any Goal, it is true that append(Prefix,Suffix,List). span/4 behaves as if it were implement as follows (but it's more efficient):
span(Goal,List,Prefix,Suffix) :-
    take_while(Goal,List,Prefix),
    drop_while(Goal,List,Suffix).

For example,

even(X) :- 0 is X mod 2.

?- span(even, [2,4,6,9,12], Prefix, Suffix).
Prefix = [2,4,6],
Suffix = [9,12].
 span(:Goal, +List:list, -Prefix:list, ?Tail:list, -Suffix:list) is semidet
This is a version of span/4 that supports difference lists.
?- span(==(a), [a,a,b,c,a], Prefix, Tail, Suffix).
Prefix = [a, a|Tail],
Suffix = [b, c, a].
 replicate(?N:nonneg, ?X:T, ?Xs:list(T))
True only if Xs is a list containing only the value X repeated N times. If N is less than zero, Xs is the empty list.

For example,

?- replicate(4, q, Xs).
Xs = [q, q, q, q] ;
false.

?- replicate(N, X, [1,1]).
N = 2,
X = 1.

?- replicate(0, ab, []).
true.

?- replicate(N, X, Xs).
N = 0,
Xs = [] ;
N = 1,
Xs = [X] ;
N = 2,
Xs = [X, X] ;
N = 3,
Xs = [X, X, X] ;
... etc.
 repeat(?X, -Xs:list)
True if Xs is an infinite lazy list that only contains occurences of X. If X is nonvar on entry, then all members of Xs will be constrained to be the same term.

For example,

?- repeat(term(X), Rs), Rs = [term(2),term(2)|_].
X = 2
Rs = [term(2), term(2)|_G3041]

?- repeat(X, Rs), take(4, Rs, Repeats).
Rs = [X, X, X, X|_G3725],
Repeats = [X, X, X, X]

?- repeat(12, Rs), take(2, Rs, Repeats).
Rs = [12, 12|_G3630],
Repeats = [12, 12]
 cycle(?Sequence, +Xs:list)
True if Xs is an infinite lazy list that contains Sequence, repeated cyclically.

For example,

?- cycle([a,2,z], Xs), take(5, Xs, Cycle).
Xs = [a, 2, z, a, 2|_G3765],
Cycle = [a, 2, z, a, 2]

?- dif(X,Y), cycle([X,Y], Xs), take(3, Xs, Cycle), X = 1, Y = 12.
X = 1,
Y = 12,
Xs = [1, 12, 1|_G3992],
Cycle = [1, 12, 1]
 oneof(List:list(T), Element:T) is semidet
Same as memberchk/2 with argument order reversed. This form is helpful when used as the first argument to predicates like include/3 and exclude/3.
 map_include(:Goal:callable, +In:list, -Out:list) is det
True if Out (elements Yi) contains those elements of In (Xi) for which call(Goal, Xi, Yi) is true. If call(Goal, Xi, Yi) fails, the corresponding element is omitted from Out. If Goal generates multiple solutions, only the first one is taken.

For example, assuming f(X,Y) :- number(X), succ(X,Y)

?- map_include(f, [1,a,3], L).
L = [2, 4].
 map_include(:Goal:callable, +In0:list, +In1:list, -Out:list) is det
Same as map_include/3, except Goal is binary argument meta predicate.
 map_include(:Goal:callable, +In0:list, +In1:list, +In2:list, -Out:list) is det
Same as map_include/3, except Goal is tertiary argument meta predicate.
 maximum(?List:list, ?Maximum) is semidet
True if Maximum is the largest element of List, according to compare/3. The same as maximum_by(compare, List, Maximum).
 maximum_with(:Goal, ?List:list, ?Maximum) is semidet
True if Maximum is the largest projected value (according to compare/3) of each element in the list. The projected values are found by applying Goal to each list element.
 maximum_by(+Compare, ?List:list, ?Maximum) is semidet
True if Maximum is the largest element of List, according to Compare. Compare should be a predicate with the same signature as compare/3.

If List is not ground the constraint is delayed until List becomes ground.

 minimum(?List:list, ?Minimum) is semidet
True if Minimum is the smallest element of List, according to compare/3. The same as minimum_by(compare, List, Minimum).
 minimum_with(:Goal, ?List:list, ?Minimum) is semidet
True if Minimum is the largest projected value (according to compare/3) of each element in the list. The projected values are found by applying Goal to each list element.
 minimum_by(+Compare, ?List:list, ?Minimum) is semidet
True if Minimum is the smallest element of List, according to Compare. Compare should be a predicate with the same signature as compare/3.

If List is not ground the constraint is delayed until List becomes ground.

 iterate(:Goal, +State, -List:list)
List is a lazy (possibly infinite) list whose elements are the result of repeatedly applying Goal to State. Goal may fail to end the list. Goal is called like
call(Goal, State0, State, Value)

The first value in List is the value produced by calling Goal with State. For example, a lazy, infinite list of positive integers might be defined with:

incr(A,B,A) :- succ(A,B).
integers(Z) :- iterate(incr,1,Z). % Z = [1,2,3,...]

Calling iterate/3 with a mode different than described in the modeline throws an exception. Other modes may be supported in the future, so don't rely on the exception to catch your mode errors.

 positive_integers(-List:list(positive_integer)) is det
Unifies List with a lazy, infinite list of all positive integers.
 lazy_include(+Goal, +List1:list, -List2:list) is det
Like include/3 but produces List2 lazily. This predicate is helpful when List1 is infinite or very large.
 lazy_maplist(:Goal, ?List1:list, ?List2:list)
True if List2 is a list of elements that all satisfy Goal applied to each element of List1. This is a lazy version of maplist/3.
 group_with(:Goal, +List:list, -Grouped:list(list)) is det
Groups elements of List using Goal to project something out of each element. Elements are first sorted based on the projected value (like sort_with/3) and then placed into groups for which the projected values unify. Goal is invoked as call(Goal,Elem,Projection).

For example,

?- group_with(atom_length, [a,hi,bye,b], Groups).
Groups = [[a,b],[hi],[bye]]
 group_by(:Goal, +List:list, -Groups:list(list)) is det
group_by(:Goal, -List:list, +Groups:list(list)) is semidet
Groups elements of List using a custom Goal predicate to test for equality. If Goal is true, then two elements compare as equal. Goal takes the form

call(Goal, X, Y)

Adjacent and equal elements of List will be grouped together if and only if Goal is true

For example,

?- group_by(==, `Mississippi`, Gs),
maplist([Codes,String]>>string_codes(String,Codes), Gs, Groups).

Groups = ["M", "i", "ss", "i", "ss", "i", "pp", "i"].
 group(+List:list, -Groups:list(list)) is semidet
True if Groups is a compressed version of the elements in List. This predicate uses term equality per ==/2 as the comparison goal for group_by/2. See the description of group_by/2.
 sort_by(:Goal, +List:list, -Sorted:list) is det
See sort_with/3. This name was assigned to the wrong predicate in earlier versions of this library. It now throws an exception. It will eventually be replaced with a different implementation.
 sort_with(:Goal, +List:list, -Sorted:list) is det
Sort a List of elements using Goal to project something out of each element. This is often more natural than creating an auxiliary predicate for predsort/3. For example, to sort a list of atoms by their length:
?- sort_with(atom_length, [cat,hi,house], Atoms).
Atoms = [hi,cat,house].

Standard term comparison is used to compare the results of Goal. Duplicates are not removed. The sort is stable.

If Goal is expensive, sort_with/3 is more efficient than predsort/3 because Goal is called once per element, O(N), rather than repeatedly per element, O(N log N).

 sort_r(+List:list, -ReverseSorted:list) is det
Like sort/2 but produces a list sorted in reverse order.
 msort_r(+List:list, -ReverseSorted:list) is det
Like msort/2 but produces a list sorted in reverse order.
 keysort_r(+List:list, -ReverseSorted:list) is det
Like keysort/2 but produces a list sorted in reverse order.
 xfy_list(?Op:atom, ?Term, ?List) is det
True if elements of List joined together with xfy operator Op gives Term. Usable in all directions.

For example,

?- xfy_list(',', (a,b,c), L).
L = [a, b, c].

?- xfy_list(Op, 4^3^2, [4,3,2]).
Op = (^).