I've written some code to do backtracking in Prolog that generates all the possible paths to reach the Gold cell from the initial one (Agent). The input of getAllPaths is the map size NxN. When I run it with a 6x6 map it works perfectly and prints all the possible paths, but when I input any map size >= 7 it prints the first path and gets stuck there when I require the next possible solution with ;. Here is my code:
gold(3, 3).
agent(1, 1).
getAllPaths(MS) :-
agent(X, Y),
assertz(worldSize(MS)),
getAllPathsRec(X, Y, [], []).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, V, L) :-
\+member((X, Y), V), append(V, [(X, Y)], VP),
((gold(X, Y), print(L)) ; move(X, Y, VP, L)).
% Left
move(X, Y, V, L) :-
XP is X - 1, XP > 0,
append(L, [l], LP),
getAllPathsRec(XP, Y, V, LP).
% Right
move(X, Y, V, L) :-
XP is X + 1, worldSize(MS), XP =< MS,
append(L, [r], LP),
getAllPathsRec(XP, Y, V, LP).
% Up
move(X, Y, V, L) :-
YP is Y + 1, worldSize(MS), YP =< MS,
append(L, [u], LP),
getAllPathsRec(X, YP, V, LP).
% Down
move(X, Y, V, L) :-
YP is Y - 1, YP > 0,
append(L, [d], LP),
getAllPathsRec(X, YP, V, LP).
The output:
?- getAllPaths(6).
[r,r,r,r,r,u,l,l,l,l,l,u,r,r]
true ;
[r,r,r,r,r,u,l,l,l,l,l,u,r,u,l,u,r,r,r,r,r,d,l,l,l,d]
true ;
[r,r,r,r,r,u,l,l,l,l,l,u,r,u,l,u,r,r,r,r,r,d,l,l,d,l]
true ;
[...]
?- getAllPaths(7).
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r]
true ;
% It gets stuck here forever...
First I thought it would be for some depth recursion limits, but it's so strange because the map size is only incremented from 36 to 49, and I would probably get some warning or error, but it displays nothing. Any clue?
Here is my variation.
getAllPaths_01(MS, R) :-
agent(X, Y),
getAllPathsRec_01(MS, X, Y, [], R).
getAllPathsRec_01(_MS, X, Y, _V, []) :-
gold(X,Y), !.
% Positions, Visited list, and Path list
getAllPathsRec_01(MS, X, Y, V, R) :-
\+ memberchk((X, Y), V),
move_01(MS, X, Y, [(X, Y)|V], R).
% Left
move_01(MS, X, Y, V, [l|R]) :-
XP is X - 1, XP > 0,
getAllPathsRec_01(MS, XP, Y, V, R).
% Right
move_01(MS, X, Y, V, [r|R]) :-
XP is X + 1, XP =< MS,
getAllPathsRec_01(MS, XP, Y, V, R).
% Up
move_01(MS, X, Y, V, [u|R]) :-
YP is Y + 1, YP =< MS,
getAllPathsRec_01(MS, X, YP, V, R).
% Down
move_01(MS, X, Y, V, [d|R]) :-
YP is Y - 1, YP > 0,
getAllPathsRec_01(MS, X, YP, V, R).
count(S,N) :-
bagof(L,getAllPaths_01(S,L),Ls),
length(Ls,N).
This removes the use assertz/1 so that rerunning the query does not add multiple facts, changes member/2 to memerchk/2 for efficiency, builds the path upon backtracking to avoid append/3, and added a cut to remove the duplicate answers.
Since the result is returned to the top level, added count/2 to show the counts instead of the list.
?- count(3,N).
N = 12.
?- count(4,N).
N = 132.
?- count(5,N).
N = 6762.
?- count(6,N).
N = 910480
This code improve the performance.
I think it's a bad design to mix the search and the printing of the result.
gold(3, 3).
agent(1, 1).
getAllPaths(MS, L) :-
agent(X, Y),
retractall(worldSize(_)),
assertz(worldSize(MS)),
getAllPathsRec(X, Y, [], [], L).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, _V, L, NL) :-
gold(X, Y),
reverse(L, NL).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, V, CL, L) :-
\+member((X, Y), V),
% useless
% append(V, [(X, Y)], VP),
move(X, Y, CL, NX, NY, NL),
% No need to use append to build the list of visited nodes
getAllPathsRec(NX, NY, [(X,Y) | V], NL, L).
% Left
move(X, Y, L, NX, Y, [l|L]) :-
X > 1 ,NX is X - 1.
% Right
move(X, Y, L, NX, Y, [r|L]) :-
worldSize(MS), X < MS,NX is X + 1.
% Up
move(X, Y, L, X, NY, [u|L]) :-
worldSize(MS), Y < MS, NY is Y + 1.
% Down
move(X, Y, L, X, NY, [d|L]) :-
Y > 1, NY is Y - 1.
I get :
?- getAllPaths(7, V), writeln(V).
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,l]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,l,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,l,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,l,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,r,u,l,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,u,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,d,r,u,u,l,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] .
