Order Lists with Constraint Logic Programming

Question

I was wondering if anyone could help me with this problem: I need to order a list using Prolog with Constraing Logic Programming, and I have to do it in a more efficient way, I can.

So, the main predicate that I defined is the following:

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? */ ! . 

The implementation of each of the previous auxiliary predicates is as follows:

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

I proved the program I did and it works! But I don’t know if efficiency can be improved, and if so, how can I do it (I read this old thread here). Should I add or change any restrictions?

Thank!

Answer 1

Your definition of same_length/2 will not be interrupted very often. Consider instead

 same_length([],[]). same_length([_|Xs], [_|Ys]) :- same_length(Xs, Ys). 

equally using library(lambda) use

 ... maplist(\_^_^true,Xs, Ys), ... 

instead

 ... same_length(Xs, Ys), ... 

It seems you want to reformulate the sorting, indicating first that the list is ordered, and only then searches for the permutation. Below works in 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). 

Note that arguments are now passed to perm / 2! Using 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) 

Answer 2

As an encore, I executed a sorting network generator for length 10 and ported the code (which was generated with the "best" option) to Prolog / clpfd.

Here's list_sorted__SN10/2 ( SN10 means "sorting network size 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). 

See if it works:

 ?- numlist(1,10,Xs),permutation(Xs,Ys),\+ list_sorted__SN10(Ys,Xs). false. % all permutations are sorted correctly 

How about going in a different direction?

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

Got speed?

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

Get the speed!

---

General Case Handling

Sorting Xs lists using length(Xs,10) is good, but what if I have longer or shorter ones?

Once again, sort the networks to help!

Here is the Prolog / clpfd port of the code shown in the Bitonic sorting network for n, which does not matter 2 ; Prolog code uses attribute variables for random access to read / write items to be sorted. We use the value attribute, which stores the element in this particular position at this time.

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

The recursive breakdown required for bitonic sorting is performed using the following code:

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

The internal comparison cycle is as follows:

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

Almost done! One thing is missing ... fdBitonicCompareTwo_/4 reads the i-th and j-th elements and puts the minimum and maximum in the i-th and j-th place, if the direction is ascending . If the direction is descending , the minimum and maximum values ​​are placed in the j-th and i-th places:

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

Testing

Firstly, 10 times for each list length between 1 and 200 , random numbers between 1 and 10000 are received and sorted. Shout out loud if the result is different from the result of 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. 

Then take the lists from 1 to N (using N =< Ub ), look at all the permutations and see that any of them shows an error in bitonic sorting (a result different from what msort/2 gives us).

The test is performed in two different ways: after and before . after creates a network of constraints and then binds the FD variables to specific values. before does the opposite, effectively using clpfd as integer arithmetic --- all restrictions are immediately removed.

 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(_,_). 

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

Use the predicate again, this time with ground input:

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

It works! Is there anything else to do? Yes, definitely !

First, custom code like list_sorted__SN10/2 should be generated for other small sizes. Secondly, various equivalent network sorting methods can be evaluated.

Answer 3

Here are two implementations using clpfd. Both of them are similar to the options for "sorting permutations" presented in earlier answers. However, both express "permutation" not with permutation/2 , but with a combination of element/3 and all_distinct/1 .

element/3 indicates that the elements of the sorted list are members of the original list. all_distinct/1 ensures that element indices are all different from each other.

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

Request example:

 ?- list_sorted1([9,7,8,5,6,3,4,1,2],Xs). Xs = [1, 2, 3, 4, 5, 6, 7, 8, 9] ; false. 

What if the second argument is known and the first is unknown?

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

So far so good. What if the list to be sorted contains duplicates?

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

Now that there are a lot of unnecessary answers! Can we do better?

---

Eliminate redundant responses

Yes! The fallback answers in the above query can be eliminated by adding a restriction associated with neighboring elements in the sorted list and their corresponding positions in the original list.

The restriction Z1 #= Z2 #==> N1 #< N2 states: "If two neighboring elements in the sorted list are equal, then their positions in the original list must be ordered."

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

But ... does it work?

 ?- list_sorted2([5,4,4,3,3,2,2,1],Xs). Xs = [1, 2, 2, 3, 3, 4, 4, 5] ; false.