Hello, I write to ask for your help to solve the following problem as a board, give the intermediate steps to reach the solution state, which in my case is {{1,2,3}, {4,5,6}, {7,8,0}};
I implemented the following function that gives the possible permutations of a board,
mutacion[tablero_List] := Module[{posc, i, j, permu, tabli},
posc = Flatten[Position[tablero, 0]];
i = posc[[1]]; j = posc[[2]]; permu = {};
Which[
i == 1 && j == 1,
tabli = tablero; tabli[[i, j]] = tablero[[i, j + 1]];
tabli[[i, j + 1]] = 0; AppendTo[permu, tabli];(*derecha*)
tabli = tablero; tabli[[i, j]] = tablero[[i + 1, j]];
tabli[[i + 1, j]] = 0; AppendTo[permu, tabli];(*abajo*),
i == 2 && j == 1,
tabli = tablero; tabli[[i, j]] = tablero[[i - 1, j]];
tabli[[i - 1, j]] = 0; AppendTo[permu, tabli];(*arriba*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j + 1]];
tabli[[i, j + 1]] = 0; AppendTo[permu, tabli];(*derecha*)
tabli = tablero; tabli[[i, j]] = tablero[[i + 1, j]];
tabli[[i + 1, j]] = 0; AppendTo[permu, tabli];,(*abajo*)
i == 3 && j == 1, tabli = tablero;
tabli[[i, j]] = tablero[[i - 1, j]]; tabli[[i - 1, j]] = 0;
AppendTo[permu, tabli];(*arriba*)
tabli = tablero;
tabli[[i, j]] = tablero[[i, j + 1]]; tabli[[i, j + 1]] = 0;
AppendTo[permu, tabli];(*derecha*),
i == 1 && j == 2,
tabli = tablero; tabli[[i, j]] = tablero[[i, j + 1]];
tabli[[i, j + 1]] = 0; AppendTo[permu, tabli];(*derecha*)
tabli = tablero; tabli[[i, j]] = tablero[[i + 1, j]];
tabli[[i + 1, j]] = 0; AppendTo[permu, tabli];(*abajo*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j - 1]];
tabli[[i, j - 1]] = 0; AppendTo[permu, tabli];(*izquierda*),
i == 2 && j == 2,
tabli = tablero; tabli[[i, j]] = tablero[[i - 1, j]];
tabli[[i - 1, j]] = 0; AppendTo[permu, tabli];(*arriba*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j + 1]];
tabli[[i, j + 1]] = 0; AppendTo[permu, tabli];(*derecha*)
tabli = tablero; tabli[[i, j]] = tablero[[i + 1, j]];
tabli[[i + 1, j]] = 0; AppendTo[permu, tabli];(*abajo*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j - 1]];
tabli[[i, j - 1]] = 0; AppendTo[permu, tabli];(*izquierda*),
i == 3 && j == 2,
tabli = tablero; tabli[[i, j]] = tablero[[i - 1, j]];
tabli[[i - 1, j]] = 0; AppendTo[permu, tabli];(*arriba*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j + 1]];
tabli[[i, j + 1]] = 0; AppendTo[permu, tabli];(*derecha*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j - 1]];
tabli[[i, j - 1]] = 0; AppendTo[permu, tabli];(*izquierda*),
i == 1 && j == 3,
tabli = tablero; tabli[[i, j]] = tablero[[i + 1, j]];
tabli[[i + 1, j]] = 0; AppendTo[permu, tabli];(*abajo*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j - 1]];
tabli[[i, j - 1]] = 0; AppendTo[permu, tabli];(*izquierda*),
i == 2 && j == 3,
tabli = tablero; tabli[[i, j]] = tablero[[i - 1, j]];
tabli[[i - 1, j]] = 0; AppendTo[permu, tabli];(*arriba*)
tabli = tablero; tabli[[i, j]] = tablero[[i + 1, j]];
tabli[[i + 1, j]] = 0; AppendTo[permu, tabli];(*abajo*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j - 1]];
tabli[[i, j - 1]] = 0; AppendTo[permu, tabli];(*izquierda*),
i == 3 && j == 3,
tabli = tablero; tabli[[i, j]] = tablero[[i - 1, j]];
tabli[[i - 1, j]] = 0; AppendTo[permu, tabli];(*arriba*)
tabli = tablero; tabli[[i, j]] = tablero[[i, j - 1]];
tabli[[i, j - 1]] = 0; AppendTo[permu, tabli];(*izquierda*)
];
permu]
In the following function, I set to do in the event that the first permutation is given board state solution
puzzle[tablero_List] :=
Module[{per, k, exp = {}, fin, n, inter, prb, t, sig},
If[tablero == {{1, 2, 3}, {4, 5, 6}, {7, 8, 0}},
MatrixForm[tablero],
per = mutacion[tablero];
If[MemberQ[per, {{1, 2, 3}, {4, 5, 6}, {7, 8, 0}}, Infinity],
PrependTo[per, tablero];
per
,
fin = mutacion[tablero];
exp = Flatten[AppendTo[exp, fin], 1];
For[k = 1, k <= Length@fin, k++,
sig = mutacion [fin[[k]]];
For[t = 1, t <= Length@sig, t++,
If[FreeQ[exp, sig[[t]], Infinity],
AppendTo[exp, sig[[t]]];
exp
]
]
]
]
]
]
When you run it, do not get all the steps, this is where my problem arises,
I hope someone has some idea
puzzle[{{1, 3, 5}, {7, 0, 2}, {8, 4, 6}}]
MatrixForm /@ %
