Prolog compute the permutation - prolog

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...

Related

A Prolog program for permutation parity

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.

How to program in Prolog a function that does operations on lists

How can I make a program in Prolog that contains n numbers of a and n numbers of b, it's important to note here that the number of a and b in the list must be equal, also the list must always start with a and finish with b, otherwise it's false. Example : [a,b] is true, [a,a,a,b,b,b] is true, [a,a,a,a] is false and [a,a,a,b,b] is also false.
Here is what I tried to do :
langageB([b]).
langageB([b| S]):- langageB(S).
language([]).
langage([a,b]).
langage([a | S]):- langage(S).
langage([a| S]):- langageB(S).
But it does not work as I want it to.
Using DCG notation, the desired language can be defined as:
langage --> [a,b].
langage --> [a], langage, [b]. % For each a at the beginning of the list
% there must be a corresponding b at the end
langage(List) :- phrase(langage, List).
Examples:
?- langage([a,a,a,b,b,b]).
true .
?- langage([a,a,b,b,b]).
false.
?- langage(L).
L = [a, b] ;
L = [a, a, b, b] ;
L = [a, a, a, b, b, b] ;
L = [a, a, a, a, b, b, b, b] .
If you want to see how to define the predicate directly using difference lists, you can list the clauses of the predicate langage/2:
?- listing(langage).
langage([a, b|A], A).
langage([a|A], B) :-
langage(A, C),
C=[b|B].
So, an alternative solution is:
langage(List) :-
langage(List, []).
langage([a, b|A], A).
langage([a|A], B) :-
langage(A, C),
C = [b|B].
langage --> [a], ( [] | langage ) , [b].
?- phrase(langage, Xs).
Xs = "ab"
; Xs = "aabb"
; Xs = "aaabbb"
; Xs = "aaaabbbb"
; Xs = "aaaaabbbbb"
; ... .
Assuming e.g. [a, b, a, b] is an acceptable list:
go :-
findnsols(20, ABs, ab_list(ABs), ABsLst), !,
writeln(ABsLst).
ab_list(ABsWrapped) :-
length(ABs, Len),
ab_list_(Len, 0, [], ABs),
append([[a], ABs, [b]], ABsWrapped).
ab_list_(0, 0, ABs, ABs) :- !.
ab_list_(CharsToAdd, Bal, SoFar, ABs) :-
succ(CharsToAdd0, CharsToAdd),
add_char(Char, Inc),
Bal1 is Bal + Inc,
% Ensure that the balance can be zero for the complete list
CharsToAdd0 >= abs(Bal1),
ab_list_(CharsToAdd0, Bal1, [Char|SoFar], ABs).
add_char(b, -1).
add_char(a, 1).
Results:
?- time(go).
[[a,b],[a,a,b,b],[a,b,a,b],[a,a,a,b,b,b],[a,a,b,a,b,b],[a,b,a,a,b,b],[a,a,b,b,a,b],[a,b,a,b,a,b],[a,b,b,a,a,b],[a,a,a,a,b,b,b,b],[a,a,a,b,a,b,b,b],[a,a,b,a,a,b,b,b],[a,b,a,a,a,b,b,b],[a,a,a,b,b,a,b,b],[a,a,b,a,b,a,b,b],[a,b,a,a,b,a,b,b],[a,a,b,b,a,a,b,b],[a,b,a,b,a,a,b,b],[a,b,b,a,a,a,b,b],[a,a,a,b,b,b,a,b]]
% 935 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 1419728 Lips)
Original: Here's a (very inefficient) solution as a one-liner in swi-prolog:
length(As, 2), same_length(As, Bs), maplist(=(a), As), maplist(=(b), Bs), append([As, Bs], ABs), distinct(ABsPerm, permutation(ABs, ABsPerm)), append([[a], ABsPerm, [b]], Final).

Prolog Out of stack error

I'm working on Problem 26 from 99 Prolog Problems:
P26 (**) Generate the combinations of K distinct objects chosen from
the N elements of a list
Example:
?- combination(3,[a,b,c,d,e,f],L).
L = [a,b,c] ;
L = [a,b,d] ;
L = [a,b,e] ;
So my program is:
:- use_module(library(clpfd)).
combination(0, _, []).
combination(Tot, List, [H|T]) :-
length(List, Length), Tot in 1..Length,
append(Prefix, [H], Stem),
append(Stem, Suffix, List),
append(Prefix, Suffix, SubList),
SubTot #= Tot-1,
combination(SubTot, SubList, T).
My query result starts fine but then returns a Global out of stack error:
?- combination(3,[a,b,c,d,e,f],L).
L = [a, b, c] ;
L = [a, b, d] ;
L = [a, b, e] ;
L = [a, b, f] ;
Out of global stack
I can't understand why it works at first, but then hangs until it gives Out of global stack error. Happens on both SWISH and swi-prolog in the terminal.
if you try to input, at the console prompt, this line of your code, and ask for backtracking:
?- append(Prefix, [H], Stem).
Prefix = [],
Stem = [H] ;
Prefix = [_6442],
Stem = [_6442, H] ;
Prefix = [_6442, _6454],
Stem = [_6442, _6454, H] ;
...
maybe you have a clue about the (main) problem. All 3 vars are free, then Prolog keeps on generating longer and longer lists on backtracking. As Boris already suggested, you should keep your program far simpler... for instance
combination(0, _, []).
combination(Tot, List, [H|T]) :-
Tot #> 0,
select(H, List, SubList),
SubTot #= Tot-1,
combination(SubTot, SubList, T).
that yields
?- aggregate(count,L^combination(3,[a,b,c,d,e],L),N).
N = 60.
IMHO, library(clpfd) isn't going to make your life simpler while you're moving your first steps into Prolog. Modelling and debugging plain Prolog is already difficult with the basic constructs available, and CLP(FD) is an advanced feature...
I can't understand why it works at first, but then hangs until it gives Out of global stack error.
The answers Prolog produces for a specific query are shown incrementally. That is, the actual answers are produced lazily on demand. First, there were some answers you expected, then a loop was encountered. To be sure that a query terminates completely you have to go through all of them, hitting SPACE/or ; all the time. But there is a simpler way:
Simply add false at the end of your query. Now, all the answers are suppressed:
?- combination(3,[a,b,c,d,e,f],L), false.
ERROR: Out of global stack
By adding further false goals into your program, you can localize the actual culprit. See below all my attempts: I started with the first attempt, and then added further false until I found a terminating fragment (failure-slice).
combination(0, _, []) :- false. % 1st
combination(Tot, List, [H|T]) :-
length(List, Length), Tot in 1..Length, % 4th terminating
append(Prefix, [H], Stem), false, % 3rd loops
append(Stem, Suffix, List), false, % 2nd loops
append(Prefix, Suffix, SubList),
SubTot #= Tot-1, false, % 1st loops
combination(SubTot, SubList, T).
To remove the problem with non-termination you have to modify something in the remaining visible part. Evidently, both Prefix and Stem occur here for the first time.
The use of library(clpfd) in this case is very suspicious. After length(List, Length), Length is definitely bound to a non-negative integer, so why the constraint? And your Tot in 1..Length is weird, too, since you keep on making a new constrained variable in every step of the recursion, and you try to unify it with 0. I am not sure I understand your logic overall :-(
If I understand what the exercise is asking for, I would suggest the following somewhat simpler approach. First, make sure your K is not larger than the total number of elements. Then, just pick one element at a time until you have enough. It could go something like this:
k_comb(K, L, C) :-
length(L, N),
length(C, K),
K =< N,
k_comb_1(C, L).
k_comb_1([], _).
k_comb_1([X|Xs], L) :-
select(X, L, L0),
k_comb_1(Xs, L0).
The important message here is that it is the list itself that defines the recursion, and you really don't need a counter, let alone one with constraints on it.
select/3 is a textbook predicate, I guess you should find it in standard libraries too; anyway, see here for an implementation.
This does the following:
?- k_comb(2, [a,b,c], C).
C = [a, b] ;
C = [a, c] ;
C = [b, a] ;
C = [b, c] ;
C = [c, a] ;
C = [c, b] ;
false.
And with your example:
?- k_comb(3, [a,b,c,d,e,f], C).
C = [a, b, c] ;
C = [a, b, d] ;
C = [a, b, e] ;
C = [a, b, f] ;
C = [a, c, b] ;
C = [a, c, d] ;
C = [a, c, e] ;
C = [a, c, f] ;
C = [a, d, b] ;
C = [a, d, c] ;
C = [a, d, e] ;
C = [a, d, f] ;
C = [a, e, b] ;
C = [a, e, c] . % and so on
Note that this does not check that the elements of the list in the second argument are indeed unique; it just takes elements from distinct positions.
This solution still has problems with termination but I don't know if this is relevant for you.

Prolog - List Member with K

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.

Prolog , Append with no repititions

Hey I'm trying to append two list with no "double" members
for example
A = [a, b, c]
B = [x, c, q]
then ->
append2(A,B,P)
P= [a,b,c,x,q]
I write this code, but it doesn't work...
not_member(_, []).
not_member(X, [Y|Ys]) :- X \= Y, not_member(X, Ys).
append2(A, [], A).
append2([], A, A).
append2([h1|ls], B, [h1|P]) :- not_member(h1, B), !, append2(ls, B, P).
append2([h1|ls], B, P) :- member(h1, P), append2(ls, B, P).
Thanks for helping :)
Assuming there are no variables in your input lists, but allowing duplicates in each list you may write:
append2(A,B,C):-
findall(Item, append2_item(A,B,Item), C).
append2_item(A,_,ItemA):-
append(HeadA, [ItemA|_], A),
\+ member(ItemA, HeadA).
append2_item(A,B,ItemB):-
append(HeadB, [ItemB|_], B),
\+ member(ItemB, HeadB),
\+ member(ItemB, A).
First clause of append2_item/3 selects (ordered) distinct items from the first list. Second clause of append2_item/3 selects (ordered) distinct items from the second list which are not present in the first list.
append2/3 just collects those elements.
Test case:
?- append2([a,b,c,a],[x,c,q,x],C).
C = [a, b, c, x, q].
Check out the pure code in my answer
to the related question "intersection and union of 2 lists"!
Telling from your requirements, predicate list_list_union/3 is just what you are looking for:
?- list_list_union([a,b,c],[x,c,q],Ls).
Ls = [a,b,c,x,q]. % succeeds deterministically
list_list_union/3 is monotone, so we get sound answers
even when using non-ground terms:
?- As = [_,_,_], Bs = [_,_,_], list_list_union(As,Bs,Ls), As = [a,b,c], Bs = [x,c,q].
As = [a,b,c], Bs = [x,c,q], Ls = [a,b,c,x,q] ; % logically sound result
false.

Resources