使用约束逻辑编程排序列表

时间:2011-06-02 12:04:26

标签: list prolog constraint-programming

我想知道是否有人可以帮我解决这个问题:我必须使用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).

我已经证明了我制作的节目并且有效!但我不知道是否有可能提高效率,如果是,我该怎么做(我在这里阅读this old thread)。我应该添加或修改任何约束吗?

谢谢!

3 个答案:

答案 0 :(得分:9)

您对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)

答案 1 :(得分:3)

作为一个安可,我为10长度运行了一个sorting network generator,并将代码(使用选项#34生成;最好&#34;)移植到Prolog / clpfd。

以下是list_sorted__SN10/2SN10代表&#34;排序网络规模10&#34;):

:- 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|...].

得到速度!


处理一般情况

使用Xslength(Xs,10)列表进行排序很不错,但是如果我有更长或更短的内容呢?

再一次,sorting networks救援!

这是Bitonic sorting network for n not a power of 2中显示的代码的Prolog / clpfd端口; 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).

bitonic排序所需的递归细分由以下代码完成:

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项中如果方向为ascending,则为第j个。如果方向为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).

测试

首先,对于1200之间的每个列表长度,10次取110000之间的随机数并对其进行排序。如果结果与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.

接下来,从1N(带N =< Ub)列表,考虑所有排列并看到它们中的任何一个都显示了比特排序中的错误(结果与msort/2给我们的内容。

测试以两种不同的方式完成:afterbeforeafter构建约束网络,然后将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这样的专用代码。其次,可以评估不同的等效网络排序方法。

答案 2 :(得分:2)

以下是使用clpfd的两个实现。两者都类似于排列排序&#34;早期答案中提供的变体。但是,无论是表达还是表达排列&#34;不是使用permutation/2,而是使用element/3all_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表示:&#34;如果排序列表中的两个相邻项目相等,则必须对它们在原始列表中的位置进行排序。&#34;

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.