Genera tutte le permutazioni della lista [1, 1, 2, 2, ..., n, n] dove il numero di elementi tra ogni coppia è pari in Prolog

Question

Recentemente ho iniziato a imparare Prolog e ho avuto l'incarico di scrivere un predicato list(N, L) che genera elenchi di L tale che:

• L ha 2N lunghezza,
• ogni numero compreso tra 1 e N avviene esattamente il doppio a L,
• fra ciascuna coppia dello stesso elemento è un ancora numero di altri elementi,
• le prime occorrenze di ogni numero sono in ordine crescente ER.

L'autore afferma che ci sono N! tali elenchi.

Ad esempio, per N = 3 Tutte le soluzioni sono:

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

mia soluzione attuale si presenta come:

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, [], []). 

lo fa due cose:

• se la corrente massima è meno di N, aggiungi quel numero alla lista, mettilo nell'elenco dei duplicati e aggiorna il massimo;
• selezionare alcuni duplicati, controllare se è presente un numero pari di elementi tra esso e il numero già presente nell'elenco (cioè quel numero è in posizione dispari), quindi aggiungerlo all'elenco e rimuoverlo dai duplicati.

Funziona, ma è lento e non sembra molto bello.

L'autore di questo esercizio mostra che per N < 12, la sua soluzione genera un singolo elenco con inferenze medie di ~ 11 (utilizzando time/1 e dividendo il risultato per N!). Con la mia soluzione cresce a ~ 60.

Ho due domande:

1. come migliorare questo algoritmo?
2. Questo problema può essere generalizzato ad altri noti? Conosco problemi simili basati sul multiset [1, 1, 2, 2, ..., n, n] (ad esempio l'accoppiamento con Langford), ma non sono riuscito a trovare qualcosa di simile.

Sto chiedendo perché il problema originale riguarda enumerare le intersezioni in una curva chiusa autointersecante. Si disegna tale curva, si seleziona un punto e una direzione e si segue la curva, elencando ciascuna intersezione quando viene raggiunto per la prima volta e ripetendo il numero nella seconda riunione: example (con la risposta [1, 2, 3, 4, 5, 3, 6, 7, 8, 1, 9, 5, 4, 6, 7, 9, 2, 8]).

L'autore afferma che ciascuna di tali curve soddisfa il predicato list, ma non tutte le liste corrispondono a una curva.

Answer 1

Ho dovuto ricorrere all'aritmetica per soddisfare il requisito di coppie di numeri interi separati dal numero di elementi. Sarebbe bello poter risolvere senza aritmetica ...

 

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

selezionare/3 è utilizzato in 'modalità inserimento'.

modifica per evitare l'aritmetica, potremmo usare questo schema più dettagliato

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

modificare

Ecco un frammento basata su incarico in una lista precompilata di 'slot' vuoti. Sulla base del mio test, è più veloce della soluzione, circa 2 volte.

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

mio primo tentativo, filtrando con even_/1 dopo ogni inserzione, era molto più lenta. Inizialmente ero concentrato a spingere il filtro subito dopo select/3, e le prestazioni erano praticamente buone come l'ultimo frammento, ma ahimè, perde una soluzione su 6 ...