Solving Tower of Hanoi declaratively (Prolog)

Question

My professor gave this as an example of Prolog. It is a program that solves the Tower of Hanoi puzzle, where you have to move a stack of disks to another peg by moving one disk after the other, without putting a bigger disk on top of a smaller disk.

Now, I don't like that program. I was told Prolog was meant for declarative programming. I don't want to program how to solve the problem, I want to write down using Prolog what the problem is. Then let Prolog solve it.

My effort so far can be found below. There are two types of lists I employ, a sequence of actions is represented like this: [[1,2],[3,1]]; this would be "move the top disk from peg 1 to peg 2, move the disk from peg 3 to peg 1". My second type of list is a state, for example, if there are three pegs [[1,2,3], [], []] would mean that there are three disks on the first peg. Smaller disks have smaller numbers, so the front of the inner list is the top of a stack.

% A sequence of actions (first argument) is a solution if it leads
% from the begin state (second argument) to the End state (third argument).

solution([], X, X).

solution([[FromIdx | ToIdx] | T], Begin, End) :-
    moved(FromIdx, ToIdx, Begin, X),
    solution(T, X, End).

% moved is true when Result is the resulting state after moving
% a disk from FromIdx to ToIdx starting at state Start

moved(FromIdx, ToIdx, Start, Result) :- 
    allowedMove(FromIdx, ToIdx, Start),
    nth1(FromIdx, Start, [Disk|OtherDisks]),
    nth1(ToIdx, Start, ToStack),
    nth1(FromIdx, Result, OtherDisks),
    nth1(ToIdx, Result, [Disk|ToStack]).

allowedMove(FromIdx, ToIdx, State) :- 
    number(FromIdx), number(ToIdx),
    nth1(FromIdx, State, [FromDisk|_]),
    nth1(ToIdx, State, [ToDisk|_]),
    ToDisk > FromDisk.

allowedMove(_, ToIdx, State) :- nth1(ToIdx, State, []).

The above program seems to work, but it is too slow for everything reasonably complex. Asking it to solve the classic Tower of Hanoi problem, moving three disks from the first peg to the third and last, would go like this:

?- solution(Seq, [[1,2,3], [], []], [[], [], [1,2,3]]).

I would like to make some modifications to the program so that it works for this query. How would I go about doing that? When profiling I can see that nth1 uses a lot of time, should I get rid of it? Something that bothers me is that moved is completely deterministic and should only have one result. How can I speed up this bottleneck?

Coy

I think your entire implementation is imperative in nature. Have you done a stackoverflow.com or google search on "prolog towers of hanoi"? There are numerous examples for how to do this more relationally. – Kinchen

Can you explain what is imperative about it? And to your question: yes I have, but all I could find was in the style of the solution I linked to, which is blatantly imperative. – Coy

I guess I was keying in on all the nth1/3 calls as you were also indicating in your question. There are some minor things to fix, like rather than [[FromIdx | ToIdx] | T] a form such as [FromIdx-ToIdx | T] might be more appropriate. In the large, you could take the "standard" approach and use CLP(FD) (N #> 1, N #= N-1) and carry a list argument for the moves rather than the writes you commonly see in other implementations. – Kinchen

I did a quick and dirty conversion and it almost worked, except in a query like, hanoi(N, [...]) which would yield N for a valid set of hanoi moves, but after finding the solution it did have some.. er... termination issues. :p – Kinchen

Answer 1

The Prolog solution to Hanoi one typically finds looks something like this. The solution writes the moves out to the screen as it encounters them and doesn't collect the moves in a list:

move_one(P1, P2) :-
    format("Move disk from ~k to ~k", [P1, P2]), nl.

move(1, P1, P2, _) :-
    move_one(P1, P2).
move(N, P1, P2, P3) :-
    N > 1,
    N1 is N - 1,
    move(N1, P1, P3, P2),
    move(1, P1, P2, P3),
    move(N1, P3, P2, P1).

hanoi(N) :-
    move(N, left, center, right).

This could be modified to collect the moves in a list instead by adding a list argument throughout and using append/3:

move(0, _, _, _, []).
move(N, P1, P2, P3, Moves) :-
    N > 0,
    N1 is N - 1,
    move(N1, P1, P3, P2, M1),
    append(M1, [P1-to-P2], M2),
    move(N1, P3, P2, P1, M3),
    append(M2, M3, Moves).

hanoi(N, Moves) :-
    move(N, left, center, right, Moves).

We were able to make the base case simpler without the write. The append/3 does the job, but it's a bit clunky. Also, the is/2 in particular makes it non-relational.

By using a DCG and CLP(FD), the append/3 can be eliminated and it can be made more relational. Here's what I'd call an initial "naive" approach, and it is also more readable:

hanoi_dcg(N, Moves) :-
    N in 0..1000,
    phrase(move(N, left, center, right), Moves).

move(0, _, _, _) --> [].
move(N, P1, P2, P3) -->
    { N #> 0, N #= N1 + 1 },
    move(N1, P1, P3, P2),
    [P1-to-P2],
    move(N1, P3, P2, P1).

This results in:

| ?- hanoi_dcg(3, Moves).

Moves = [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center] ? a

no
| ?- hanoi_dcg(N,  [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center]).

N = 3 ? ;

(205 ms) no
| ?-

Although it's relational, it does have a couple of issues:

• Useless choice points in "both directions"
• Termination issues unless constrained with something like N in 0..1000

I sense there's a way around these two issues, but haven't worked that out yet. (I'm sure if some smarter Prologers than I, such as @mat, @false, or @repeat see this, they'll have a good answer right off.)

Kinchen

Do you really think someone in the third week of learning prolog can appreciate your answer? – Plaything

@PatrickJ.S. the short answer is "yes". (And where did OP say they are in their 3rd week?) It only takes a few minutes of reading to understand what the fundamental concepts of CLP(FD) and DCG are about in Prolog which make it easy to express problems like this more clearly. I assume that when someone asks a question such as how to solve the Hanoi puzzle in a relational way that they are wanting to learn aspects of Prolog which facilitate such a solution. – Kinchen

Great solution! I mean the actual Prolog solution, before the edit! (I do not consider a solution involving side-effects a "typical Prolog solution"; maybe a "typical Prolog bowdlerization", but not more.) I would also go with the DCG and CLP(FD) solution only, maybe improve the naming a bit (disks_moves/2?) and make it a bit more general: A definitely applicable upper bound for the number of disks is certainly the length of the moves, no? This solves termination issues. Nice relational solution (before the edit), +1! – Nazarene

@Nazarene thanks. I decided to add the first two for "contrast" since the first especially appears so much around the 'net. The solution with appends is admittedly icky. – Kinchen

It's OK to also show how to not solve it well, I just can't call that a "typical Prolog solution". Maybe a pseudo-solution, half-baked solution, ... – Nazarene

@Nazarene yeah, I guess "typical" means "what one typically find" not "what's best". – Kinchen

indeed, and I hope that one day "what one typically finds" is "what's best".. By this I mean a general and elegant solution, which I think is much more typical for a good Prolog program. – Nazarene

Answer 2

I looked at your solution and here is some thought I had about it:

When you move, what you're doing is take from one tower and put on another. There is a SWI-Predicate that replaces an element in a list, select/4. But you also want to have the index where you replaced it. so lets rewrite it a little, and call it switch_nth1, because it doesn't have to do much with select anymore.

% switch_nth1(Element, FromList, Replacement, ToList, Index1)
switch_nth1(Elem, [Elem|L], Repl, [Repl|L], 1).
switch_nth1(Elem, [A|B], D, [A|E], M) :-
    switch_nth1(Elem, B, D, E, N),
    M is N+1.

Since we're operating on List of Lists, we'll need two switch_nth1 calls: one to replace the Tower we take from, and one to put it on the new tower.

A move predicate could look like this (sorry I changed the arguments a little). (It should be called allowed_move because it doesn't do moves that aren't allowed).

move((FromX - ToX), BeginState, NewState):-
    % take a disk from one tower
    switch_nth1([Disk| FromTowerRest], BeginState, FromTowerRest, DiskMissing, FromX),
    % put the disk on another tower.
    switch_nth1(ToTower, DiskMissing, [Disk|ToTower], NewState, ToX),

    %  there are two ways how the ToTower can look like:
    (ToTower = [];              % it's empty
     ToTower = [DiskBelow | _], % it already has some elements on it.
     DiskBelow > Disk).

If you plug that into your solution you sadly run into some termination issues, since noone said that a state that already has been reached shouldn't be a right step on the way. Thus, we need to keep track where we already were and disallow continuation when a known state is reached.

solution(A,B,C):-solution_(A,B,C,[B]).

solution_([], X, X,_).
solution_([Move | R], BeginState, EndState, KnownStates):-
   move(Move, BeginState, IntermediateState),
   \+ memberchk(IntermediateState, KnownStates), % don't go further, we've been here.
   solution_(R, IntermediateState, EndState, [IntermediateState | KnownStates]).

That said, this solution still is very imperative – there should be nicer solutions out there, where you really take advantage of recursion.

Plaything

Answer 3

By "declarative" I'll assume you mean something close to the old slogan of "in Prolog, to write down a question is to have the answer to it". Let Prolog discover the answer instead of me just coding in Prolog the answer that I had to find out on my own.

Simply defining a legal_move predicate, stating the initial and final condition and running a standard search of whatever variety, leads to extremely very inefficient solution that will backtrack a whole lot.

Making a computer derive the efficient solution here seems a very hard problem to me. For us humans though, with just a little bit of thinking the solution is obvious, cutting away all the redundancy too, making any comparisons and checking the legality of positions completely unnecessary -- the solution is efficient and every move is legal by construction.

If we can move N = M + K disks, we can move M of them just the same - the other two pegs are empty, and we pretend the lower K disks aren't there.

But having moved the M disks, we're faced with the remaining K. Wherever the M disks went, we can't move any of the K there, because by construction the K disks are all "larger" than any of the M ("larger" simply because they were beneath them initially on the source peg).

But the third peg is empty. It is easy to move one disk there. Wouldn't it be just peachy if K were equal 1? Having moved the remaining K = 1 disk to the empty target peg, we again can pretend it isn't there (because it's the "largest") and move the M disks on top of it.

The vital addition: since M disks are to be moved to target in the second phase, initially they are to be moved into the spare.

This all means that if we knew how to move M disks, we could easily move M + 1. Induction, recursion, DONE!

If you knew all this already, apologies for the load of verbiage. The code:

hanoi(Disks, Moves):- 
    phrase( hanoi(Disks, [source,target,spare]), Moves).

hanoi( Disks, [S,T,R]) -->
    { append( M, [One], Disks) }, 
    hanoi( M, [S,R,T]),
    [ moving( One, from(S), to(T)) ],
    hanoi( M, [R,T,S]).
hanoi( [], _) --> [ ].

Testing:

4 ?- hanoi([1,2,3], _X), maplist( writeln, _X).
moving(1,from(source),to(target))
moving(2,from(source),to(spare))
moving(1,from(target),to(spare))
moving(3,from(source),to(target))
moving(1,from(spare),to(source))
moving(2,from(spare),to(target))
moving(1,from(source),to(target)) ;
false.

Improbable

Answer 4

This is a solution which is purely declarative. But it takes around 20s on my computer to get the answer.

% describing all the legal moves
move([[Disk|L1],[H2|T2],L3],[L1,[Disk,H2|T2],L3],[a,b,Disk]) :- Disk < H2.
move([[Disk|L1],[],L3],[L1,[Disk],L3],[a,b,Disk]).
move([[Disk|L1],L2,[H3|T3]],[L1,L2,[Disk,H3|T3]],[a,c,Disk]) :- Disk < H3.
move([[Disk|L1],L2,[]],[L1,L2,[Disk]],[a,c,Disk]).
move([L1,[Disk|L2],[H3|T3]],[L1,L2,[Disk,H3|T3]],[b,c,Disk]) :- Disk < H3.
move([L1,[Disk|L2],[]],[L1,L2,[Disk]],[b,c,Disk]).
move([[H1|T1],[Disk|L2],L3],[[Disk,H1|T1],L2,L3],[b,a,Disk]) :- Disk < H1.
move([[],[Disk|L2],L3],[[Disk],L2,L3],[b,a,Disk]).
move([[H1|T1],L2,[Disk|L3]],[[Disk,H1|T1],L2,L3],[c,a,Disk]) :- Disk < H1.
move([[],L2,[Disk|L3]],[[Disk],L2,L3],[c,a,Disk]).
move([L1,[H2|T2],[Disk|L3]],[L1,[Disk,H2|T2],L3],[c,b,Disk]) :- Disk < H2.
move([L1,[],[Disk|L3]],[L1,[Disk],L3],[c,b,Disk]).

% initial state, disks are numbered from 1 to 4 (from the smallest to the largest)
hanoi([1,2,3,4],[],[],[]).
hanoi(A1,B1,C1,[M|Ms]) :- 
    move([A0,B0,C0],[A1,B1,C1],M),
    hanoi(A0,B0,C0,Ms).

Query must use iterative deepening i.e. exhaustively search for a solution for a list of moves of length n before considering searching for a solution for a list of moves of length n+1:

length(_Ms, _),hanoi([],[],[1,2,3,4],_Ms),reverse(_Ms,Solution).

Oviform