How to keep Prolog from going back and forth between the same two steps forever?

Question

Behold the following "solution" to the Towers of Hanoi problem:

f([],[],_).

f([A|As],[],C) :- f(As,[A],C).
f([A|As],B,[]) :- f(As,B,[A]).

f([],[B|Bs],C) :- f([B],Bs,C).
f(A,[B|Bs],[]) :- f(A,Bs,[B]).

f([],B,[C|Cs]) :- f([C],B,Cs).
f(A,[],[C|Cs]) :- f(A,[C],Cs).

f([A|As],[B|Bs],C) :- A < B, f(As,[A,B|Bs],C).
f([A|As],B,[C|Cs]) :- A < C, f(As,B,[A,C|Cs]).

f([A|As],[B|Bs],C) :- B < A, f([B,A|As],Bs,C).
f(A,[B|Bs],[C|Cs]) :- B < C, f(A,Bs,[B,C|Cs]).

f([A|As],B,[C|Cs]) :- C < A, f([C,A|As],B,Cs).
f(A,[B|Bs],[C|Cs]) :- C < B, f(A,[C,B|Bs],Cs).

But this will never finish as Prolog is getting stuck at moving disk 1 back and forth between rod A and B ad infinitum:

[trace]  ?- f([1,2,3],[],[]).
   Call: (10) f([1, 2, 3], [], []) ? creep
   Call: (11) f([2, 3], [1], []) ? creep
   Call: (12) f([3], [1], [2]) ? creep
   Call: (13) 3<1 ? creep
   Fail: (13) 3<1 ? creep
   Redo: (12) f([3], [1], [2]) ? creep
   Call: (13) 3<2 ? creep
   Fail: (13) 3<2 ? creep
   Redo: (12) f([3], [1], [2]) ? creep
   Call: (13) 1<3 ? creep
   Exit: (13) 1<3 ? creep
   Call: (13) f([1, 3], [], [2]) ? creep
   Call: (14) f([3], [1], [2]) ? creep
   Call: (15) 3<1 ? creep
   Fail: (15) 3<1 ? creep
   Redo: (14) f([3], [1], [2]) ? creep
   Call: (15) 3<2 ? creep
   Fail: (15) 3<2 ? creep
   Redo: (14) f([3], [1], [2]) ? creep
   Call: (15) 1<3 ? creep
   Exit: (15) 1<3 ? creep
   Call: (15) f([1, 3], [], [2]) ? creep
   Call: (16) f([3], [1], [2]) ? creep
   Call: (17) 3<1 ? creep
   Fail: (17) 3<1 ? creep
   Redo: (16) f([3], [1], [2]) ? creep
   Call: (17) 3<2 ? creep
   Fail: (17) 3<2 ? creep
   Redo: (16) f([3], [1], [2]) ? creep
   Call: (17) 1<3 ? creep
   Exit: (17) 1<3 ? creep
   Call: (17) f([1, 3], [], [2]) ? creep
   Call: (18) f([3], [1], [2]) ? 
   [...]

I'm generally aware of cuts being used in similar situations. But where would you place a cut here if that is required or indicated?

How to make this program finish without having to rearrange it based on specifics of the backtrack trace? Because I assume this would be an option here but this is of course a toy example.

Answer 1

According to /u/brebs something like this would be the most straightforward adaption of my code, keeping track of and avoiding past states. This does not just look ugly it is - if I dare to say - downright unmaintainable. Hence I hope some Prolog Yedi is taking notice of my plight and enlightens me as how to do it right.

f([],[],_,P,P).

f([A|As],[],C,P,P_) :- 
    \+ member([As,[A],C],P), 
    f(As,[A],C,[[As,[A],C]|P],P_).
f([A|As],B,[],P,P_) :- 
    \+ member([As,B,[A]],P), 
    f(As,B,[A],[[As,B,[A]]|P],P_).

f([],[B|Bs],C,P,P_) :- 
    \+ member([[B],Bs,C],P), 
    f([B],Bs,C,[[[B],Bs,C]|P],P_).
f(A,[B|Bs],[],P,P_) :- 
    \+ member([A,Bs,[B]],P), 
    f(A,Bs,[B],[[A,Bs,[B]]|P],P_).

f([],B,[C|Cs],P,P_) :- 
    \+ member([[C],B,Cs],P), 
    f([C],B,Cs,[[[C],B,Cs]|P],P_).
f(A,[],[C|Cs],P,P_) :- 
    \+ member([A,[C],Cs],P), 
    f(A,[C],Cs,[[A,[C],Cs]|P],P_).

f([A|As],[B|Bs],C,P,P_) :- A < B, 
    \+ member([As,[A,B|Bs],C],P), 
    f(As,[A,B|Bs],C,[[As,[A,B|Bs],C]|P],P_).
f([A|As],B,[C|Cs],P,P_) :- A < C, 
    \+ member([As,B,[A,C|Cs]],P), 
    f(As,B,[A,C|Cs],[[As,B,[A,C|Cs]]|P],P_).

f([A|As],[B|Bs],C,P,P_) :- B < A, 
    \+ member([[B,A|As],Bs,C],P), 
    f([B,A|As],Bs,C,[[[B,A|As],Bs,C]|P],P_).
f(A,[B|Bs],[C|Cs],P,P_) :- B < C, 
    \+ member([A,Bs,[B,C|Cs]],P), 
    f(A,Bs,[B,C|Cs],[[A,Bs,[B,C|Cs]]|P],P_).

f([A|As],B,[C|Cs],P,P_) :- C < A, 
    \+ member([[C,A|As],B,Cs],P), 
    f([C,A|As],B,Cs,[[[C,A|As],B,Cs]|P],P_).
f(A,[B|Bs],[C|Cs],P,P_) :- C < B, 
    \+ member([A,[C,B|Bs],Cs],P), 
    f(A,[C,B|Bs],Cs,[[A,[C,B|Bs],Cs]|P],P_).

At least it terminates with a solution.

?- f([1,2,3],[],[],[[[1,2,3],[],[]]],P), reverse(P,P_), write(P_).

[[[1,2,3],[],[]],[[2,3],[1],[]],[[3],[1],[2]],[[1,3],[],[2]],
 [[1,3],[2],[]],[[3],[2],[1]],[[3],[1,2],[]],[[],[1,2],[3]],
 [[1],[2],[3]],[[],[2],[1,3]],[[2],[],[1,3]],[[2],[1],[3]],
 [[],[1],[2,3]],[[1],[],[2,3]],[[],[],[1,2,3]]]

Answer 2

For beginners, clpfd is debatable to include (and is also overkill for this simple task), so here's the Peano equivalent of lurker's answer:

% Ending state
move(0, _, _, _) --> [].
% "s" for "successor"
move(s(N), P1, P2, P3) -->
    move(N, P1, P3, P2),
    [P1-to-P2],
    move(N, P3, P2, P1).

Results in swi-prolog:

?- phrase(move(s(s(s(0))), left, center, right), Moves).
Moves = [left-to-center, left-to-right, center-to-right,
left-to-center, right-to-left, right-to-center, left-to-center].

This has fewer unwanted choicepoints, since 0 vs s(N) is covered by first-argument indexing.

s(s(s(0))) is 4 as Peano. Here's code to convert.

--> is DCG notation, which in essence provides efficient and succinct list-handling.

Answer 3

You evidently want to define the search space by describing the legal moves and the final state, and let the search engine find its way to the solution on its own. But Prolog is a depth-first search engine, so it doesn't work here because, as coded, the search space has infinite depth, as you rightly note. The enumeration of attempted solution isn't "fair" since Prolog works in top-down left-to-right order which is what leads to it being "depth-first".

A general answer to this is to use some kind of diagonalization of streams of partial solutions that can deal with infinite depth as well as infinite branching, to get a "fair enumeration" of solutions.

Here though the branching, i.e. the number of legal moves from each legal position, is finite, so the simpler, breadth-first exploration is sufficient.

So instead of coding the moves one by one, code up just one transition rule that turns a position into a list of all valid "next" positions. Then it's easy to code the breadth-first search with that.

Just pop a position from an "agenda" list of positions to explore -- initially containing just one, starting position -- then turn that position to a list of its next positions, and append that list to the agenda, putting it at its end. This is what makes it breadth first, exploring the space level by level, so that the shortest path to the solution, if any, is found first.

Prepending it at the start of the agenda list would result in the depth-first search again. Mixing the two up in some clever ways would make the search be clever, in some strange and clever way. Like if you had some heuristics, you could put the "better" solutions first.

Instead of positions you can maintain the whole paths i.e. sequences of moves leading to each position, if needed.

You'll still have to code it all yourself, since Prolog is a depth-first, top-down left-to-right search engine. It's a programming language, it is not a declarative programming system that would analyze your code by itself, and find ways to get to the solution by itself, a system that would be aware of its own computation processes and capable of adjusting itself, switching from depth first to breadth first or to diagonalization, all on its own, as one example. Prolog doesn't do that.

Answer 4

Here's a quick stab at a more elegant solution than the OP's:

start_state(N, st(L, [], [])) :-
    numlist(1, N, L).

end_state(st([], [], _)).

% Can move any disk to an empty tower
% Destination is first arg, for first-argument indexing
can_move([], [H|T], [H], T).
% Can move disk if smaller
can_move([E|R], [H|T], [H|[E|R]], T) :-
    E > H.

can_moves(E, E, _, []).
can_moves(State, EndState, Visited, [SrcT-DesT|Moves]) :-
    % Prepare NextState
    functor(NextState, st, 3),
    % Select action
    Towers = [1, 2, 3],
    select(SrcT, Towers, Towers0),
    select(DesT, Towers0, [OtherT]),
    arg(SrcT, State, SrcL),
    arg(DesT, State, DesL),
    can_move(DesL, SrcL, DesNext, SrcNext),
    % Assemble NextState
    arg(SrcT, NextState, SrcNext),
    arg(DesT, NextState, DesNext),
    % The unchanged tower
    arg(OtherT, State, Other),
    arg(OtherT, NextState, Other),
    % Prevent infinite loop
    \+ member(NextState, Visited),
    % Loop
    can_moves(NextState, EndState, [NextState|Visited], Moves).

moves(NumOfDisks, Moves) :-
    start_state(NumOfDisks, StartState),
    end_state(EndState),
    can_moves(StartState, EndState, [StartState], Moves).

Results in swi-prolog:

?- length(M, _), moves(3, M).
M = [1-3, 1-2, 3-2, 1-3, 2-1, 2-3, 1-3] ;
...

?- length(M, _), moves(4, M).
M = [1-2, 1-3, 2-3, 1-2, 3-1, 3-2, 1-2, 1-3, 2-3, 2-1, 3-1, 2-3, 1-2, 1-3, 2-3] ;
...

This is using length/2 to get the shortest list of moves first, as the easiest/laziest way - could instead implement breadth-first-search will a tiny bit of extra effort, as Will Ness mentioned.