4
$\begingroup$

I have generated sudoku solver using a recursive scheme, however, i wish to find a more mathematica like solution to solving sudoku. I tried using FindInstance but to no use.

here is my attempt so far:

grid = {{9, 0, 0, 2, 3, 7, 6, 8, 0}, {0, 2, 0, 8, 4, 0, 0, 7, 3}, {8, 0, 7, 
1, 0, 5, 0, 2, 9}, {0, 0, 4, 5, 9, 8, 3, 0, 0}, {2, 0, 0, 0, 0, 1, 
0, 0, 6}, {5, 1, 0, 0, 0, 0, 0, 4, 7}, {4, 0, 1, 3, 0, 6, 2, 9, 
5}, {0, 5, 0, 9, 1, 0, 7, 3, 8}, {3, 0, 8, 0, 5, 0, 0, 0, 0}};

i deliberately replace 0's for symbols

symgrid = grid /. 0 :> Module[{x}, x]
(* {{9, x$8160, x$8161, 2, 3, 7, 6, 8, x$8162}, {x$8163, 2, x$8164, 8, 4,
   x$8165, x$8166, 7, 3}, {8, x$8167, 7, 1, x$8168, 5, x$8169, 2, 
  9}, {x$8170, x$8171, 4, 5, 9, 8, 3, x$8172, x$8173}, {2, x$8174, 
  x$8175, x$8176, x$8177, 1, x$8178, x$8179, 6}, {5, 1, x$8180, 
  x$8181, x$8182, x$8183, x$8184, 4, 7}, {4, x$8185, 1, 3, x$8186, 6, 
  2, 9, 5}, {x$8187, 5, x$8188, 9, 1, x$8189, 7, 3, 8}, {3, x$8190, 8,
   x$8191, 5, x$8192, x$8193, x$8194, x$8195}} *)

one can get symbols in the symgrid using:

symbols = Cases[symgrid, _Symbol, Infinity];

i placed four constraints on the system: the sum of all the rows and that of all the columns should be 45 i.e. 1+2+...+9 including the 3x3 submatrices that i generate using 'getSubMatrices` with the fourth constraint that the values for the symbols lie in the range 1-9.

Clear@getSubMatrices;
getSubMatrices[grid_, x_Symbol] := 
Block[{row, col, submatrix},
{row, col} = First@Position[grid, x];
submatrix = (Plus @@ # == 45) &@
Flatten[Which[row <= 3 && col <= 3, Take[grid, 3, 3],
  row <= 3 && col <= 6, Take[grid, 3, 4 ;; 6], 
  row <= 3 && col <= 9, Take[grid, 3, 7 ;; 9],
  row <= 6 && col <= 3, Take[grid, 4 ;; 6, 3], 
  row <= 6 && col <= 6, Take[grid, 4 ;; 6, 4 ;; 6], 
  row <= 6 && col <= 9, Take[grid, 4 ;; 6, 7 ;; 9],
  row <= 9 && col <= 3, Take[grid, 7 ;; 9, 3], 
  row <= 9 && col <= 6, Take[grid, 7 ;; 9, 4 ;; 6], 
  row <= 9 && col <= 9, Take[grid, 7 ;; 9, 7 ;; 9]]]
] 

I might be wrong here but i think the constraints should be enough to get the solution to Sudoku. However, using the formulation below I get duplicate values in the row:

FindInstance[
And @@ Join[Table[Plus @@ symgrid[[i]] == 45, {i, 9}], 
Table[Plus @@ symgrid[[All, i]] == 45, {i, 9}], 
DeleteDuplicates[getSubMatrices[symgrid, #] & /@ symbols], (1 <= # <= 9) & /@ 
symbols], symbols]

(* {{x$8160 -> 8, x$8161 -> 1, x$8162 -> 1, x$8163 -> 8, x$8164 -> 1, 
x$8165 -> 9, x$8166 -> 3, x$8167 -> 1, x$8168 -> 6, x$8169 -> 6, 
x$8170 -> 1, x$8171 -> 5, x$8172 -> 5, x$8173 -> 5, x$8174 -> 9, 
x$8175 -> 9, x$8176 -> 5, x$8177 -> 7, x$8178 -> 1, x$8179 -> 5, 
x$8180 -> 9, x$8181 -> 8, x$8182 -> 1, x$8183 -> 1, x$8184 -> 9, 
x$8185 -> 6, x$8186 -> 9, x$8187 -> 5, x$8188 -> 5, x$8189 -> 2, 
x$8190 -> 8, x$8191 -> 4, x$8192 -> 6, x$8193 -> 8, x$8194 -> 2, 
x$8195 -> 1}} *)

Can you kindly let me know how to use the FindInstance properly to get the right solution that i do get recursively (below):

enter image description here

$\endgroup$
1
$\begingroup$

I found that the system has the tendency to generate results provided that the system is not too undetermined.

for instance if we use the grid (same as above but with slightly fewer unknowns) and using additional constraint i.e. product of elements in rows and columns equals 9! :

grid = {{9, 0, 0, 2, 3, 7, 6, 8, 0}, {0, 2, 0, 8, 4, 0, 0, 7, 3}, {8, 
0, 7, 1, 0, 5, 0, 2, 9}, {0, 0, 4, 5, 9, 8, 3, 0, 0}, {2, 0, 0, 4,
 0, 1, 0, 0, 6}, {5, 1, 0, 0, 0, 3, 0, 4, 7}, {4, 0, 1, 3, 0, 6, 
2, 9, 5}, {0, 5, 0, 9, 1, 0, 7, 3, 8}, {3, 0, 8, 0, 5, 0, 1, 0, 
4}};

symgrid = grid /. 0 :> Unique@x;
symbols = Cases[symgrid, _Symbol, Infinity];

Clear@getSubMatrices;
getSubMatrices[grid_, x_Symbol] := Block[{row, col, submatrix},
{row, col} = First@Position[grid, x];
submatrix = (Plus @@ # == 45) &@
Flatten[Which[row <= 3 && col <= 3, Take[grid, 3, 3],
row <= 3 && col <= 6, Take[grid, 3, 4 ;; 6], 
row <= 3 && col <= 9, Take[grid, 3, 7 ;; 9],
row <= 6 && col <= 3, Take[grid, 4 ;; 6, 3], 
row <= 6 && col <= 6, Take[grid, 4 ;; 6, 4 ;; 6], 
row <= 6 && col <= 9, Take[grid, 4 ;; 6, 7 ;; 9],
row <= 9 && col <= 3, Take[grid, 7 ;; 9, 3], 
row <= 9 && col <= 6, Take[grid, 7 ;; 9, 4 ;; 6], 
row <= 9 && col <= 9, Take[grid, 7 ;; 9, 7 ;; 9]]]
] 


sol = FindInstance[
And @@ Join[Table[Plus @@ symgrid[[i]] == 45, {i, 9}], 
Table[Plus @@ symgrid[[All, i]] == 45, {i, 9}], 
Table[Times @@ symgrid[[i]] == 9!, {i, 9}], 
Table[Times @@ symgrid[[All, i]] == 9!, {i, 9}], 
DeleteDuplicates[getSubMatrices[symgrid, #] & /@ symbols]], 
symbols]

sympos = Flatten[Position[symgrid, #] & /@ symbols, 1];

symfilled = First[symgrid /. sol];

rule = Map[# ->Framed[Style[symfilled[[Sequence @@ #]], Bold], 
  RoundingRadius -> 50, Background -> LightGreen ] &, sympos];

ReplacePart[symgrid, Dispatch[rule]] // MatrixForm

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.