перестановка списка с несколькими одинаковыми элементами Пролог

Вы можете построить такие перестановки, просматривая список.

myPermutation([], []).
myPermutation(L, [H|P]):-
  select(H, L, NL), % Select one item from the list
  myPermutation(NL, H, P).

myPermutation([], _, []).
myPermutation(L, H, [I|P]):-
  select(I, L, NL), % Select another item
  I \= H, % Enforce restriction of no duplicate consecutive items
  myPermutation(NL, I, P).

Этот код при возврате выдаст все допустимые перестановки. Я оставлю вам в качестве упражнения способ отбросить повторяющиеся перестановки.

Вы можете сделать это довольно быстро с помощью dif/2, который запрещает двум переменным иметь разные значения, не зная их заранее:

?- dif(X,Y).
dif(X, Y).

?- dif(X,Y), X=1.
X = 1,
dif(1, Y).

?- dif(X,Y), X=1, Y=1.
false.

Используя это, вы можете создать предикат, который ограничивает список таким образом, чтобы не было двух одинаковых элементов:

conseq_dif([]).
conseq_dif([_]).
conseq_dif([X,Y|Xs]) :-
    dif(X,Y),
    conseq_dif([Y|Xs]).

Теперь, чтобы найти нужные вам ограниченные перестановки:

constrained_perm(Lst,Prm) :-
    length(Lst,N),
    length(Prm,N),           % make list of N unbound variables
    conseq_dif(Prm),
    permutation(Lst,Prm).    % "ordinary" (library) permutation finding

Я не уверен, что dif/2 является стандартным Прологом, но в основных реализациях он есть.

Мы определяем my_perm/2 на основе same_length/2, < a href = "https://stackoverflow.com/a/33212200/4609915"> list_permuted/2, dif и mapadj/2:

my_perm(Xs,Ys) :-
   same_length(Xs,Ys),
   mapadj(dif,Ys),
   list_permuted(Xs,Ys).

Универсальный мета-предикат mapadj/2 может определяться следующим образом:

:- meta_predicate mapadj(2,?), list_mapadj(?,2), list_prev_mapadj(?,?,2).
mapadj(P_2,Xs) :-
   list_mapadj(Xs,P_2).

list_mapadj([],_).
list_mapadj([A|As],P_2) :-
   list_prev_mapadj(As,A,P_2).

list_prev_mapadj([],_,_).
list_prev_mapadj([A1|As],A0,P_2) :-
   call(P_2,A0,A1),
   list_prev_mapadj(As,A1,P_2).

Вот пример запроса ^1,2, предоставленный OP.

Мы используем call_time/2 для измерения времени выполнения в миллисекундах T_ms.

?- call_time(my_perm([1,1,1,1,1,2,2,3,3,4,4,5,5],[1,2,1,5,1,3,1,4,1,2,3,5,4]),T_ms).
T_ms = 0.

Сколько времени нужно, чтобы найти первые несколько решений?

?- call_time(my_perm([1,2,1,5,1,3,1,4,1,2,3,5,4],Xs),T_ms).
  T_ms =  0, Xs = [1,2,1,5,1,3,1,4,1,2,3,5,4]
; T_ms =  0, Xs = [1,2,1,5,1,3,1,4,1,2,3,4,5]
; T_ms = 10, Xs = [1,2,1,5,1,3,1,4,1,2,5,3,4]
; T_ms = 10, Xs = [1,2,1,5,1,3,1,4,1,2,4,3,5]
; T_ms = 10, Xs = [1,2,1,5,1,3,1,4,1,2,5,4,3]
; T_ms = 10, Xs = [1,2,1,5,1,3,1,4,1,2,4,5,3]
; T_ms = 10, Xs = [1,2,1,5,1,3,1,4,1,3,2,5,4]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,3,2,4,5]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,5,2,3,4]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,4,2,3,5]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,5,2,4,3]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,4,2,5,3]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,3,5,2,4]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,3,4,2,5]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,5,3,2,4]
; T_ms = 20, Xs = [1,2,1,5,1,3,1,4,1,4,3,2,5]
; T_ms = 30, Xs = [1,2,1,5,1,3,1,4,1,5,4,2,3]
; T_ms = 30, Xs = [1,2,1,5,1,3,1,4,1,4,5,2,3]
...

Обратите внимание, что T_ms монотонно растет: он измеряет время, потраченное с момента первого вызова данной цели.

Сколько времени нужно, чтобы перечислить все решения?

?- call_time(\+((my_perm([1,1,1,1,1,2,2,3,3,4,4,5,5],_),false)),T_ms).
T_ms = 4030.

Сколько существует решений?

?- use_module(library(aggregate)),
   aggregate(count,Xs,my_perm([1,2,1,5,1,3,1,4,1,2,3,5,4],Xs),N).
N = 197664.

^{Сноска 1: Использование SICStus Prolog версии 4.3.2 (x86_64-linux-glibc2.12).
Сноска 2: Последовательности ответов, выдаваемые процессором Пролога, были адаптированы для удобства чтения.}