Списки заказов с программированием логики ограничений
Мне было интересно, может ли кто-нибудь помочь мне с этой проблемой: мне нужно заказать список, используя Prolog с Constraing Logic Programming, и я должен сделать это более эффективным способом.
Итак, основным предикатом, который я определил, является следующий:
order(Xs,Ys) :-
same_length(Xs,Ys), /* To determine the list Ys with the Xs' length */
perm(Xs,Ys), /* Permutation */
ordered(Ys), /* Is Ys ordered? */
! .
Реализация каждого из предыдущих вспомогательных предикатов выглядит следующим образом:
same_length(Xs,Ys) :-
length(Xs,L),
length(Ys,L).
perm([],[]).
perm([X|Xs],Ys) :- elem(X,Ys,Ws), perm(Xs,Ws).
ordered([]).
ordered([_]).
ordered([X,Y|Xs]) :- X =< Y, ordered([Y|Xs]).
elem(X,[X|Ys],Ys).
elem(X,[Y|Ws],[Y|Zs]) :- elem(X,Ws,Zs).
Я доказал программу, которую я сделал, и она работает! Но я не знаю, возможно ли повысить эффективность, и если да, то как я могу это сделать (я читал эту старую ветку здесь). Должен ли я добавить или изменить какие-либо из ограничений?
Спасибо!
3 ответа
Ваше определение same_length/2 не закончится очень часто. Вместо этого рассмотрим
same_length([],[]).
same_length([_|Xs], [_|Ys]) :-
same_length(Xs, Ys).
в равной степени, используя library(lambda) использование
... maplist(\_^_^true,Xs, Ys), ...
на месте
... same_length(Xs, Ys), ...
Кажется, вы хотите переформулировать сортировку, указав сначала, что список упорядочен, и только потом ищите перестановку. Ниже работает в SICStus, SWI, YAP.
ordered2([]).
ordered2([_]).
ordered2([X,Y|Xs]) :-
when((nonvar(X),nonvar(Y)),
( X =< Y, ordered2([Y|Xs]) )).
list_sorted2(Xs,Ys) :-
maplist(\_^_^true,Xs,Ys),
ordered2(Ys),
perm(Ys,Xs).
Обратите внимание, что аргументы в perm/2 теперь обмениваются! Использование SWI:
?- time(order([10,9,8,7,6,5,4,3,2,1],Xs)).
% 38,434,099 inferences, 10.655 CPU in 11.474 seconds (93% CPU, 3607101 Lips)
?- time(list_sorted2([10,9,8,7,6,5,4,3,2,1],Xs)).
% 50,139 inferences, 0.023 CPU in 0.032 seconds (72% CPU, 2205620 Lips)
В качестве вызова на бис я запустил генератор сети сортировки по длине 10 и портировал код (который был сгенерирован с опцией "best") в Prolog/clpfd.
Сейчас начнется list_sorted__SN10/2 (SN10 расшифровывается как "сортировка сети размером 10"):
:- use_module(library(clpfd)).
list_sorted__SN10(Xs,Zs) :-
Xs = [A0,A1,A2,A3,A4,A5,A6,A7,A8,A9],
Zs = [E0,G1,H2,I3,J4,J5,I6,H7,G8,E9],
B4 #= min(A4,A9), B9 #= max(A4,A9),
B3 #= min(A3,A8), B8 #= max(A3,A8),
B2 #= min(A2,A7), B7 #= max(A2,A7),
B1 #= min(A1,A6), B6 #= max(A1,A6),
B0 #= min(A0,A5), B5 #= max(A0,A5),
C1 #= min(B1,B4), C4 #= max(B1,B4),
C6 #= min(B6,B9), C9 #= max(B6,B9),
C0 #= min(B0,B3), C3 #= max(B0,B3),
C5 #= min(B5,B8), C8 #= max(B5,B8),
D0 #= min(C0,B2), D2 #= max(C0,B2),
D3 #= min(C3,C6), D6 #= max(C3,C6),
D7 #= min(B7,C9), D9 #= max(B7,C9),
E0 #= min(D0,C1), E1 #= max(D0,C1),
E2 #= min(D2,C4), E4 #= max(D2,C4),
E5 #= min(C5,D7), E7 #= max(C5,D7),
E8 #= min(C8,D9), E9 #= max(C8,D9),
F1 #= min(E1,E2), F2 #= max(E1,E2),
F4 #= min(E4,D6), F6 #= max(E4,D6),
F7 #= min(E7,E8), F8 #= max(E7,E8),
F3 #= min(D3,E5), F5 #= max(D3,E5),
G2 #= min(F2,F5), G5 #= max(F2,F5),
G6 #= min(F6,F8), G8 #= max(F6,F8),
G1 #= min(F1,F3), G3 #= max(F1,F3),
G4 #= min(F4,F7), G7 #= max(F4,F7),
H2 #= min(G2,G3), H3 #= max(G2,G3),
H6 #= min(G6,G7), H7 #= max(G6,G7),
I3 #= min(H3,G4), I4 #= max(H3,G4),
I5 #= min(G5,H6), I6 #= max(G5,H6),
J4 #= min(I4,I5), J5 #= max(I4,I5).
Давайте посмотрим, работает ли это:
?- numlist(1,10,Xs),permutation(Xs,Ys),\+ list_sorted__SN10(Ys,Xs).
false. % all permutations are sorted correctly
Как насчет того, чтобы идти в другом направлении?
?- list_sorted__SN10(Xs,[1,2,3,4,5,6,7,8,9,10]),
labeling([],Xs),
write('Xs'=Xs),nl,
false.
Xs=[1,2,3,4,5,6,7,8,9,10]
Xs=[1,2,3,4,5,6,7,8,10,9]
Xs=[1,2,3,4,5,6,7,9,8,10]
Xs=[1,2,3,4,5,6,7,9,10,8]
Xs=[1,2,3,4,5,6,7,10,8,9]
Xs=[1,2,3,4,5,6,7,10,9,8]
Xs=[1,2,3,4,5,6,8,7,9,10]
...
Есть скорость?
?- time(list_sorted__SN10([10,9,8,7,6,5,4,3,2,1],Xs)).
% 198 inferences, 0.000 CPU in 0.000 seconds (97% CPU, 4841431 Lips)
Xs = [1, 2, 3, 4, 5, 6, 7, 8, 9|...].
Получил скорость!
Обработка общего случая
Сортировка списков Xs с length(Xs,10) это хорошо, но что если у меня есть длинные или короткие?
Еще раз сортировка сетей на помощь!
Вот порт Prolog / clpfd кода, показанного в сети сортировки Bitonic для n, не степени 2; код Prolog использует атрибутивные переменные для произвольного доступа на чтение / запись для сортируемых элементов. Мы используем атрибут value который хранит элемент в этой конкретной позиции в то время.
:- use_module(library(clpfd)).
init_att_var(X,Z) :-
put_attr(Z,value,X).
get_att_value(Var,Value) :-
get_attr(Var,value,Value).
direction_flipped(ascending,descending).
direction_flipped(descending,ascending).
fdBitonicSort(Xs0,Zs) :-
same_length(Xs0,Zs),
maplist(init_att_var,Xs0,Xs1),
Xs2 =.. [data|Xs1],
functor(Xs2,_,N),
fdBitonicSort_(Xs2,0,N,ascending),
maplist(get_att_value,Xs1,Zs).
Рекурсивная разбивка, необходимая для битовой сортировки, выполняется с помощью следующего кода:
fdBitonicSort_(Data,Lo,N,Dir) :-
( N > 1
-> M is N // 2,
direction_flipped(Dir,Dir1),
fdBitonicSort_(Data,Lo,M,Dir1),
Lo1 is Lo + M,
N1 is N - M,
fdBitonicSort_(Data,Lo1,N1,Dir),
fdBitonicMerge_(Data,Lo,N,Dir)
; true
).
greatestPowerOfTwoLessThan(N,K) :-
T is 1 << msb(N),
( N /\ (N-1) =:= 0
-> K is T >> 1
; K = T
).
fdBitonicMerge_(Data,Lo,N,Dir) :-
( N > 1
-> greatestPowerOfTwoLessThan(N,M),
Ub is Lo + N - M,
fdBitonicCompareMany_(Data,Lo,Ub,M,Dir),
fdBitonicMerge_(Data,Lo,M,Dir),
Lo1 is Lo + M,
N1 is N - M,
fdBitonicMerge_(Data,Lo1,N1,Dir)
; true
).
Внутренний цикл сравнений выглядит так:
fdBitonicCompareMany_(Data,I,Ub,M,Dir) :-
( I < Ub
-> I_plus_M is I+M,
fdBitonicCompareTwo_(Data,I,I_plus_M,Dir),
I1 is I + 1,
fdBitonicCompareMany_(Data,I1,Ub,M,Dir)
; true
).
Почти сделано! Одна вещь отсутствует... fdBitonicCompareTwo_/4 читает i-й и j-й элемент и помещает минимум и максимум в i-й и j-й позиции, если направление ascending, Если направление descending минимум и максимум ставятся на j-е и i-е места:
fdBitonicCompareTwo_(Data,I,J,Dir) :-
I1 is I+1,
J1 is J+1,
arg(I1,Data,V1),
arg(J1,Data,V2),
get_attr(V1,value,W1),
get_attr(V2,value,W2),
Z1 #= min(W1,W2),
Z2 #= max(W1,W2),
( Dir == ascending
-> E1 = Z1, E2 = Z2
; E1 = Z2, E2 = Z1
),
put_attr(V1,value,E1),
put_attr(V2,value,E2).
тестирование
Во-первых, 10 раз для каждой длины списка между 1 а также 200 взять случайные числа между 1 а также 10000 и сортировать их. Кричите громко, если результат отличается от того, что msort/2 поставляет.
?- ( setrand(rand(29989,9973,997)),
between(1,200,N),
length(Xs,N),
format('(~d)',[N]),
( N mod 10 =:= 0 -> nl ; true ),
between(1,10,_),
maplist(random_between(1,10000),Xs),
( fdBitonicSort(Xs,Zs), \+ msort(Xs,Zs)
-> write(error(Xs,Zs)), nl
; true
),
false
; true
).
(1)(2)(3)(4)(5)(6)(7)(8)(9)(10)
(11)(12)(13)(14)(15)(16)(17)(18)(19)(20)
(21)(22)(23)(24)(25)(26)(27)(28)(29)(30)
(31)(32)(33)(34)(35)(36)(37)(38)(39)(40)
(41)(42)(43)(44)(45)(46)(47)(48)(49)(50)
(51)(52)(53)(54)(55)(56)(57)(58)(59)(60)
(61)(62)(63)(64)(65)(66)(67)(68)(69)(70)
(71)(72)(73)(74)(75)(76)(77)(78)(79)(80)
(81)(82)(83)(84)(85)(86)(87)(88)(89)(90)
(91)(92)(93)(94)(95)(96)(97)(98)(99)(100)
(101)(102)(103)(104)(105)(106)(107)(108)(109)(110)
(111)(112)(113)(114)(115)(116)(117)(118)(119)(120)
(121)(122)(123)(124)(125)(126)(127)(128)(129)(130)
(131)(132)(133)(134)(135)(136)(137)(138)(139)(140)
(141)(142)(143)(144)(145)(146)(147)(148)(149)(150)
(151)(152)(153)(154)(155)(156)(157)(158)(159)(160)
(161)(162)(163)(164)(165)(166)(167)(168)(169)(170)
(171)(172)(173)(174)(175)(176)(177)(178)(179)(180)
(181)(182)(183)(184)(185)(186)(187)(188)(189)(190)
(191)(192)(193)(194)(195)(196)(197)(198)(199)(200)
true.
Далее возьмите списки из 1 в N (с N =< Ub), рассмотрите все перестановки и увидите, что любая из них показывает ошибку в битовой сортировке (результат, который отличается от того, что msort/2 дает нам).
Тест проводится двумя разными способами: after а также before, after создает сеть ограничений, а затем связывает переменные FD с конкретными значениями.before делает это наоборот, эффективно используя clpfd как целочисленную арифметику - все ограничения немедленно разрешаются.
test_fdBitonicSort(Method,Ub) :-
length(RefList,Ub),
append(Xs,_,RefList),
length(Xs,N),
numlist(1,N,Xs),
same_length(Xs,Ys),
same_length(Xs,Zs),
time((format('[~q] testing length ~d (all permutations of ~q) ... ',
[Method,N,Xs]),
( Method == before
-> ( permutation(Xs,Ys),
\+ fdBitonicSort(Ys,Xs)
-> write(errorB(Ys))
; true
)
; permutation(Xs,Ys),
\+ (fdBitonicSort(Zs,Xs), Zs = Ys)
-> write(errorA(Ys))
; true
),
write('DONE\n'))),
false.
test_fdBitonicSort(_,_).
Давайте работать test_fdBitonicSort/2:
?- test_fdBitonicSort(after,7).
[after] testing length 1 (all permutations of [1]) ... DONE
% 93 inferences, 0.000 CPU in 0.000 seconds (89% CPU, 1620943 Lips)
[after] testing length 2 (all permutations of [1,2]) ... DONE
% 4,775 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 9136675 Lips)
[after] testing length 3 (all permutations of [1,2,3]) ... DONE
% 53,739 inferences, 0.006 CPU in 0.006 seconds (100% CPU, 9514148 Lips)
[after] testing length 4 (all permutations of [1,2,3,4]) ... DONE
% 462,798 inferences, 0.048 CPU in 0.048 seconds (100% CPU, 9652164 Lips)
[after] testing length 5 (all permutations of [1,2,3,4,5]) ... DONE
% 3,618,226 inferences, 0.374 CPU in 0.374 seconds (100% CPU, 9666074 Lips)
[after] testing length 6 (all permutations of [1,2,3,4,5,6]) ... DONE
% 32,890,387 inferences, 3.212 CPU in 3.211 seconds (100% CPU, 10241324 Lips)
[after] testing length 7 (all permutations of [1,2,3,4,5,6,7]) ... DONE
% 330,442,005 inferences, 32.499 CPU in 32.493 seconds (100% CPU, 10167747 Lips)
true.
Давайте снова используем предикат, на этот раз с наземным вводом:
?- test_fdBitonicSort(before,9).
[before] testing length 1 (all permutations of [1]) ... DONE
% 27 inferences, 0.000 CPU in 0.000 seconds (97% CPU, 334208 Lips)
[before] testing length 2 (all permutations of [1,2]) ... DONE
% 151 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 1824884 Lips)
[before] testing length 3 (all permutations of [1,2,3]) ... DONE
% 930 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 4308089 Lips)
[before] testing length 4 (all permutations of [1,2,3,4]) ... DONE
% 6,033 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 5124516 Lips)
[before] testing length 5 (all permutations of [1,2,3,4,5]) ... DONE
% 43,584 inferences, 0.006 CPU in 0.006 seconds (100% CPU, 7722860 Lips)
[before] testing length 6 (all permutations of [1,2,3,4,5,6]) ... DONE
% 353,637 inferences, 0.033 CPU in 0.033 seconds (100% CPU, 10753040 Lips)
[before] testing length 7 (all permutations of [1,2,3,4,5,6,7]) ... DONE
% 3,201,186 inferences, 0.249 CPU in 0.249 seconds (100% CPU, 12844003 Lips)
[before] testing length 8 (all permutations of [1,2,3,4,5,6,7,8]) ... DONE
% 32,060,649 inferences, 2.595 CPU in 2.594 seconds (100% CPU, 12355290 Lips)
[before] testing length 9 (all permutations of [1,2,3,4,5,6,7,8,9]) ... DONE
% 340,437,636 inferences, 27.549 CPU in 27.541 seconds (100% CPU, 12357591 Lips)
true.
Оно работает! Есть ли еще чем заняться? Да, безусловно!
Во-первых, специализированный код, такой как list_sorted__SN10/2 должны быть созданы для других небольших размеров. Во-вторых, можно оценить различные эквивалентные методы сортировки сети.
Вот две реализации, использующие clpfd. Оба аналогичны вариантам "сортировки перестановок", представленным в предыдущих ответах. Тем не менее, оба выражают "перестановку", не используя permutation/2, но комбинацией element/3 а также all_distinct/1,
element/3 утверждает, что все элементы отсортированного списка являются членами исходного списка. all_distinct/1 гарантирует, что индексы элементов все отличаются друг от друга.
:- use_module(library(clpfd)).
elements_index_item(Vs,N,V) :-
element(N,Vs,V).
list_sortedA(Xs,Zs) :-
same_length(Xs,Zs),
chain(Zs,#=<),
maplist(elements_index_item(Xs),Ns,Zs),
all_distinct(Ns),
labeling([],Ns).
Пример запроса:
?- list_sorted1([9,7,8,5,6,3,4,1,2],Xs).
Xs = [1, 2, 3, 4, 5, 6, 7, 8, 9] ;
false.
Что если второй аргумент известен, а первый неизвестен?
?- list_sorted1(Xs,[1,2,3]).
Xs = [1, 2, 3] ;
Xs = [1, 3, 2] ;
Xs = [2, 1, 3] ;
Xs = [3, 1, 2] ;
Xs = [2, 3, 1] ;
Xs = [3, 2, 1].
Все идет нормально. Что делать, если сортируемый список содержит дубликаты?
?- list_sorted1([5,4,4,3,3,2,2,1],Xs).
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
Xs = [1, 2, 2, 3, 3, 4, 4, 5].
Теперь это много лишних ответов! Можем ли мы сделать лучше?
Устранение лишних ответов
Да! Избыточные ответы в вышеупомянутом запросе могут быть устранены путем добавления ограничения, связывающего соседние элементы в отсортированном списке и их соответствующие позиции в исходном списке.
Ограничение Z1 #= Z2 #==> N1 #< N2 гласит: "Если два соседних элемента в отсортированном списке равны, то их позиции в исходном списке должны быть упорядочены".
originalPosition_sorted([],[]).
originalPosition_sorted([_],[_]).
originalPosition_sorted([N1,N2|Ns],[Z1,Z2|Zs]) :-
Z1 #= Z2 #==> N1 #< N2,
originalPosition_sorted([N2|Ns],[Z2|Zs]).
list_sorted2(Xs,Zs) :-
same_length(Xs,Zs),
chain(Zs,#=<),
maplist(elements_index_item(Xs),Ns,Zs),
originalPosition_sorted(Ns,Zs),
all_distinct(Ns),
labeling([],Ns).
Но... это работает?
?- list_sorted2([5,4,4,3,3,2,2,1],Xs).
Xs = [1, 2, 2, 3, 3, 4, 4, 5] ;
false.