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

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