Prolog permutations with condition? - algorithm

Question

I have this program to generate all the permutations of a list. The thing is, I need to generate only the permutations in which the consecutive terms have the absolute difference less or equal than 3. Something like:
[2,7,5] => [2,5,7] and [7,5,2]. [2 7 5] would be wrong since 2-7 = -5 and |-5| > 3
The permutation program:
perm([X|Y],Z):-
perm(Y,W),
takeout(X,Z,W).
perm([],[]).
takeout(X,[X|R],R).
takeout(X,[F|R],[F|S]):-
takeout(X,R,S).
permutfin(X,R):-
findall(P,perm(X,P),R).
I know I'm supposed to add the condition somewhere in the perm function but I can't figure out exactly what or where to write.

Answer 1

A more intuitive way to write a permutation is:
takeout([X|T],X,T).
takeout([H|L],X,[H|T]) :-
takeout(L,X,T).
Where the first element is the original list, the second the element picked, and the third the list without that element.
In that case the permutation predicate is defined as:
perm([],[]).
perm(L,[E|T]) :-
takeout(L,E,R),
perm(R,T).
this also allows tail-recursion which can imply an important optimization in most Prolog systems.
Now in order to generate only permutations with a consecutive difference of at most three, you can do two things:
The naive way is generate and test: here you let Prolog generate a permutation, but you only accept it if a certain condition is met. For instance:
dif3([_]).
dif3([A,B|T]) :-
D is abs(A-B),
D =< 3,
dif3([B|T]).
and then define:
perm3(L,R) :-
perm(L,R),
dif3(R).
This approach is not very efficient: it can be the case that for an exponential amount of permutations, only a few are valid, and this would imply a large computational effort. If for instance the list of elements is [2,5,7,9] it will generate all permutations starting with [2,9,...] while a more intelligent approach could already see that will never generate a valid solution anyway.
the other more intelligent approach is interleaved generate and test. Here you select only numbers with takeout3/4 that are valid candidates. You can define a predicate takeout3(L,P,X,T). where L is the original list, P the previous number, X the selected number and T the resulting list:
takeout3([X|T],P,X,T) :-
D is abs(X-P),
D =< 3.
takeout3([H|L],N,X,[H|T]) :-
takeout3(L,N,X,T).
Now we can generate a permutation as follows:
perm3([],[]).
perm3(L,[E|T]) :-
takeout(L,E,R),
perm3(R,E,T).
perm3([],_,[]).
perm3(L,O,[E|T]) :-
takeout3(L,O,E,R),
perm3(R,E,T).
Mind we use two versions of perm3: perm3/2 and perm3/3, the first is used to generate the first element (using the old takeout/3), and perm3/3 is used to generate the remainder of the permutation using takeout3/4.
The full source code of this approach is:
takeout([X|T],X,T).
takeout([H|L],X,[H|T]) :-
takeout(L,X,T).
takeout3([X|T],P,X,T) :-
D is abs(X-P),
D =< 3.
takeout3([H|L],N,X,[H|T]) :-
takeout3(L,N,X,T).
perm3([],[]).
perm3(L,[E|T]) :-
takeout(L,E,R),
perm3(R,E,T).
perm3([],_,[]).
perm3(L,O,[E|T]) :-
takeout3(L,O,E,R),
perm3(R,E,T).
Running it with swipl gives:
?- perm3([2,7,5],L).
L = [2, 5, 7] ;
L = [7, 5, 2] ;
false.
The expected behavior.

Answer 2

Here is another solution. I added the condition in takeout to make sure the adjacent items are within 3 of each other:
perm([X|Y],Z):-
perm(Y,W),
takeout(X,Z,W).
perm([],[]).
check(_,[]).
check(X,[H|_]) :-
D is X - H,
D < 4,
D > -4.
takeout(X,[X|R],R) :-
check(X,R).
takeout(X,[F|R],[F|S]):-
takeout(X,R,S),
check(F,R).