The task is to delete all increasing subseries from a list. For example:
deleteInc([2,4,6,5,8,12,8,3],L) should produce L=[8,3] as result
I tried to solve it, but it's not working properly and I can't figure out the correct solving. Can somebody help me out please with a correct solution? Thanks in advance :)
My Code:
deleteInc([],[]).
deleteInc([H1,H2|T],L):-
H2>=H1,
!,
deleteInc(T,L).
deleteInc([H1,H2|T],[H2|T2]):-
H2<H1,
deleteInc(T,T2).
Here's what I did, assuming it's checking three values at a time:
deleteInc([],[]).
deleteInc([H1,H2,_H3|T],L):-
H2>=H1,
!,
deleteInc(T,L).
deleteInc([H1,H2|T],[H1,H2|T2]):-
H2<H1,!,
deleteInc(T,T2).
Example:
?-deleteInc([2,4,6,5,8,12,8,3],L).
L = [8, 3]
?-deleteInc([2,4,6,5,8,12,15,21,25,7,3],L).
L = [7, 3]
?-deleteInc([2,4,6,5,8,12,15,21,25,55,77,88,65,38],L).
L = [65, 38]
Here's an approach to collect all combinations that are not increasing:
deleteInc(L,[],L).
deleteInc([H1,H2|T],L,Rest):-
H2>=H1,
!,
deleteInc(T,L,Rest).
deleteInc([H1,H2|T],[H1,H2|L],Rest):-
H2<H1,!,
deleteInc(T,L,Rest).
Example:-
?-deleteInc([2,4,6,5,8,12,15,21,25,55,77,88,65,38],L,_).
L = []
L = []
L = [6, 5]
L = [6, 5]
L = [6, 5]
L = [6, 5]
L = [6, 5]
L = [6, 5, 65, 38]
?-deleteInc([2,4,6,5,8,12,15,21,25,7,3],L,_).
L = []
L = []
L = [6, 5]
L = [6, 5]
L = [6, 5]
L = [6, 5, 25, 7]
?-deleteInc([2,4,6,5,8,12,8,3],L,_).
L = []
L = []
L = [6, 5]
L = [6, 5]
L = [6, 5, 8, 3]
I would implement it like this:
deleteInc(In, Out):-
deleteInc(In,Out,new).
deleteInc([A],[A],new).
deleteInc([_],[],incr).
deleteInc([H1,H2|T],L,_):-
H2>=H1,
!,
deleteInc([H2|T],L,incr).
deleteInc([H1,H2|T],T2,incr):-
H2<H1,
deleteInc([H2|T],T2,new).
deleteInc([H1,H2|T],[H1|T2],new):-
H2<H1,
deleteInc([H2|T],T2,new).
A third attribute indicates if your are currently in a new or increasing streak.
If the two head elements of the list are in increasing order, the third element is pretty much ignored. Please note to forward not the list T but [H2|T] since you need the element H2 for further comparison. If you are in a streak (incr) and the current two head elements are not increasing, you do the same as before: ignore. However if you just started a new streak and the current head elements are decreasing, you put the first head element in the return list. Special cases for one element. Let's check:
?- deleteInc([2,4,6,5,8,12,8,3],L).
L = [8, 3] ;
false.
Looks good.
Another approach would be to just check for 3 succeeding elements if the middle one is smaller than the first but larger than the third. If this is the case: store the element. If this is is not the case: check the list without the first head element.
Add a rule for 2 elements left. Also there needs to be a special treatment for the very first element, because this is not covered in the main rule. By using the cut you can "catch" the left over case (two increasing elements or weird input with one or no element) with the last line. Please note that the order of the rules is important for the program to work.
deleteInc([H1,H2|L], [H1|R]):-
H1 >= H2,
!,
deleteInc1([H1,H2|L], R).
deleteInc([H1,H2|L], R):-
deleteInc1([H1,H2|L], R).
deleteInc1([H1,H2,H3|L], [H2|R]):-
H1 > H2,
H2 > H3,
!,
deleteInc1([H2,H3|L], R).
deleteInc1([A,B],[B]):-
A > B,
!.
deleteInc1([_|L], R):-
!,
deleteInc1(L, R).
deleteInc1(_,[]).
Let's test it:
?- deleteInc([2,4,6,5,8,12,8,3],L).
L = [8, 3].
Works (for lists of numbers).
And yet another solution would be to count the length of the streak and to filter out all results which have more than one element. The following code starts with count 0 for the first element and uses the successor predicate s/1 for counting:
deleteInc(In, Out):-
countInc(In,0,InC),
delInc(InC,Out).
countInc([A], C, [(A,C)]).
countInc([A,B|L], C, Out):-
A =< B,
countInc([B|L], s(C), Out).
countInc([A,B|L], C, [(A,C)|Out]):-
A > B,
countInc([B|L], 0, Out).
delInc([],[]).
delInc([(E,0)|L],[E|R]):-
delInc(L,R).
delInc([(_,s(_))|L],R):-
delInc(L,R).
Output:
?- deleteInc([2,4,6,5,8,12,8,3],L)
L = [8, 3] ;
false.
As expected
Related
I'm writing a predicate for finding the bigger number in pairs. If the number has no pair - it will be just added.
write_list([A|[]]):- write(A).
write_list([A, B|Tail]) :- ((A>B, write(A));(A<B,write(B))), nl,
write_list([B|Tail]).
My problem is, I cannot figure out how to write a result in another list instead of printing the result out:
write_list([1,2,6,8,5], X).
X = [2,6,8,8,5].
write only prints the content to the standard output, it does not "yield" it to the result list. In Prolog the only way to generate values, is through unification.
You thus need to define a predicate maxpair/2, not write_list/1.
The predicate thus looks like:
:- use_module(library(clpfd)).
maxpair([A], [A]).
maxpair([A, B|Tail], [H|T]) :-
H #= max(A, B),
maxpair([B|Tail], T).
The first clause says that the maxpair/2 of a singleton list is that singleton list. The latter says that the maxpair/2 for a list containing two or more lists is a list that starts with the maximum of the first two elements, and we recurse on the tail of the list.
The above can also yield a list in reverse. For example:
?- write_list(L, [5, 3, 2, 1]).
L = [5, 3, 2, 1] ;
false.
?- write_list(L, [1, 4, 2, 5]).
false.
?- write_list(L, [3, 3, 5, 5]).
L = [_542, _548, _554, 5],
_542 in inf..3,
3#=max(_542, _548),
_548 in inf..3,
3#=max(_548, _554),
_554 in inf..3 ;
false.
?- write_list(L, [3, 5, 5, 4]).
L = [_1128, _1134, 5, 4],
_1128 in inf..3,
3#=max(_1128, _1134),
_1134 in inf..3 ;
false.
So depending on the situation it can:
fully reconstruct the list;
construct a list with some variables with intervals; or
proof that it is impossible to construct such a list.
I am really sorry for previous question, it's my first time post question on this website and I really didn't know I shouldn't post quesion like that.
It was my first time using prolog. Actually I spent more than 5 hours on this question but still cannot fully solve it, I tried to tear this question apart and here is what remain to be solved:
How to put the successive increasing whole numbers into a sublist in origin list.
eg. [3,5,1,2,3,7,8,2] to [3,5,[1,2,3],[7,8],2]
Here is what I wrote, can someone tell me how to fix the code? Thanks.
% empty List
chop_up([], []).
% single item list
chop_up([X], [X]).
% continue if the first number is not part of a sequence
chop_up(List, NewList):-
List = [First | Tail],
Tail = [Second | _],
First =\= Second - 1,
chop_up(Tail, NewList2),
NewList = [First | NewList2].
% if it is part of a sequence
chop_up(List, NewList):-
List = [First | Tail],
Tail = [Second | Tail2],
First is Second - 1,
chop_up(Tail, NewList2),
NewList = [[First] | NewList2].
enter image description here
Thank you for updating your question to show us what you tried!
Like all Prolog beginners, you are trying to do too much at once. This is normal! But you have to learn and get used to a way of thinking that is different from other programming languages. Almost always you have to decompose your problem into several subproblems that you then put together to get the final program.
So let's try to solve only one part of the problem first: Given a nonempty list, decompose it into successive elements at the front and into all the remaining elements. That is, we want something like this:
?- list_successive_rest([1, 2, 4, 3], Succ, Rest).
Succ = [1, 2],
Rest = [4, 3] .
If we can write this definition, then we should be able to iterate over the Rest to chop it up further.
Here is a definition of list_successive_rest/3. Note how it follows the structure of your attempt for chop_up/2, but it's shorter and simpler because we only look at a successive prefix of the list, not all of the list at once:
list_successive_rest([X], [X], []).
list_successive_rest([A, B | Xs], [A], [B | Xs]) :-
A + 1 =\= B.
list_successive_rest([A, B | Xs], [A | Successive], Rest) :-
A + 1 =:= B,
list_successive_rest([B | Xs], Successive, Rest).
(This is also simpler than your version because I match lists of at least two elements as [A, B | Xs] rather than [A | Tail] and Tail = [B | Tail2]. It's a good idea to get used to this syntax.)
We can call this successively to decompose a list into successive parts:
?- list_successive_rest([1, 2, 4, 3], Succ, Rest), list_successive_rest(Rest, Succ2, Rest2), list_successive_rest(Rest2, Succ3, Rest3).
Succ = [1, 2],
Rest = [4, 3],
Succ2 = [4],
Rest2 = Succ3, Succ3 = [3],
Rest3 = [] ;
false.
Defining chop_up/2 is now easy by using the above predicate to peel off successive prefixes of the list iteratively:
chop_up([], []).
chop_up(List, [Succ | Chopped]) :-
list_successive_rest(List, Succ, Rest),
chop_up(Rest, Chopped).
Note that chop_up/2 is recursive, and it uses list_successive_rest/3, which is recursive as well. Trying to write all this in one recursive predicate would be harder and lead to less readable code.
Let's try the above test, and your test case:
?- chop_up([1, 2, 4, 3], Chopped).
Chopped = [[1, 2], [4], [3]] ;
false.
?- chop_up([3,5,1,2,3,7,8,2], Chopped).
Chopped = [[3], [5], [1, 2, 3], [7, 8], [2]] ;
false.
This doesn't actually produce the exact format you wanted: Singleton elements are singleton lists rather than "naked" members of the outer list. I think this is better this way, but your teacher may disagree. In that case, changing this small detail is an exercise for you.
I conseived much more elegant way with DCG!
chunk_list([])-->[].
chunk_list([C|Rest])-->chunk(C),chunk_list(Rest).
chunk(Ret)-->[First],consecutive(First,Last),{First=:=Last->Ret is First;Ret = [First,Last]}.
consecutive(Prev,Last)-->[Current],{Current is Prev+1},consecutive(Current,Last).
consecutive(Prev,Prev)-->[].
Test:
?- phrase(chunk_list(R),[1,2,3,6,7,3,3,2,3,4,6],[]).
R = [[1, 3], [6, 7], 3, 3, [2, 4], 6]
maybe it could be reversible with more lavor.
I.E. convert [[1, 3], [6, 7], 3, 3, [2, 4], 6] into [1,2,3,6,7,3,3,2,3,4,6]
I also tried for my prolog training.
terrible program but does work anyway.
I tested this in ECLiPSe but it will work with few modification in other environment(may be only deleting :-lib(listut))
call like this:
chunk([4,5,6,3,4,4,57,3,4,5,7,2,3,4,5,7,7,54,3],Ret).
Program:
:-lib(listut).
chunk(List,Ans):-
chunk_sub(List,0,[],List1),
first_and_lasts(List1,Ans),
!.
chunk_sub([],_,Ret,Reverse):-reverse(Ret,Reverse),!.
chunk_sub([Current|Rest],Prev,[NowList|RetRest],Ret):-
Current =:= Prev+1,
append(NowList,[Current],NextList),
chunk_sub(Rest,Current,[NextList|RetRest],Ret).
chunk_sub([Current|Rest],_,NowList,Ret):-
chunk_sub(Rest,Current,[[Current]|NowList],Ret).
first_and_lasts([],[]):-!.
first_and_lasts([FirstList|RestLists],[Converted|RestRet]):-
length(FirstList,Len),
(
Len=:=1->
([OneElem]=FirstList,Converted=OneElem);
(
nth1(1,FirstList,Smallest),
nth1(Len,FirstList,Biggest),
Converted=[Smallest,Biggest]
)
),
first_and_lasts(RestLists,RestRet).
Finally I did it!
this is reversible(generalized) version.This program works cleverly.
It was very fun developing this.
Code:
chunk_list([])-->[],!.
chunk_list([Chunk|Rest])-->chunk(Chunk),!,chunk_list(Rest).
chunk([First,Last])-->sequence([First,Last]),{First<Last}. % sequence
chunk(Val)-->sequence([Val,Val]). % isolated number
sequence([First,Last])-->
{(number(First),number(Last))->First<Last;true},
[First],
{succ(First,Second)},sequence([Second,Last]).
sequence([Val,Val])-->[Val].
Test:
[eclipse 4]: phrase(chunk_list([2,[2,6],[3,5],3,7,[1,3]]),Ret).
Ret = [2, 2, 3, 4, 5, 6, 3, 4, 5, 3, 7, 1, 2, 3]
Yes (0.00s cpu)
[eclipse 5]: phrase(chunk_list(Ret),[3,4,5,2,1,6,7,88,9,4,5,6,7,2,1,2,3]).
Ret = [[3, 5], 2, 1, [6, 7], 88, 9, [4, 7], 2, [1, 3]]
Yes (0.00s cpu)
[eclipse 6]: phrase(chunk_list([[2,4],A,[2,8],3]),[2,B,4,6,2,C,4,5,6,7,D,E]).
A = 6
B = 3
C = 3
D = 8
E = 3
Yes (0.00s cpu)
I am having a bit of trouble with prolog as I have just started learning it. I am unsure how to test if X is the median of A, B, C. My first thought was to make a list of A, B, C and then sort it. I would then check if X is equal to the second number. The problem being that I don't know how to take three values and turn them into a list (If you can). Is this even the most effecent way to do this? Honestly I have no Idea so any insite would be helpful.
this is a very basic solution, with a sorting only accepting 3 values, but it should make the problem solved.
is_median_of_sorted([_, ValueToCheck, _],ValueToCheck).
sorted_list_of_3([A,B,C],R) :-
A>B, A>C, B>C, R = [A,B,C];
A>C, A>B, C>B, R = [A,C,B];
B>A, B>C, A>C, R = [B,A,C];
B>C, B>A, C>A, R = [B,C,A];
C>A, C>B, A>B, R = [C,A,B];
C>B, C>A, B>A, R = [C,B,A].
is_median_of_3(List, ValueToCheck) :-
sorted_list_of_3(List,SortedList),
is_median_of_sorted(SortedList, ValueToCheck).
To check it, query:
is_median_of_3([1,10,4],4).
Or if you want to check what is the median of a given list:
is_median_of_3([1,10,4],X).
You can also check it via browser at: https://swish.swi-prolog.org/p/three_values_median.pl
What is does is : is_median_of_3 first gets a matching sorted list, and then checks agains is_median_of_sorted, which just picks a 2nd element of the list.
Hope I could help.
If you want to create a modular program, you had to insert all the elements in a list, sort it and find the median. This could be done in this way:
findMedian([H|_],0,H):- !.
findMedian([_|T],C,X):-
C1 is C-1,
findMedian(T,C1,X).
median(L,X):-
msort(L,SortedL),
length(SortedL,Len),
Len2 is Len//2,
findMedian(SortedL,Len2,X).
?- median([1,10,4,5,7],X).
X = 5
?- median([1,10,4,5,7],5).
true
This solution will works also with list with an even number of elements, returning the element after the middle of the list (ex. 4 elements, [0,1,2,3], it returns 2). In this case you have to decide what to do (fail, return the two elements in the middle ecc...)
EDIT: as suggested in the comment, you should use msort/2 instead sort/2 because sort/2 removes duplicated elements.
I would choose a solution similar to #damianodamiano's, but I would find the middle element of a list without using length/2:
median(List, Median) :-
msort(List, SortedList),
middle_element(SortedList, SortedList, Median).
middle_element([], [M|_], M).
middle_element([_], [M|_], M).
middle_element([_,_|Xs], [_|Ys], M) :-
middle_element(Xs, Ys, M).
A simple answer to "check if X is the median of A,B,C?" is:
is_median_of_3(A,B,C,X):-
msort([A,B,C],[_,X,_]).
This will try to match if [A,B,C] sorted consists of any list (of three elements) with X as the middle element.
I don't know everywhere, but in swish there are residuals coming out from msort as such:
msort([2,8,4],L).
L = [2, 4, 8],
_residuals = []
L = [2, 4, 8],
_residuals = [_1080]
L = [2, 4, 8],
_residuals = [_1122, _1128]
L = [2, 4, 8],
_residuals = [_1170, _1176, _1182]
L = [2, 4, 8],
_residuals = [_1224, _1230, _1236, _1242]
L = [2, 4, 8],
_residuals = [_1284, _1290, _1296, _1302, _1308]
L = [2, 4, 8],
_residuals = [_716, _722, _728, _734, _740, _746]
L = [2, 4, 8],
_residuals = [_788, _794, _800, _806, _812, _818, _824]
L = [2, 4, 8],
_residuals = [_866, _872, _878, _884, _890, _896, _902, _908]
and so on...
Also, I couldn't test it in tutorialspoint because it seems broken.
Following a generate & test approach you can write:
median(List,Median) :-
dif(List,[]), msort(List,SList), length(List,Len),
append(Low,[Median],Tmp), append(Tmp,High,SList),
length(Low,LowLen), div(Len,2)=:=LowLen, !.
This has a convenient declarative reading: Median is the value of a non-empty List that splits the sorted version SList of List into two halves Low and High, viz. Median is the "middle element" of the distribution of the values in List.
Indeed, the program above determines Median by checking whether SList can be written as a list concatenation Low + [Median] + High such that the length of Low is half the length of SList. Since High is never used (i.e. it is a singleton), the program can be rewritten by substituting it with _ as in:
median(List,Median) :-
dif(List,[]), msort(List,SList), length(List,Len),
append(Low,[Median],Tmp), append(Tmp,_,SList),
length(Low,LowLen), div(Len,2)=:=LowLen, !.
Naturally, it is also possible to distinguish the case in which the length of the list is odd from the case it is even, so to return the average of the two median elements in the latter case:
median(List,Median) :-
is_list(List), dif(List,[]),
msort(List,SList), length(List,Len),
median(SList,Len,Median).
median(SList,Len,Median) :-
Len mod 2 =:= 1,
append3(Low,[Median],_,SList),
length(Low,LowLen), div(Len,2)=:=LowLen, !.
median(SList,Len,Median) :-
Len mod 2 =:= 0,
append3(Low,[M1,M2],_,SList),
length(Low,LowLen), div(Len,2)=:=LowLen + 1,
Median is (M1+M2)/2, !.
append3(L1,L2,L3,L) :- append(L1,L2,T), append(T,L3,L).
I am trying to find the most common sequence of length N that occurs in a list. So I am supposed to write a predicate common(L,N,X) that gives me this sequence in a form of a list. For example: common([1,2,3,2,3,1,4],2,X) should give me back X=[2,3] ; common([1,2,3,4,2,2,2,3,4],3,X) should give back X=[2,3,4] or common([1,2,3],1,X) should give X=[1] X=[2] X=[3].
I have read a couple of posts when we seek only the most common element (so a case where N=1), but I don`t know how to do it for a general N. I am not allowed to use if-then-else or clpfd.
I was thinking maybe grouping the elements and then ordering them, so for common([1,2,3,2,3,1,4],2,X) make a list like this[[1,2],[2,3],[3,2],[2,3],[3,1],[1,4]] and then order the elements from most common to least.
I like your plan. Here's how I'd get the overlapping subsequences.
First, let's get the prefix of the list of length N:
subsequences(L, N, Sub) :- append(Sub, _, L), length(Sub, N).
This should be read "Sub is a subsequence of length N of list L if Sub, appended to something else yields L, and the length of Sub is N." This will definitely get you a prefix of L of length N. Now let's see the recursive case:
subsequences([_|L], N, Sub) :- subsequences(L, N, Sub).
"Otherwise, find a subsequence in the tail of L." And this will produce multiple solutions:
?- subsequences([1,2,3,2,3,1,4], 2, X).
X = [1, 2] ;
X = [2, 3] ;
X = [3, 2] ;
X = [2, 3] ;
X = [3, 1] ;
X = [1, 4] ;
findall/3 is your friend here, you can use it to build the list you want:
?- findall(X, subsequences([1,2,3,2,3,1,4], 2, X), Subsequences).
Subsequences = [[1, 2], [2, 3], [3, 2], [2, 3], [3, 1], [1, 4]].
Hope this helps!
I want to access list permutation and pass it as argument to other functions.
This is the permutation code:
takeout(X,[X|R],R).
takeout(X,[F|R],[F|S]) :-
takeout(X,R,S),
write(S).
perm([X|Y],Z) :-
perm(Y,W),
takeout(X,Z,W).
perm([],[]).
To start with, let's redefine your predicates so they don't do any unnecessary I/O:
takeout(X,[X|R],R).
takeout(X,[F |R],[F|S]) :- takeout(X,R,S).
perm([X|Y],Z) :- perm(Y,W), takeout(X,Z,W).
perm([],[]).
Now you have what could be considered a "pure" permutation function:
?- perm([1,2,3], X).
X = [1, 2, 3] ;
X = [2, 1, 3] ;
X = [2, 3, 1] ;
X = [1, 3, 2] ;
X = [3, 1, 2] ;
X = [3, 2, 1] ;
false.
So, suppose you have a max_heap function that takes a list of values and produces a tree. I'll let you worry about that, so let's just posit that it exists and is called max_heap/2 and let's further posit that you have a way to display this attractively called display_heap/1. To "take" the permutation and "send" it as a parameter to these functions, you're really saying in math-ese: suppose P is a permutation of X, let's make a max_heap with it and display it. Or, suppose P is a permutation of X, H is a max heap made from X, let's display H:
show_heaps(List) :- perm(List, P), max_heap(P, H), display_heap(H).
This says the same thing as my English sentence: suppose P is a permutation of the list, then H is a heap representation of it, then display it. Technically, display_heap/1 is still a predicate which could be true or false for a given heap. In practice, it will always be true, and if you run this you'll still have to hit ; repeatedly to say, give me another solution, unless you use a failure-driven loop or an extralogical predicate like findall/3 to cause all the solutions to be found.
Edit: Let's discuss failure-driven loops and findall/3. First let me add some new predicates, because I don't know exactly what you're doing, but it doesn't matter for our purposes.
double([X|Xs], [Y|Ys]) :- Y is X*2, double(Xs, Ys).
double([],[]).
showlist(Xs) :- print(Xs).
So now I have a predicate double/2 which doubles the values in the list and a predicate showlist/1 that prints the list on standard output. We can try it out like so:
?- perm([1,2,3], X), double(X, Y), showlist(Y).
[2,4,6]
X = [1, 2, 3],
Y = [2, 4, 6] ;
[4,2,6]
X = [2, 1, 3],
Y = [4, 2, 6] ;
[4,6,2]
X = [2, 3, 1],
Y = [4, 6, 2] ;
[2,6,4]
X = [1, 3, 2],
Y = [2, 6, 4] ;
[6,2,4]
X = [3, 1, 2],
Y = [6, 2, 4] ;
[6,4,2]
X = [3, 2, 1],
Y = [6, 4, 2] ;
false.
When you type ; you're saying, "or?" to Prolog. In other words, you're saying "what else?" You're telling Prolog, in effect, this isn't the answer I want, try and find me another answer I like better. You can formalize this process with a failure-driven loop:
?- perm([1,2,3], X), double(X, Y), showlist(Y), fail.
[2,4,6][4,2,6][4,6,2][2,6,4][6,2,4][6,4,2]
false.
So now you see the output from each permutation having gone through double/2 there, and then Prolog reported false. That's what one means by something like this:
show_all_heaps(List) :- perm(List, X), double(X, Y), showlist(Y), nl, fail.
show_all_heaps(_).
Look at how that works:
?- show_all_heaps([1,2,3]).
[2,4,6]
[4,2,6]
[4,6,2]
[2,6,4]
[6,2,4]
[6,4,2]
true.
The other option is using findall/3, which looks more like this:
?- findall(Y, (perm([1,2,3], X), double(X, Y)), Ys).
Ys = [[2, 4, 6], [4, 2, 6], [4, 6, 2], [2, 6, 4], [6, 2, 4], [6, 4, 2]].
Using this to solve your problem is probably beyond the scope of whatever homework it is you're working on though.
We can define list_permutation/2 based on same_length/2 and select/3 like this:
:- use_module(library(lists),[same_length/2,select/3]).
list_permutation(As,Bs) :-
same_length(As,Bs), % redundant goal helps termination
list_permutation_(As,Bs).
list_permutation_([],[]).
list_permutation_([A|As],Bs0) :-
select(A,Bs0,Bs),
list_permutation_(As,Bs).
Thanks to same_length/2, both of the following queries1,2 terminate universally:
?- list_permutation([1,2,3],Ys).
Ys = [1,2,3]
; Ys = [1,3,2]
; Ys = [2,1,3]
; Ys = [3,1,2]
; Ys = [2,3,1]
; Ys = [3,2,1]
; false.
?- list_permutation(Xs,[1,2,3]).
Xs = [1,2,3]
; Xs = [1,3,2]
; Xs = [2,1,3]
; Xs = [2,3,1]
; Xs = [3,1,2]
; Xs = [3,2,1]
; false.
So far, so good. But what does the answer sequence look like if there are duplicate list items?
?- list_permutation([1,1,1],Ys).
Ys = [1,1,1]
; Ys = [1,1,1]
; Ys = [1,1,1]
; Ys = [1,1,1]
; Ys = [1,1,1]
; Ys = [1,1,1]
; false.
5/6 answers are redundant! What can we do? We simply use selectd/3 instead of select/3!
list_permuted(As,Bs) :-
same_length(As,Bs),
list_permuted_(As,Bs).
list_permuted_([],[]).
list_permuted_([A|As],Bs0) :-
selectd(A,Bs0,Bs), % use selectd/3, not select/3
list_permuted_(As,Bs).
Let's re-run above query that gave us 5 redundant solutions before!
?- list_permuted([1,1,1],Ys).
Ys = [1,1,1]
; false.
?- list_permuted(Xs,[1,1,1]).
Xs = [1,1,1]
; false.
Better! All redundant answers are gone.
Let's compare the solution set for some sample case:
?- _Xs = [1,2,1,1,2,1,1,2,1],
setof(Ys,list_permutation(_Xs,Ys),Yss),
setof(Ys,list_permuted(_Xs,Ys),Yss),
length(Yss,N).
N = 84, Yss = [[1,1,1,1,1,1,2,2,2],[1,1,1,1,1,2,1,2,2],[...|...]|...].
OK! How about empirical runtime measurements with a problem of a slightly bigger size?
We use call_time/2 for measuring the runtime in milli-seconds T_ms.
?- call_time(\+ (list_permutation([1,2,1,1,1,2,1,1,1,2,1],_),false),T_ms).
T_ms = 8110.
?- call_time(\+ (list_permuted( [1,2,1,1,1,2,1,1,1,2,1],_),false),T_ms).
T_ms = 140.
OK! And with proper compilation of if_/3 and (=)/3, list_permuted/2 is even faster!
Footnote 1: Using SICStus Prolog version 4.3.2 (x86_64-linux-glibc2.12).
Footnote 2: The answers given by the Prolog toplevel have been post-processed for the sake of readability.
If you just want to explore the permutations without the "False" in the end, this code might be helpful
takeout(X,[F |R],[F|S]) :- F\=X, takeout(X,R,S).
takeout(X,[X|R],R).
perm([X|Y],Z) :- perm(Y,W), takeout(X,Z,W).
perm([],[]).
So, the output of perm([a,b],B) would be
B=[a,b]
B=[b,a]