Fixing list output in Prolog

Question

I'm trying to make a solver for the Dutch National flag problem. Basically, given a list, I want to sort them in the order of Red-White-Blue. Red, White and Blue are defined by their predicates (i.e. red(x), white(x) etc.) Currently, I have the following code:

red(1).
white(2).
blue(3).

dutch(Xs,Ys):- 
    getRed(Xs,[], Red), getWhite(Xs,[],White), getBlue(Xs,[],Blue), 
    append([], Red, Y1), append(Y1, White, Y2), append(Y2, Blue, Ys).

getRed([],Rs,Rs).
getRed([X|Rest], Acc, Rs) :- red(X), getRed(Rest, [X,Acc] , Rs).
getRed([X|Rest], Acc, Rs) :- getRed(Rest, Acc, Rs).

getWhite([],Rs,Rs).    
getWhite([X|Rest], Acc, Rs) :- white(X), getWhite(Rest, [X,Acc], Rs).
getWhite([X|Rest], Acc, Rs) :- getWhite(Rest, Acc, Rs).

getBlue([],Rs,Rs).
getBlue([X|Rest], Acc, Rs) :- blue(X), getBlue(Rest, [X,Acc], Rs).    
getBlue([X|Rest], Acc, Rs) :- getBlue(Rest, Acc, Rs).

My output looks like this :

?- dutch([1,2,3],R).
R = [1, [], 2, [], 3, []]
R = [1, [], 2, []]
R = [1, [], 3, []]
R = [1, []]
R = [2, [], 3, []]
R = [3, []]
R = []

What I want is for it to look like this:

R = [1, 2, 3]

I've tried a few ways to force the output to what i want, but haven't been able to get anywhere close.

Edit: Looks like i can solve it by using a brute force solution of permuting all possible sets and evaluating whether the set is in "Dutch Flag" order. Is there a better solution though?

mat mat · Accepted Answer · 2016-10-26T09:10:37

A pure solution

Preface

I would like to add a pure, relational solution to the existing one.

Ideally, you can use a Prolog predicate in all directions, and I will now show an implementation that lets you do this: Not only can you sort an instantiated list according to your criteria, no, you can also generate solutions and complete partially instantiated solutions.

To do this, I am using the meta-predicate if_/3 from library(reif).

Reified predicates

I start with the reified versions of your predicates, also taking the liberty to use the more telling names red, white and blue to denote the colors:

red(R, T)   :- =(R, red, T).

white(W, T) :- =(W, white, T).

blue(B, T)  :- =(B, blue, T).

Note I am using (=)/3, which ships for free with library(reif).

Using DCGs to describe lists

Next, purely for convenience, I am using dcg notation to describe the subsequences of interest:

reds([]) --> [].
reds(Rs) -->
        [R],
        { if_(red(R), Rs = [R|Rest], Rs = Rest) },
        reds(Rest).

whites([]) --> [].
whites(Ws) --> [W],
        { if_(white(W), Ws = [W|Rest], Ws = Rest) },
        whites(Rest).

blues([]) --> [].
blues(Bs) --> [B],
        { if_(blue(B), Bs = [B|Rest], Bs = Rest) },
        blues(Rest).

I leave making this more concise as an easy exercise.

Solution

With these building blocks, we can express the overall solution:

dutch(Colors, Ds) :-
        phrase(reds(Rs), Colors),
        phrase(whites(Ws), Colors),
        phrase(blues(Bs), Colors),
        phrase((Rs,Ws,Bs), Ds).

Examples

Of course, this works in simple, instantiated cases like:

?- dutch([red,white,blue], Ds).
Ds = [red, white, blue] ;
false.

Now the point: This also works in the most general case, where all arguments are variables:

?- length(Cs, _), dutch(Cs, Ds).
Cs = Ds, Ds = [] ;
Cs = Ds, Ds = [red] ;
Cs = Ds, Ds = [white] ;
Cs = Ds, Ds = [blue] ;
Cs = [_G1322],
Ds = [],
dif(_G1322, blue),
dif(_G1322, white),
dif(_G1322, red) ;
Cs = Ds, Ds = [red, red] ;
Cs = Ds, Ds = [red, white] ;
Cs = Ds, Ds = [red, blue] ;
Cs = [red, _G1340],
Ds = [red],
dif(_G1340, blue),
dif(_G1340, white),
dif(_G1340, red) .

By adding further goals, we can specialize this query to observe concrete solutions that are now generated:

?- length(Cs, _), Cs = [_,_,_|_], dutch(Cs, Ds), ground(Cs).
Cs = Ds, Ds = [red, red, red] ;
Cs = Ds, Ds = [red, red, white] ;
Cs = Ds, Ds = [red, red, blue] ;
Cs = [red, white, red],
Ds = [red, red, white] ;
Cs = [red, blue, red],
Ds = [red, red, blue] .

Compare this with the other answer, which cannot be used to fairly enumerate solutions:

?- length(Xs, _), Xs = [_,_,_|_], dutch(Xs, Ys).
Xs = Ys, Ys = [1, 1, 1] ;
Xs = Ys, Ys = [1, 1, 1, 1] ;
Xs = Ys, Ys = [1, 1, 1, 1, 1] ;
Xs = Ys, Ys = [1, 1, 1, 1, 1, 1] ;
Xs = Ys, Ys = [1, 1, 1, 1, 1, 1, 1] .

Summary

Thus, by retaining logical-purity we have obtained a more general logic program, which we can use in all directions.

Admittedly, you did not request this generality. However, while we are at it, why waive it?