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?

Answer 1

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

Answer 2

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.

Answer 3

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

Answer 4

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.