Prolog: How to create all possible combinations without repetitions

Question

I am trying to create a predicate that finds all possible combinations without repeating same numbers. I tried using permutation predicate, but it found duplicated lists. For example:

permutation([0,1,1], L).
L = [0,1,1];
L = [0,1,1];
L = [1,0,1];
L = [1,1,0];
L = [1,0,1];
L = [1,1,0];

What I need:

newPermutation([0,1,1], L).
L = [0,1,1];
L = [1,0,1];
L = [1,1,0];

Can someone please help me with that? Thanks a lot...

Answer 1

The repetition-free permutations of [0, 1, 1] are the possible interleavings of the lists [0] and [1, 1]:

?- list_list_interleaving([0], [1, 1], Interleaving).
Interleaving = [0, 1, 1] ;
Interleaving = [1, 0, 1] ;
Interleaving = [1, 1, 0] ;
false.

We can define this as:

list_list_interleaving([], Ys, Ys).
list_list_interleaving([X | Xs], [], [X | Xs]).
list_list_interleaving([X | Xs], [Y | Ys], [X | Interleaving]) :-
    list_list_interleaving(Xs, [Y | Ys], Interleaving).
list_list_interleaving([X | Xs], [Y | Ys], [Y | Interleaving]) :-
    list_list_interleaving([X | Xs], Ys, Interleaving).

For more than two distinct elements, we need the ability to interleave all the lists in a list:

lists_interleaving([Xs], Xs).
lists_interleaving([Xs, Ys | Lists], Interleaving) :-
    lists_interleaving([Ys | Lists], Interleaving0),
    list_list_interleaving(Xs, Interleaving0, Interleaving).

For example:

?- lists_interleaving([[a, a], [b], [c, c]], Interleaving).
Interleaving = [a, a, b, c, c] ;
Interleaving = [a, b, a, c, c] ;
Interleaving = [a, b, c, a, c] ;
Interleaving = [a, b, c, c, a] ;
Interleaving = [b, a, a, c, c] ;
Interleaving = [b, a, c, a, c] ;
Interleaving = [b, a, c, c, a] ;
Interleaving = [b, c, a, a, c] ;
Interleaving = [b, c, a, c, a] ;
Interleaving = [b, c, c, a, a] ;
Interleaving = [a, a, c, b, c] ;
Interleaving = [a, c, a, b, c] ;
Interleaving = [a, c, b, a, c] ;
Interleaving = [a, c, b, c, a] ;
Interleaving = [c, a, a, b, c] ;
Interleaving = [c, a, b, a, c] ;
Interleaving = [c, a, b, c, a] ;
Interleaving = [c, b, a, a, c] ;
Interleaving = [c, b, a, c, a] ;
Interleaving = [c, b, c, a, a] ;
Interleaving = [a, a, c, c, b] ;
Interleaving = [a, c, a, c, b] ;
Interleaving = [a, c, c, a, b] ;
Interleaving = [a, c, c, b, a] ;
Interleaving = [c, a, a, c, b] ;
Interleaving = [c, a, c, a, b] ;
Interleaving = [c, a, c, b, a] ;
Interleaving = [c, c, a, a, b] ;
Interleaving = [c, c, a, b, a] ;
Interleaving = [c, c, b, a, a] ;
false.

The key observation here is that interleaving is not the same as just inserting elements into a list at an arbitrary position: Interleaving keeps the relative order of the elements of the lists. So the first occurrence of a will always precede the second occurrence of a. We can see this more clearly if we label the elements:

?- list_list_interleaving([a1, a2], [b1, b2], Interleaving).
Interleaving = [a1, a2, b1, b2] ;
Interleaving = [a1, b1, a2, b2] ;
Interleaving = [a1, b1, b2, a2] ;
Interleaving = [b1, a1, a2, b2] ;
Interleaving = [b1, a1, b2, a2] ;
Interleaving = [b1, b2, a1, a2] ;
false.

a1 always precedes a2, b1 always precedes b2.

So we can do what we need if our input is separated into such a list of lists. This is a multiset of the elements of the original list. We can compute multisets like this:

list_multiset([], []).
list_multiset([X | Xs], Multiset) :-
    list_multiset(Xs, Multiset0),
    (   ClassX = [X | _],
        select(ClassX, Multiset0, MultisetWithoutClassX)
    ->  Multiset = [[X | ClassX] | MultisetWithoutClassX]
    ;   Multiset = [[X] | Multiset0] ).

For example:

?- list_multiset([a, b, c, a, c], Multiset).
Multiset = [[a, a], [b], [c, c]].

So then the distinct permutations (combinations, whatever) are the interleavings of a list's multiset representation:

distinct_permutation(List, Permutation) :-
    must_be(ground, List),
    list_multiset(List, Multiset),
    lists_interleaving(Multiset, Permutation).

This works:

?- distinct_permutation([0, 1, 1], Permutation).
Permutation = [0, 1, 1] ;
Permutation = [1, 0, 1] ;
Permutation = [1, 1, 0] ;
false.

It's much faster than slaggo's solution, but so far only works on ground lists:

?- time(aggregate_all(count, distinct_permutation([1,1,1,2,2,2,3,3,3,3,4,4,4,4,4],P), C)).
% 63,090,949 inferences, 3.958 CPU in 3.958 seconds (100% CPU, 15941609 Lips)
C = 12612600.

It remains to handle lists containing variables. The heavy lifting in all of this is done by select/3. All we need is to "just" implement a reified select_t/4 similarly to memberd_t/3. Unfortunately I haven't managed to do this so far. Suggestions are very welcome, or for someone to take this approach and run with it.

Edit: And now with fully pure support for arbitrary lists

I was thinking too complicated above: select/3 is not needed, nor any reified version of it. The above version uses select/3 for a relation that (operationally) adds an element to a multiset: If there is already an equivalence class containing X, it is extended by another X element, whereas if there isn't such a class, a new class [X] is added.

But we can write this much more directly as well:

list_multiset([], []).
list_multiset([X | Xs], Multiset) :-
    list_multiset(Xs, Multiset0), 
    multiset_elem_inserted(Multiset0, X, Multiset).

multiset_elem_inserted([],                  X, [[X]]).
multiset_elem_inserted([[X|Xs] | Classes],  X, [[X,X|Xs] | Classes]).
multiset_elem_inserted([[Y|Ys] | Classes0], X, [[Y|Ys] | Classes]) :-
    dif(X, Y),
    multiset_elem_inserted(Classes0, X, Classes).

This handles variables correctly, enumerating on backtracking all possible ways of constraining any pair of terms in the list with =/2 or dif/2:

?- list_multiset([X, Z, X, Y], Multiset).
X = Z, Z = Y,
Multiset = [[Y, Y, Y, Y]] ;
X = Y,
Multiset = [[Y, Y, Y], [Z]],
dif(Z, Y) ;
Z = Y,
Multiset = [[Y, Y], [X, X]],
dif(X, Y),
dif(X, Y) ;
X = Z,
Multiset = [[Y], [Z, Z, Z]],
dif(Z, Y),
dif(Z, Y),
dif(Z, Y) ;
Multiset = [[Y], [X, X], [Z]],
dif(X, Y),
dif(X, Y),
dif(Z, Y),
dif(Z, X) ;
false.

And this carries over to the distinct permutations too (we can now remove the must_be from distinct_permutation):

?- distinct_permutation([X, Y], Permutation).
X = Y,
Permutation = [Y, Y] ;
Permutation = [Y, X],
dif(X, Y) ;
Permutation = [X, Y],
dif(X, Y) ;
false.

?- distinct_permutation([X, Y], Permutation), X = Y.
X = Y,
Permutation = [Y, Y] ;
false.

?- distinct_permutation([X, Y], Permutation), dif(X, Y).
Permutation = [Y, X],
dif(X, Y),
dif(X, Y) ;
Permutation = [X, Y],
dif(X, Y),
dif(X, Y) ;
false.