Ordering lists with constraint logic programming

Question

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

So the main predicate I have defined is the next one:

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 have proved the program I made and it works! But I don't know if it is possible to improve the efficiency, and if it is, how can I do it (I was reading this old thread here). Should I add or modify any of the constraints?

Thanks!

Answer 1

Your definition of same_length/2 will not terminate very often. Instead, consider

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

equally, using library(lambda) use

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

in place of

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

It seems you want to reformulate sorting by stating first, that the list is ordered, and only then searching for a 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).

Please note that the arguments in perm/2 are now exchanged! 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

Here are two implementations using clpfd. Both are similar to the "permutation sort" variants presented in earlier answers. However, both express "permutation" not by using permutation/2, but by a combination of element/3 and all_distinct/1.

element/3 states that the elements of the sorted list are all members of the original list. all_distinct/1 ensures that the 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).

Sample query:

?- 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's a lot of redundant answers! Can we do better?

---

Eliminating redundant answers

Yes! The redundant answers in the above query can be eliminated by adding a constraint relating neighboring items in the sorted list and their respective positions in the original list.

The constraint Z1 #= Z2 #==> N1 #< N2 states: "If two neighboring items 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.