Generate all permutations of the list [1, 1, 2, 2, ..., n, n] where the number of elements between each pair is even in Prolog

Question

I recently started learning Prolog and I got a task to write a predicate list(N, L) that generates lists L such that:

• L has length 2N,
• every number between 1 and N occurs exactly twice in L,
• between each pair of the same element there is an even number of other elements,
• the first occurrences of each number are in increasing order.

The author states that there are N! such lists.

For example, for N = 3 all solutions are:

?- list(3, L).
L = [1, 1, 2, 2, 3, 3] ;
L = [1, 1, 2, 3, 3, 2] ;
L = [1, 2, 2, 1, 3, 3] ;
L = [1, 2, 2, 3, 3, 1] ;
L = [1, 2, 3, 3, 2, 1] ;
L = [1, 2, 3, 1, 2, 3] ;
false.

My current solution looks like:

even_distance(H, [H | _]) :-
   !.
even_distance(V, [_, _ | T]) :-
   even_distance(V, T).

list(N, [], _, Length, _, _) :-
   Length =:= 2*N,
   !.
list(N, [New | L], Max, Length, Used, Duplicates) :-
   select(New, Duplicates, NewDuplicates),
   even_distance(New, Used),
   NewLength is Length + 1,
   list(N, L, Max, NewLength, [New | Used], NewDuplicates).
list(N, [New | L], Max, Length, Used, Duplicates) :-
   Max < N,
   New is Max + 1,
   NewLength is Length + 1,
   list(N, L, New, NewLength, [New | Used], [New | Duplicates]).

list(N, L) :-
   list(N, L, 0, 0, [], []).

It does two things:

• if current maximum is less than N, add that number to the list, put it on the list of duplicates, and update the max;
• select some duplicate, check if there is an even number of elements between it and the number already on the list (ie. that number is on odd position), then add it to the list and remove it from duplicates.

It works, but it's slow and doesn't look really nice.

The author of this exercise shows that for N < 12, his solution generates a single list with average of ~11 inferences (using time/1 and dividing the result by N!). With my solution it grows to ~60.

I have two questions:

1. How to improve this algorithm?
2. Can this problem be generalized to some other known one? I know about similar problems based on the multiset [1, 1, 2, 2, ..., n, n] (eg. Langford pairing), but couldn't find something like this.

I'm asking because the original problem is about enumerating intersections in a self-intersecting closed curve. You draw such curve, pick a point and direction and follow the curve, enumerating each intersection when met for the first time and repeating the number on the second meeting: example (with the answer [1, 2, 3, 4, 5, 3, 6, 7, 8, 1, 9, 5, 4, 6, 7, 9, 2, 8]).

The author states that every such curve satisfies the predicate list, but not every list corresponds to a curve.

Answer 1

I had to resort to arithmetic to satisfy the requirement about pairs of integers separated by even count of elements. Would be nice to be able to solve without arithmetic at all...

list(N,L) :- numlist(1,N,H), list_(H,L), even_(L).

list_([D|Ds],[D|Rs]) :-
    list_(Ds,Ts),
    select(D,Rs,Ts).
list_([],[]).

even_(L) :-
    forall(nth0(P,L,X), (nth0(Q,L,X), abs(P-Q) mod 2 =:= 1)).

select/3 is used in 'insert mode'.

edit to avoid arithmetic, we could use this more verbose schema

even_(L) :-
    maplist(even_(L),L).
even_(L,E) :-
    append(_,[E|R],L),
    even_p(E,R).
even_p(E,[E|_]).
even_p(E,[_,_|R]) :- even_p(E,R).

edit

Here is a snippet based on assignment in a prebuilt list of empty 'slots'. Based on my test, it's faster than your solution - about 2 times.

list(N,L) :-
    N2 is N*2,
    length(L,N2),
    numlist(1,N,Ns),
    pairs(Ns,L).

pairs([N|Ns],L) :- first(N,L,R),even_offset(N,R),pairs(Ns,L).
pairs([],_).

first(N,[N|R],R) :- !.
first(N,[_|R],S) :- first(N,R,S).

even_offset(N,[N|_]).
even_offset(N,[_,_|R]) :- even_offset(N,R).

My first attempt, filtering with even_/1 after every insertion, was much slower. I was initially focused on pushing the filter immediately after the select/3, and performance was indeed almost good as the last snippet, but alas, it loses a solution out of 6...