Is a goose worth sinning?

If there's a field, where Prolog is very good from first sight, it is no doubt solving logical puzzles. You know what I mean: those where you have to tell who owns the fish, how to measure two liters of water only with a bucket of 3 liters and one of 4 liters, solve a sudoku, and so on. Of course, Prolog will be able to deal only with purely combinatorial riddles--any involving self-reference or some dose of creativity are beyond its scope.

If one was to write it in an imperative programming language, it would take quite a lot of time to write a sound representation of the solution-space and then search through it; in Prolog, you just have to declare the rules which the world of the riddle must obey, and voilà!, it outputs the right answer.

For example, the Prolog code for solving the famous Einstein's riddle is quite straight forward (see also this solution):

%% the answer is a list of five houses, in the right order.
%% each house is a list of items in the following order:
%% [Color, Nationality, Beverage, Cigaretts, Pet]

left(L, R, [L | [R | _]]).
left(L, R, [_ | Rest]) :- left(L, R, Rest).

next(X,Y,List) :-
   left(Y,X,List).
next(X,Y,List) :-
   left(X,Y,List).

einstein(List,FishOwner) :-

   List=[_,_,[_,_,milk,_,_],_,_],
   List=[[_,norwegian,_,_,_],_,_,_,_],

   member([red, brit,_,_,_],List),
   member([_,swede,_,_,dog],List),
   member([_,dane,tea,_,_],List),
   left([green,_,_,_,_],[white,_,_,_,_],List),

   member([green,_,coffee,_,_],List),
   member([_,_,_,pall_mall,bird],List),
   member([yellow,_,_,dunhill,_],List),

   next([_,_,_,blends,_],[_,_,_,_,cat],List),
   next([_,_,_,_,horse],[_,_,_,dunhill,_],List),
   member([_,_,beer,bluemaster,_],List),
   member([_,german,_,prince,_],List),
   next([blue,_,_,_,_],[_,norwegian,_,_,_],List),
   next([_,_,_,blends,_],[_,_,water,_,_],List),
   member([_,FishOwner,_,_,fish],List),

   write('The '),write(FishOwner),write(' owns the fish.').

Unfortunately, not all simple riddles are so simple for Prolog as the latter one. A good example may be the fox, goose and bag of beans puzzle. It is one of my favorite puzzles (my father told me it when I was five and it was the first real puzzle I've ever solved), so it was quite obvious that this was going to be the second program I would write.

These rules govern the movement of the farmer and his stuff:

next(state([rolnik|Tail],X), state(Tail, [rolnik|X])).
next(state(X,[rolnik|Tail]), state([rolnik|X], Tail)).

(The constants are in Polish: rolnik = farmer, koza = goat (goose), kapusta = cabbage (bag of beans), wilk = wolf (fox).)

next(state([rolnik|Animals], Right), state(NewLeft,[rolnik|Rest])) :-
   member(X,Animals),
   delete(Animals, X, NewLeft),
   append([X],Right,Rest).

next(state(Left,[rolnik|Animals]), state([rolnik|Rest],NewRight)) :-
   member(X,Animals),
   delete(Animals, X, NewRight),
   append([X],Left,Rest).

Next, we write which states of the world are acceptable, and which not:

meal(koza,kapusta). % goats eat cabbage
meal(wilk,koza). % wolfs eat goats

not_good(Bank) :-
   \+member(rolnik,Bank),
   meal(X,Y),
   subset([X,Y],Bank).


good(state(X,Y)) :-
   \+not_good(X),
   \+not_good(Y).

and the constraints we want the solution to obey:

legal_chain([X]).

legal_chain([Car, Cadr|Tail]) :- % ah, Lisp reminiscences! :-)
   next(Car,Cadr),
   good(Cadr),
   legal_chain([Cadr|Tail]).

Now, the most intuitive thing we could do now would be to state something like this:

naive-solution(Solution) :-
   Solution = [state([rolnik, koza, kapusta, wilk], []) | _],
   legal_chain(Solution),
   last(Solution, state([], [rolnik, koza, kapusta, wilk]).

However, this definitely won't work. It may be perfectly correct from the declarative and logical point of view, but, as I have said in the previous post, Prolog is not logic. It doesn't automagically find the answer--it performs a depth-first search through the solution space. And in this case, the first path Prolog selects is one of the worst for us. The farmers goes to the other side of the river, returns, goes to the other side, and... Yes, ladies and gentlemen. An infinite loop.

Of course, it is possible to solve this problem in Prolog. The only think we have to do is think about our program more... well, as a program, not as a set of propositions, and change its search behavior. For example, we could implement an iterated, depth-first search (AFAIK, this was the least invasive way of altering my code so that it started to work).

(Well, it isn't precisely iterated depth-first (it looks for the answers only at the bottom o each layer), but the idea is quite the same.)

solve(Solution,N) :-
   (
    between(1,N,X),
    length(Solution,X),
    legal_chain([state([rolnik,koza,kapusta,wilk],[])|Solution]),
    last(Solution,state([],[rolnik,koza,kapusta,wilk]))
   ),!
;
   (
    NewN is N+1,
    solve(Solution,NewN)
   ).

solution(Solution) :-
solve(Solution,1).

You may have noticed that the program does nothing to avoid loops in the solutions. However, this is fine--for every “loopy” solution there exists a shorter one without loops, so we can be sure that the first solution we will find (the shortest one) is loop-free.

The last noteworthy thing is the cut operator (the red “!” in solve). Its task is to prevent backtracking after we have found a solution. It isn't really necessary--if you removed it, the program would just try to find other answers (and would find infinitely many of them--all except one loopy). Overusing it is considered very bad style in Prolog (as someone has said, “[cut] turns Prolog from a nice declarative language into a hybrid monster. Use cuts sparingly and with a sense of having sinned.”). However, I am still learning the language and couldn't resist the temptation of trying it, as soon as I found an adequate occasion. Yes, I am a sinner, and the goose was worth it. ;-)