I've tried to implement Breadth First Search algorithm in MMA, to attempt to solve the 8-puzzle game. But in some cases, I ran out of memory, but on other cases it solves without problem.
Here is the code I am using to make BFS, in the case of inicial = {{1, 6, 2}, {0, 4, 3}, {7, 5, 8}}; you get the desired answer, run the following code and see the result
mutacion[tablero_List] :=
Module[{posc, directions, newposs, olddigits},
posc = Flatten[Position[tablero, 0]];
directions = Select[Tuples[Range[-1, 1], 2], Norm[#] == 1 &];
newposs = (posc + #) & /@ directions;
newposs = Select[newposs, FreeQ[#, 4] \[And] FreeQ[#, 0] &];
olddigits = Extract[tablero, newposs];
MapThread[
ReplacePart[tablero, {#1 -> 0, posc -> #2}] &, {newposs,
olddigits}]]
q = {}; map = {};
inicial = {{1, 6, 2}, {0, 4, 3}, {7, 5, 8}};
final = {{1, 2, 3}, {4, 5, 6}, {7, 8, 0}};
AppendTo[q, {inicial, 0}]
AppendTo[map, {inicial, 0}]
While[q != {}, prim = First@MinimalBy[q, Last];
hijos = Flatten[Most[MapAt[mutacion, prim, 1]], 1];
If[Not@MemberQ[map, #, Infinity],
AppendTo[q, {#, Last[prim] + 1}]] & /@ hijos;
If[Not@MemberQ[map, #, Infinity],
AppendTo[map, {#, Last[prim] + 1}]] & /@ hijos;
q = DeleteCases[q, prim, Infinity];
If[MemberQ[hijos, final],
Print["Found at the level : ", Last[prim] + 1]; Break[]]]
but when inicial = {{2, 1, 5}, {6, 3, 4}, {8, 0, 7}};I have waited for more than 15 minutes without getting any response, maybe the problem is with the command MemberQ, since that command must make many comparisons in increasingly larger lists. I want to ask you please can you help me to correct my mistakes and thus be able to improve my code to obtain the solutions. Thanks in advance, your help is very necessary and important.