Prolog: How to create all possible combinations without repetitions

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.

For ground lists you may do what @GuyCoder suggested: distinct(permutation([1,1,0],L)).

For arbitrary lists you may enumerate all distinct solutions with the help of dif/2:

permutation_no_dup([], []).
permutation_no_dup(L, PL):-
  same_length(L, PL),
  length(L, Len),
  numlist(1,Len, RLMax),
  reverse(RLMax, LMax),
  length(LCur, Len),
  maplist(=(1), LCur),
  permutation_no_dup(LCur, L, LMax/LCur-L, [], PL).
  
permutation_no_dup([], _, _, PL, PL).
permutation_no_dup([], _, LMax/LCur-L, PL, PL1):-
  dif(PL, PL1),
  next(LCur, LMax, NLCur),
  permutation_no_dup(NLCur, L, LMax/NLCur-L, [], PL1).
permutation_no_dup([Take|LCur], L, Info, PL, PL1):-
  nth1(Take, L, Item, L1),
  permutation_no_dup(LCur, L1, Info, [Item|PL], PL1).

next([Cur|LCur], [Max|_], [NCur|LCur]):-
  Cur < Max,
  succ(Cur, NCur).
next([Cur|LCur], [Cur|LMax], [1|NLCur]):-
  next(LCur, LMax, NLCur).

same_length([],[]).
same_length([_|Xs], [_|Ys]) :-
   same_length(Xs, Ys).

Sample run:

?- permutation_no_dup([0,1,1], L).
L = [1, 1, 0] ;
L = [1, 0, 1] ;
L = [0, 1, 1] ;
false.
?- permutation_no_dup([X,Y], L), X=Y.
X = Y,
L = [Y, Y] ;
false.

Update:

With the above code, I get this output with SWI 8.0.2 which is obviously wrong:

?- permutation_no_dup([x,y,Z,Z],P), P=[x,y,z,z].
false.

?- P=[x,y,z,z], permutation_no_dup([x,y,Z,Z],P).
P = [x, y, z, z],
Z = z ;
false.

but rearranging the call to dif/2 in the second clause of permutation_no_dup/5 so it now reads:

permutation_no_dup([], _, _, PL, PL).
permutation_no_dup([], _, LMax/LCur-L, PL, PL1):-
%      dif(PL, PL1),    % <-- removed dif/2 from here
  next(LCur, LMax, NLCur),
  permutation_no_dup(NLCur, L, LMax/NLCur-L, [], PL1),
  dif(PL, PL1).         % <-- Moved dif/2 to here
permutation_no_dup([Take|LCur], L, Info, PL, PL1):-
  nth1(Take, L, Item, L1),
  permutation_no_dup(LCur, L1, Info, [Item|PL], PL1).

Now we get:

?- permutation_no_dup([x,y,Z,Z],P), P=[x,y,z,z].
Z = z,
P = [x, y, z, z] ;
false.

?- P=[x,y,z,z], permutation_no_dup([x,y,Z,Z],P).
P = [x, y, z, z],
Z = z ;
false.