Block world problem search runs out of stack space - search

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?

Answer 1

For a first test, there is no need to rewrite your code. Not since summer 19721. 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.

Answer 2

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)