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.
Related
I have been asked to
define a predicate subseq/2, with signature subseq(-,+),
which is true when both its arguments are lists, and its first
argument can be constructed by removing zero or more elements
from its second argument.
... with intended solution order:
?- subseq(X, [a, b, c]).
X = [a, b, c] ;
X = [a, b] ;
X = [a, c] ;
X = [a] ;
X = [b, c] ;
X = [b] ;
X = [c] ;
X = [].
My code:
subseq([], []).
subseq([], [_|_]).
subseq([X|XS], [X|YS]) :- subseq(XS, YS).
subseq([X|XS], [_|YS]) :- subseq([X|XS], YS).
My code's solution order:
?- subseq(X, [a, b, c]).
X = []
X = [a]
X = [a, b]
X = [a, b, c]
X = [a, c]
X = [b]
X = [b, c]
X = [c] ;
false.
How do I achieve the intended solution order?
In Prolog, the order of the rules is crucial. To get the desired output, simply change the order of the rules, like this:
subseq([X|XS], [X|YS]) :- subseq(XS, YS).
subseq([X|XS], [_|YS]) :- subseq([X|XS], YS).
subseq([], []).
subseq([], [_|_]).
?- subseq(X,[a,b,c]).
X = [a, b, c]
X = [a, b]
X = [a, c]
X = [a]
X = [b, c]
X = [b]
X = [c]
X = []
Little tweaks can change the order:
sub_list_forwards(Sub, Long) :-
sub_list_forwards_(Long, Sub).
sub_list_forwards_([], []).
% Either pick H, or don't
sub_list_forwards_([H|T], S) :-
(S = Sub ; S = [H|Sub]),
sub_list_forwards_(T, Sub).
Result in swi-prolog:
?- sub_list_forwards(S, [a,b,c]).
S = [] ;
S = [c] ;
S = [b] ;
S = [b, c] ;
S = [a] ;
S = [a, c] ;
S = [a, b] ;
S = [a, b, c].
Or tweak the selection line to be:
(S = [H|Sub] ; S = Sub),
... which results in the order you were given:
?- sub_list_forwards(S, [a,b,c]).
S = [a, b, c] ;
S = [a, b] ;
S = [a, c] ;
S = [a] ;
S = [b, c] ;
S = [b] ;
S = [c] ;
S = [].
Note that neither of these leave an unwanted choicepoint at the end, because they use first-argument indexing on [] vs [H|T] with 1 selection each.
Does the order matter? What would be an optimum order? It probably varies.
In general it is best to put the base case (i.e. [], []) first, for flexibility (and because they sometimes contain a cut).
This is programming, rather than mathematics, so meaningful variable names/initials are far better for readability than using the likes of X and Y continually.
Using (S = [H|Sub] ; S = Sub), produces the sensible:
?- nth1(5, L, e), sub_list_forwards([a,b,c], L).
L = [a, b, c, _, e] ;
L = [a, b, c, _, e, _] ;
L = [a, b, c, _, e, _, _] ;
L = [a, b, c, _, e, _, _, _] ;
... rather than a stack overflow, and so is preferable.
I wrote this small program in Prolog.
odd_even_flip(odd, even).
odd_even_flip(even, odd).
% flip_one, for A = a, B = b, P = [a, .., b, ..], gives M = [b, .., a, ..]
flip_one(A, B, P, M) :-
append([A|As], [B|Bs], P),
append([B], As, L),
append([A], Bs, R),
append(L, R, M).
permutation_parity([X|L], [X|P], R) :- permutation_parity(L, P, R).
% abc
permutation_parity([X|L], [Y|P], R) :-
X \= Y,
flip_one(Y, X, [Y|P], M),
permutation_parity([X|L], M, Res),
odd_even_flip(Res, R).
permutation_parity([], [], even).
I expect it to find the parity of a permutation P of list L. The few queries that assert that a given permutation of a given list is indeed even or odd worked fine.
However, from my experience with Prolog, I would expect that permutation_parity([a, b, c], X, Y). would show me all permutations of [a, b, c] but that is not happening.
Rather, I get X = [a, b, c], Y = even. and that is all.
I tried to add member(Y, L) in the rule that follows %abc as I was thinking that will help Prolog to know how to instantiate X in permutation_parity([a, b, c], X, Y) but that helped to no avail.
If someone could help me see what I am missing it would be great. Thanks in advance.
You only need to use unification to correctly instantiate the variable X (assuming that permutation_parity/3 is called with a proper list as its first argument). So I suggest you modify your code as follows:
permutation_parity([], [], even).
permutation_parity([X|Xs], [X|Zs], P) :-
permutation_parity(Xs, Zs, P).
permutation_parity([X|Xs], Zs, P) :-
permutation_parity(Xs, Ys, Q),
flip_first([X|Ys], Zs),
odd_even_flip(Q, P).
flip_first(L0, L1) :-
append([X|Xs], [Y|Ys], L0),
append([Y|Xs], [X|Ys], L1).
odd_even_flip(odd, even).
odd_even_flip(even, odd).
Examples:
?- permutation_parity([a,b,c], Permutation, Parity).
Permutation = [c, a, b],
Parity = even ;
Permutation = [b, c, a],
Parity = even ;
Permutation = [b, a, c],
Parity = odd ;
Permutation = [c, b, a],
Parity = odd ;
Permutation = [a, c, b],
Parity = odd ;
Permutation = [a, b, c],
Parity = even.
?- permutation_parity([a,b,c], [a,c,b], Parity).
Parity = odd ;
false.
?- permutation_parity([a,b,c], Permutation, even).
Permutation = [c, a, b] ;
Permutation = [b, c, a] ;
Permutation = [a, b, c].
EDIT
perm_parity(L0, L1, P) :-
same_length(L0, L1),
permutation_parity(L0, L1, P).
The predicate same_length/2 is defined in SWI-Prolog as follows:
same_length([], []).
same_length([_|T1], [_|T2]) :-
same_length(T1, T2).
Example:
?- perm_parity(L, [a,b,c], P).
L = [b, c, a],
P = even ;
L = [c, a, b],
P = even ;
L = [b, a, c],
P = odd ;
L = [c, b, a],
P = odd ;
L = [a, c, b],
P = odd ;
L = [a, b, c],
P = even.
listMem(L, K, LK): LK is the list L with element K inserted in it somewhere.
I am having trouble writing this function, but my attempt goes as so:
My idea was to add K to L, then sort it and check if that sorted was the same as LK, unfortunately it doesn't work so well. I am having doubts of my use of the append predicate.
listMem(L, K, LK) :- append(L, K, Y), sort(Y, LK).
Since it seems you are missing the difference between a function and a Prolog predicate:
?- select(E, [a,b,c], L).
E = a,
L = [b, c] ;
E = b,
L = [a, c] ;
E = c,
L = [a, b] ;
false.
?- select(x, L, [a,b,c]).
L = [x, a, b, c] ;
L = [a, x, b, c] ;
L = [a, b, x, c] ;
L = [a, b, c, x] ;
false.
?- select(x, [a,b,c], L).
false.
In a sense, "select" as a word means less than what select/3 does, but, as CapelliC pointed out, what you are looking for is indeed select/3. You can see how it is implemented in any Prolog textbook or check out the library implementation of an open-source Prolog implementation.
I am supposed to write a program in Prolog which when given a list,returns the permutation of its powerset.
one thing I forgot to mention: I already have a predicate that reverses a list: deep_reverse(List,RevList).
for example: ?-sublist_perm([a,b,c],X).
will return:(duplicates are allowed)
X = [] ;
X = [c] ;
X = [b] ;
X = [b, c] ;
X = [c, b] ;
X = [a] ;
X = [a, c] ;
X = [c, a] ;
X = [a, b] ;
X = [b, a] ;
X = [a, b, c] ;
X = [b, a, c] ;
X = [b, c, a] ;
X = [a, c, b] ;
X = [c, a, b] ;
X = [c, b, a]
You ask two things in one question: How to get all sublists and how to permutate a list:
sublist_perm(In, Out) :-
sublist(In, Temp),
permutation(Temp, Out).
sublist([], []).
sublist([_|XS], YS) :-
sublist(XS, YS).
sublist([X|XS], [X|YS]) :-
sublist(XS, YS).
See also: man page for permutation/2.
findall(X, sublist_perm([a,b,c], X), XS),
XS = [[],[c],[b],[b,c],[c,b],[a],[a,c],[c,a],[a,b],[b,a],
[a,b,c],[b,a,c],[b,c,a],[a,c,b],[c,a,b],[c,b,a]].
I have a predicate variablize/3 that takes a list and replaces each item, in turn, with a variable, example:
% ?- variablize([a,b,c], X, L).
% L = [[X, b, c], [a, X, c], [a, b, X]]
Now I am trying to extend this predicate to accept a list of variables, example:
% ?- variablize([a,b,c], [X,Y], L).
% L = [[X, Y, c], [X, b, Y], [a, X, Y]]
My code so far is:
replace_at([_|Tail], X, 1, [X|Tail]).
replace_at([Head|Tail], X, N, [Head|R]) :- M is N - 1, replace_at(Tail, X, M, R).
replace_each([], _, _, [], _).
replace_each([_|Next], Orig, X, [Res|L], N) :-
replace_at(Orig, X, N, Res),
M is N + 1,
replace_each(Next, Orig, X, L, M).
variablize(I, X, L) :- replace_each(I, I, X, L, 1).
Any pointers? Do I extend replace_at/4 to have a list of indexes that should be skipped?
A simplified, builtin based way of implementing variablize/3
variablize(I, X, L) :-
bagof(R, U^select(U, I, X, R), L).
put in evidence that instead of select/4 we could have a distribute/3 that applies replacements of elements of X, when X becomes a list. select/4 can be implemented in this way
myselect(B, I, X, R) :-
append(A, [B|C], I), append(A, [X|C], R).
and this form is convenient because we have the part to the right of input list I, where I suppose you need to distribute remaining variables. Then a recursion on X elements should do:
distribute(I, [X|Xs], L) :-
append(A, [_|C], I),
distribute(C, Xs, R),
append(A, [X|R], L).
distribute(I, [], I).
distribute/3 behaves this way:
?- distribute([a,b,c,d],[1,2],X).
X = [1, 2, c, d] ;
X = [1, b, 2, d] ;
X = [1, b, c, 2] ;
X = [a, 1, 2, d] ;
X = [a, 1, c, 2] ;
X = [a, b, 1, 2] ;
false.
thus
variablize_l(I, X, L) :-
bagof(R, distribute(I, X, R), L).
give us:
?- variablize_l([a,b,c],[X,Y],L).
L = [[X, Y, c], [X, b, Y], [a, X, Y]].
edit
I initially wrote this way, for here the evidence of separating the distribution phase from list construction:
replace_v([_|T], X, [X|T]).
replace_v([L|T], X, [L|R]) :-
replace_v(T, X, R).
variablize(I, X, L) :-
bagof(E, replace_v(I, X, E), L).
variablize(L1,L2,L) :-
append(L1,L2,L3),
length(L1,Len1),
length(L2,Len2),
findall(L4,(combination(L3,Len1,L4),var_count(L4,Len2)),L).
combination(X,1,[A]) :-
member(A,X).
combination([A|Y],N,[A|X]) :-
N > 1,
M is N - 1,
combination(Y,M,X).
combination([_|Y],N,A) :-
N > 1,
combination(Y,N,A).
var_count([],0).
var_count([V|R],N) :-
var(V),
var_count(R,N1),
N is N1 + 1,
!.
var_count([A|R],N) :-
var_count(R,N).