Message Boards Message Boards

1
|
14392 Views
|
7 Replies
|
1 Total Likes
View groups...
Share
Share this post:

puzzle solver, intermediate steps not showing

Posted 11 years ago
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 /@ %
POSTED BY: Luis Ledesma
7 Replies
@Luis It certainly is possible to solve using Mathematica. Though you have to come up with a good algorithm in order to solve it.
POSTED BY: Sander Huisman
Posted 11 years ago
Hi Vitaly, thanks for sharing the link of the puzzle, after seeing the program I realized that the author, makes random movements and so leaves the board, but does not have a button for the ppuzzle be resolved automatically.

Because what I need is to show the intermediate steps to get to the board based solution {{4,1,5}, 7,0,2}, {8,3,6}} or any other, as I discuss in Sander Huisman

Might I suggest someone check my project more in detail, and this case is that  can not do in mathematica?
POSTED BY: Luis Ledesma
By the way there is a great slide-puzzle at the Wolfram Demonstration project with free code:  Picture Puzzle

POSTED BY: Vitaliy Kaurov
Posted 11 years ago
Sander Huisman, first of all, thanks for the help, indeed it is the slide- puzzle,the function that you implemented surprised me with my puzzle function only get some intermediate steps slide-puzzle, as I show below

but what I need are all the intermediate steps that functions to find the solution,something like the following

I hope you continue to help me, because this is of great interest to me, my goal state is {{1,2,3}, {4,5,6}, {7,8,0}}, as shown in the last panel, why stop there, but I have not managed to that. in thissample, the start state  is {{4,1,5},{7,0,2},{8,3,6}}
POSTED BY: Luis Ledesma
Dear Luis, 

I'm not sure if you can evaluate this iteratively, because it can be very memory intensive:
If you start with some configuration a. You wil get 4 (or 3 or 2) new possible states, after that those also have 4 (or 3 or 2) possible states again, so you have 16, after that 64 after that 256. et cetera.. It will grow really fast. My idea would be to do it as follows:

start with a buffer of states and their origin:
buffer = {{{{1,2,3}, {4,5,6}, {7,8,0}},"start"}}
copy the buffer to second buffer.
Now iteratively (until we have the solution) we do:
 For each item in the second buffer we calculate the new states and their origin (the previous state) and add them to the second buffer. 
 delete all the states from the second buffer that are already present in the primary buffer.
 copy these states from the second buffer to the primary buffer.
 check if the primary buffer has the end state somewhere in it: escape the loop
loop

Now from the final solution you have to track back to the start.

This is a little bit more difficult than your original code, but I think you have to do it in such kind of way, if you want to use this approach. Implementing requires some tricks of course. Maybe I will try later, can't promise anything though.
POSTED BY: Sander Huisman
Hola Luis!

I looked at your mutacion function and I now understand what it does, but the way you do it is complicated and long code. Here is a simplified version that does the same:
mutacion2[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}]
]

I will look at the other part of the code some later time.
POSTED BY: Sander Huisman
Hola Luis!

Your code is quite complicated to understand, could you tell us what kind of output you are expecting? Are you trying to find all the possible arrangements of 9 digits in a 3x3 matrix? Or is this like a slide-puzzle? What are you trying to find? We need some more background information.
POSTED BY: Sander Huisman
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract