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...
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.
I am currently working on an encoding program in prolog.
In the first place I want to cut a word in pieces
For example: friends should look like:
[[F,R,I][R,I,E][I,E,N][E,N,D][N,D,S]]
For the moment I have something like this but can't understand why is the program not working when I try on a word.
It is always answering false.
couper([X1,X2,X3|L],[L1|ResQ]):-
L1 = [X1,X2,X3],
couper([X2,X3|L],ResQ).
couper([_,_|[]] , []).
couper([] , []).
couper([_|[]] , []).
Your program seems to work:
?- atom_chars(alpha,L),couper(L,Triplets).
L = [a, l, p, h, a],
Triplets = [[a, l, p], [l, p, h], [p, h, a]] ;
Although it can be written easier:
couper([X1,X2,X3|L],[[X1,X2,X3]|ResQ]):-
couper([X2,X3|L],ResQ).
couper([_,_] , []). % Only two chars left or only two to begin with
couper([_] , []). % Only one char to begin with
couper([] , []). % No chars to begin with
You can also try:
?- findall([A,B,C], append(_,[A,B,C|_],[f,r,i,e,n,d,s]), T).
T = [[f, r, i], [r, i, e], [i, e, n], [e, n, d], [n, d, s]].
As a rule:
couper(L, T) :-
findall([A,B,C], append(_, [A,B,C|_], L), T).
Examples:
?- couper([f,r,i,e,n,d,s], T).
T = [[f, r, i], [r, i, e], [i, e, n], [e, n, d], [n, d, s]].
?- couper([e,x,a,m,p,l,e,s], T).
T = [[e, x, a], [x, a, m], [a, m, p], [m, p, l], [p, l, e], [l, e, s]].
?- couper([t,w,o], T).
T = [[t, w, o]].
?- couper([t,o], T).
T = [].
NOTE In Prolog, uppercase letters are variables. Thus, the predicate must be called with a list of lowercase letters (perhaps, this is the cause of your problem).
I have list structure
L=[[a,b,c,d],[a,f,c,h]]
Length of L can be greater than 2.I want to unite the elements of list so that L or a NewL become
L=[a,[b,f],c,[d-h]]
This is probably what you want:
unite([[],[]], []).
unite([[X|Ls], [X|Rs]], [X|Rest]) :- unite([Ls, Rs], Rest).
unite([[L|Ls], [R|Rs]], [[L,R]|Rest]) :- L \= R, unite([Ls, Rs], Rest).
However, I agree with #false because this is a strange API and there are a lot of unhandled edge cases.
What you're requiring is an aggregation schema. I think I got it:
unite(Ls, [E|Es]) :-
aggreg(Ls, E, Ns),
unite(Ns, Es).
unite(_, []).
aggreg(L, E, LLs) :-
maplist(first, L, Fs, LLs),
setof(X, member(X, Fs), S),
( [E] = S -> true ; E = S ).
first([E|Es], E, Es).
yields
?- L=[[a,b,c,d],[a,f,c,h],[a,f,c,g]],unite(L,U).
L = [[a, b, c, d], [a, f, c, h], [a, f, c, g]],
U = [a, [b, f], c, [d, g, h]] ;
L = [[a, b, c, d], [a, f, c, h], [a, f, c, g]],
U = [a, [b, f], c] .
I think that a cut after the first solution would be well placed (use once/1 for that).
Note that the schema it's rather general: just substitute in setof/3 some more applicative task (if any) than unification (you could call into your DB, for instance).
I'm writing a permutation function [a,b]-->[[[a], [b]], [[a, b]]
I have this so far, but it doesn't work.
perm([],[]).
perm(L,[H|T]) :- append(V,[H|U],L), append(V,U,W), perm(W,T).
Given your example, it looks like you might actually be wanting the powerset, not the permutation, of the given list.
For instance, the powerset of [a,b] is the set {[a,b], [a], [b], []}.
To compute the powerset of a list of items in Prolog, look at this answer by #gusbro. If this helps you, also please upvote that answer.
If you want all solutions of the powerset of a list L at once, you can wrap the call to powerset/2 in a findall/3 call like this:
?- findall(S, powerset(L, S), Ss).
If, on the other hand, you're after the partitions (as you've mentioned in one of your earlier edits), consider the following:
partition(L, PL) :-
partition(L, [], PL).
partition([], [], []).
partition([X|Xs], As, R) :-
% add X into the new partition...
append(As, [X], NewAs),
partition(Xs, NewAs, R).
partition(L, [A|As], [[A|As]|R]) :-
% ...or, collect the current non-empty partition
partition(L, [], R).
The predicate partition/2 takes a list and returns all partitions, as you've described. For example:
?- partition([a,b,c],L).
L = [[a, b, c]] ;
L = [[a, b], [c]] ;
L = [[a], [b, c]] ;
L = [[a], [b], [c]] ;
false.
Really? It seems to work in SWI-Prolog:
?- [user].
|: perm([],[]).
|: perm(L,[H|T]) :- append(V,[H|U],L), append(V,U,W), perm(W,T).
|: % user://1 compiled 0.00 sec, 3 clauses
true.
?- perm([a,b,c], X).
X = [a, b, c] ;
X = [a, c, b] ;
X = [b, a, c] ;
X = [b, c, a] ;
X = [c, a, b] ;
X = [c, b, a] ;
false.
?- perm([a,b,c,d], X).
X = [a, b, c, d] ;
/* trimming 22 solutions */
X = [d, c, b, a] ;
false.
This also yields the number of answers you'd expect: 3! = 6, 4! = 24. What's not working for you?
Quick note: Prolog doesn't offer functions, but relations.
In this case, perm/2 will hold true when the arguments are one the permutation of the other.
I find this definition more readable than your.
perm([], []).
perm([E|Es], P) :-
perm(Es, Q),
select(E, P, Q).
It's almost the same as that of permutation/2 SWI-Prolog, but hides a bug...