Block world problem search runs out of stack space

Question

I have the following code:

move(state(on(X, NewX), OldY, Z), state(NewX, on(X, OldY), Z)).
move(state(on(X, NewX), Y, OldZ), state(NewX, Y, on(X, OldZ))).

move(state(OldX, on(Y, NewY), Z), state(on(Y, OldX), NewY, Z)).
move(state(X, on(Y, NewY), OldZ), state(X, NewY, on(Y, OldZ))).

move(state(OldX, Y, on(Z, NewZ)), state(on(Z, OldX), Y, NewZ)).
move(state(X, OldY, on(Z, NewZ)), state(X, on(Z, OldY), NewZ)).

path(X,X,[]).
path(X,Y,[Z|ZS]) :- 
    move(X,Z),
    path(Z,Y,ZS).

Where move give us the possible movements that you can use and path should give us the path that you have to take from X to Y.

The problem is that the predicate path doesn't work as I want, i.e., if I type path(state(on(c,on(b,on(a,void))), void, void), state(void, void, on(c,on(a,on(b,void)))), X). I got ERROR: Out of local stack, but I want that that X would be

X=[state(void, void, on(c,on(a,on(b,void)))),
state(void, on(c,void), on(void(a,on(b,void))),
state(on(a,void), on(c,void), on(b,void)),
state(on(b,on(a,void)), on(c,void), void),
state(on(c,on(b,on(a,void))), void, void)].

So what am I doing wrong?

You need to keep track of whether you have already "visited" a particular node along the way to avoid path loops. You can do this by including an argument where you collect nodes you've visited and, before recursing along `path`, check first whether the node is in the list. — lurker, May 02 '20 at 11:14

false · Accepted Answer · 2022-08-11T14:47:53.667

For a first test, there is no need to rewrite your code. Not since summer 1972¹. Instead, you can reformulate your queries sparingly.

Instead of asking for a concrete answer which demands from your Prolog system quite a bit of ingenuity, let's formulate your answer as a query! I tried it and realized that you have some nasty syntax errors in them, and after that, the query failed..

But there is a cheaper way! Let's just limit the length of the list and let Prolog fill out the rest. How long shall that list be? We know not (that is, I don't). OK, so let's try out any length! Also this is something Prolog loves. It is as easy as:

?- length(X,N),  % new
   path(  state(on(c,on(b,on(a,void))), void, void),
          state(void, void, on(c,on(a,on(b,void)))),
          X).
   X = [ state(on(b,on(a,void)),on(c,void),void),
         state(on(a,void),on(c,void),on(b,void)),
         state(void,on(c,void),on(a,on(b,void))),
         state(void,void,on(c,on(a,on(b,void)))) ],
   N = 4
;  ... .

See what I did? I only added length(X, N) in front. And out of a sudden Prolog answered with a shorter answer than you expected!

Now, is this really the best way to ask? After all, many of the answers might be simple cycles, putting a block into one place and back again... Are there really any cycles? Let's ask that first:

... --> [] | [_], ... .

?- length(X,N),
   path( state(on(c,on(b,on(a,void))), void, void),
         state(void, void, on(c,on(a,on(b,void)))),
         X),
   phrase((...,[E],...,[E],...), X).
   X = ...
   N = 6,
   E = state(void,on(c,void),on(a,on(b,void)))
;  ... .

Oh yes, there are! Now it does make sense to rule out such paths. Here is a clean way:

alldifferent([]).
alldifferent([X|Xs]) :-
   maplist(dif(X), Xs),
   alldifferent(Xs).

?- alldifferent(X),
   length(X,N),
   path( state(on(c,on(b,on(a,void))), void, void),
         state(void, void, on(c,on(a,on(b,void)))),
         X).

How far can you get with this formulation? Currently, I found a path of length 48 ... 55 ... Shouldn't it be finite? And: Is it possible to rule out such long paths for such trivial problems? Any toddler can keep the search space small... These are all fundamental questions, but they are independent of the programming problem as such.

Or, see it from another angle: The set of solutions for X is pretty large. So if we are exploring this set, where shall we start? What does it mean to be the best solution? The one that when uploaded on Utube produces the most upvotes? So what we are doing here is completely uninformed search. You would need to inform the program what kind of preference you have. It cannot guess it reasonably. OK, one heuristics would be the term size of a solution. length/2 did that.

Note that I did not dare to touch your clean code. Yes, I could have improved it somewhat, say by using path/4, but not by much. Rather stick to your highly clean style and rather do more querying instead! That is what Prolog is excellent at!

Other improvements: Use a list to represent the stack, this makes the state much more appealing.

_{1 That's the year Prolog was discovered/conceived/delivered.}

Final remark: I believe it is better to include the original node in the path such that such cycles can be ruled out as well. — false, May 02 '20 at 23:03

David Tonhofer · Answer 2 · 2020-05-02T10:54:52.997

Ohh... a block world problem!

It is simply because you do two things:

Depth first search through state space.
Failure to test whether a state has already been visited.

(Additionally, the solution you give is not a reachable state, the second line has a void on a wrong position, plus the path is reversed).

In fact, you construct the path through state path on return only in the third argument here: path(X,Y,[Z|ZS]).

You have to check on each state expansion whether a new state might already be on the path. Otherwise the program may cycle forever (depending on how it hits the move/2 move-generating predicate ... actually a nice exercise select a move/2 probabilistically... maybe later). In the code below, the check is done by fail_if_visited/2.

Additionally, a depth-first search according to the above will find a solution path, but the will likely not be a short path and not the solution sought.

You really need breadth-first search (or rather, Iterative Deepening). As Prolog doesn't allow to switch out the search algorithm (why not? it's been over 40 years), you have to roll one yourself.

Observe:

% ===
% Transform a state into a string
% ===

express(state(A,B,C),S) :- 
   express_pos(A,SA),
   express_pos(B,SB),
   express_pos(C,SC),
   atomic_list_concat(["[",SA,",",SB,",",SC,"]"],S).

express_pos(on(Top,Rest),S) :- 
   express_pos(Rest,S2), 
   atomic_list_concat([Top,S2],S).

express_pos(void,""). 

% ===
% Transform a path into a string
% (The path is given in the reverse order; no matter)
% ===

express_path(Path,PathStr) :-
   express_path_states(Path,StateStrs),
   atomic_list_concat(StateStrs,"<-",PathStr).

express_path_states([S|Ss],[StateStr|SubStateStrs]) :-   
   express_path_states(Ss,SubStateStrs),
   express(S,StateStr).

express_path_states([],[]).

% ===
% For debugging
% ===

debug_proposed(Current,Next,Moved,Path) :-
   express(Current,CurrentStr),
   express(Next,NextStr),
   length(Path,L),
   debug(pather,"...Proposed at path length ~d: ~w -> ~w (~q)",[L,CurrentStr,NextStr,Moved]).

debug_accepted(State) :-
   express(State,StateStr),
   debug(pather,"...Accepted: ~w",[StateStr]).

debug_visited(State) :-
   express(State,StateStr),
   debug(pather,"...Visited: ~w",[StateStr]).

debug_moved(X) :-
   debug(pather,"...Already moved: ~w",[X]).

debug_final(State) :-
   express(State,StateStr),
   debug(pather,"Final state reached: ~w",[StateStr]).

debug_current(State,Path) :-
   express(State,StateStr),
   express_path(Path,PathStr),
   length(Path,L),
   debug(pather,"Now at: ~w with path length ~d and path ~w",[StateStr,L,PathStr]).

debug_path(Path) :-
   express_path(Path,PathStr),
   debug(pather,"Path: ~w",[PathStr]).

% ===
% Moving blocks between three stacks, also recording the move
% ===

move(state(on(X, A), B, C), 
     state(A, on(X, B), C),
     moved(X,"A->B")).

move(state(on(X, A), B, C), 
     state(A, B, on(X, C)),
     moved(X,"A->C")).

move(state(A, on(X, B), C), 
     state(on(X, A), B, C),
     moved(X,"B->A")).

move(state(A, on(X, B), C), 
     state(A, B, on(X, C)),
     moved(X,"B->C")).

move(state(A, B, on(X, C)), 
     state(on(X, A), B, C),
     moved(X,"C->A")).

move(state(A, B, on(X, C)), 
     state(A, on(X, B), C),
     moved(X,"C->B")).

move(_,_,_,_) :- debug(pather,"No more moves",[]).

% ===
% Finding a path from an Initial State I to a Final State F.
% You have to remember the path taken so far to avoid cycles,
% instead of trying to reach the final state while the path-so-far
% is sitting inaccessible on the stack, from whence it can only be
% be reconstructed on return-fro-recursion.
% ===

fail_if_visited(State,Path) :- 
   (memberchk(State,Path) 
   -> (debug_visited(State),fail)
   ; true).

fail_if_moved(moved(X,_),LastMoved) :-
   (LastMoved = moved(X,_)
   -> (debug_moved(X),fail)
   ; true).

path2(F,F,Path,Path,_) :- 
    debug_final(F).

path2(I,F,PathToI,FullPath,LastMoved) :-
    dif(I,F),                          % I,F are sure different (program will block if it can't be sure)
    debug_current(I,PathToI),
    move(I,Next,Moved),                % backtrackably pattern-match yourself an acceptable next state based on I
    ground(Next),                      % fully ground, btw
    debug_proposed(I,Next,Moved,PathToI),
    fail_if_moved(Moved,LastMoved),    % don't want to move the same thing again
    fail_if_visited(Next,PathToI),     % maybe already visited?
    debug_accepted(Next),              % if we are here, not visited
    PathToNext = [Next|PathToI],
    path2(Next,F,PathToNext,FullPath,Moved). % recurse with path-so-far (in reverse) 

% ---
% Top call
% ---

path(I,F,Path) :- 
   PathToI = [I],
   path2(I,F,PathToI,FullPath,[]),     % FullPath will "fish" the full path out of the depth of the stack
   reverse(FullPath,Path),             % don't care about efficiency of reverse/2 at all
   debug_path(Path).

% ===
% Test 
% ===

:- begin_tests(pather).

test(one, true(Path = [state(void, void, on(c,on(a,on(b,void)))),
                       state(void, on(c,void), on(void(a,on(b,void)))),
                       state(on(a,void), on(c,void), on(b,void)),
                       state(on(b,on(a,void)), on(c,void), void),
                       state(on(c,on(b,on(a,void))), void, void)]))

     :- I = state(on(c,on(b,on(a,void))), void, void),
        F = state(void, void, on(c,on(a,on(b,void)))),
        path(I,F,Path).

:- end_tests(pather).

rt :- debug(pather),run_tests(pather).

At the end we get:

% ...Accepted: [c,,ab]
% Now at: [c,,ab] with path length 24 and path [c,,ab]<-[,c,ab]<-[,ac,b]<-[b,ac,]<-[ab,c,]<-[ab,,c]<-[b,a,c]<-[,a,bc]<-[a,,bc]<-[a,b,c]<-[,ab,c]<-[c,ab,]<-[ac,b,]<-[ac,,b]<-[c,a,b]<-[,ca,b]<-[b,ca,]<-[cb,a,]<-[cb,,a]<-[b,c,a]<-[,bc,a]<-[a,bc,]<-[ba,c,]<-[cba,,]
% ...Proposed at path length 24: [c,,ab] -> [,c,ab] (moved(c,"A->B"))
% ...Already moved: c
% ...Proposed at path length 24: [c,,ab] -> [,,cab] (moved(c,"A->C"))
% ...Already moved: c
% ...Proposed at path length 24: [c,,ab] -> [ac,,b] (moved(a,"C->A"))
% ...Visited: [ac,,b]
% ...Proposed at path length 24: [c,,ab] -> [c,a,b] (moved(a,"C->B"))
% ...Visited: [c,a,b]
% ...Proposed at path length 23: [,c,ab] -> [,,cab] (moved(c,"B->C"))
% ...Accepted: [,,cab]
% Final state reached: [,,cab]
% Path: [cba,,]<-[ba,c,]<-[a,bc,]<-[,bc,a]<-[b,c,a]<-[cb,,a]<-[cb,a,]<-[b,ca,]<-[,ca,b]<-[c,a,b]<-[ac,,b]<-[ac,b,]<-[c,ab,]<-[,ab,c]<-[a,b,c]<-[a,,bc]<-[,a,bc]<-[b,a,c]<-[ab,,c]<-[ab,c,]<-[b,ac,]<-[,ac,b]<-[,c,ab]<-[,,cab]
ERROR: /home/homexercises/pather.pl:146:
        test one: wrong answer (compared using =)
ERROR:     Expected: [state(void,void,on(c,on(a,on(b,void)))),state(void,on(c,void),on(void(a,on(b,void)))),state(on(a,void),on(c,void),on(b,void)),state(on(b,on(a,void)),on(c,void),void),state(on(c,on(b,on(a,void))),void,void)]
ERROR:     Got:      [state(on(c,on(b,on(a,void))),void,void),state(on(b,on(a,void)),on(c,void),void),state(on(a,void),on(b,on(c,void)),void),state(void,on(b,on(c,void)),on(a,void)),state(on(b,void),on(c,void),on(a,void)),state(on(c,on(b,void)),void,on(a,void)),state(on(c,on(b,void)),on(a,void),void),state(on(b,void),on(c,on(a,void)),void),state(void,on(c,on(a,void)),on(b,void)),state(on(c,void),on(a,void),on(b,void)),state(on(a,on(c,void)),void,on(b,void)),state(on(a,on(c,void)),on(b,void),void),state(on(c,void),on(a,on(b,void)),void),state(void,on(a,on(b,void)),on(c,void)),state(on(a,void),on(b,void),on(c,void)),state(on(a,void),void,on(b,on(c,void))),state(void,on(a,void),on(b,on(c,void))),state(on(b,void),on(a,void),on(c,void)),state(on(a,on(b,void)),void,on(c,void)),state(on(a,on(b,void)),on(c,void),void),state(on(b,void),on(a,on(c,void)),void),state(void,on(a,on(c,void)),on(b,void)),state(void,on(c,void),on(a,on(b,void))),state(void,void,on(c,on(a,on(b,void))))]
 done
% 1 test failed
% 0 tests passed
false.

A path of length 23 successfully reaches the final state, but is "too long" according to the sought solution. Even with the heuristic "do not move a block twice" expressed in fail_if_moved/2.

Addendum: Probabilistic search

Using a Randomized Algorithm is amazingly rewarding:

Rip out the move/3 predicate from above and replace it by:

move(From,To,Moved) :-
   random_permutation([0,1,2,3,4,5],ONs),  % permute order numbers
   !,                                      % no backtracking past here!
   move_randomly(ONs,From,To,Moved).       % try to match a move 

move_randomly([ON|___],From,To,Moved) :- move(ON,From,To,Moved).
move_randomly([__|ONs],From,To,Moved) :- move_randomly(ONs,From,To,Moved).
move_randomly([],_,_,_)               :- debug(pather,"No more moves",[]).

move(0,state(on(X, A), B, C), 
     state(A, on(X, B), C),
     moved(X,"0: A->B")).

move(1,state(on(X, A), B, C), 
     state(A, B, on(X, C)),
     moved(X,"1: A->C")).

move(2,state(A, on(X, B), C), 
     state(on(X, A), B, C),
     moved(X,"2: B->A")).

move(3,state(A, on(X, B), C), 
     state(A, B, on(X, C)),
     moved(X,"3: B->C")).

move(4,state(A, B, on(X, C)), 
     state(on(X, A), B, C),
     moved(X,"4: C->A")).

move(5,state(A, B, on(X, C)), 
     state(A, on(X, B), C),
     moved(X,"5: C->B")).

Evidently this is not the paradigm of efficient Prolog, but who cares:

A solution of length 5 was found within 7 tries only!

Path: [cba,,]<-[ba,c,]<-[a,c,b]<-[,c,ab]<-[,,cab] (Length 5)

Block world problem search runs out of stack space

2 Answers2

Addendum: Probabilistic search