Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: FindInstance for sudoku

  • To: mathgroup at smc.vnet.net
  • Subject: [mg64847] Re: [mg64808] FindInstance for sudoku
  • From: Daniel Lichtblau <danl at wolfram.com>
  • Date: Sun, 5 Mar 2006 03:19:16 -0500 (EST)
  • References: <200603040735.CAA15772@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Arturas Acus wrote:
> Dear group,
> 
> Despite there was a number of solutions of sudoku puzzle presented on
> the list half a year ago, I decided to check if it can be handled in a
> pure algebraic way with current Mathematica solvers. (As far as I remember, all
> previously mentioned solutions was of different kind).
> 
> Unfortunatelly after playing a bit I was unable to find a satisfactory
> approach. I am still interesting weather combination of obvious
> algebraic conditions can yield any solution using current Mathematica solvers.
> 
> Below is some of my attempts:
> 
> 
> (* general definitions *)
> 
> sudokuForm[mat_]:=
>   DisplayForm[
>     GridBox[Map[GridBox,mat,{2}],GridFrame->True,RowLines->True,
>       ColumnLines->True]]
> sudokuQ[mat_]:=Dimensions[mat]==={3,3,3,3}
> 
> sudokuGeneral=Table[Table[elem[i,j][m,n],{m,3},{n,3}],{i,3},{j,3}]
> 
> sudokuForm[sudokuGeneral]
> 
> 
> (* obviuos conditions we can formulate sudoku puzzle in algebraic way *)
> (* first two indices (i-raw,j-column) enumerates big boxes; other (m,n)
> enumerates elements inside (i,j) box*)
> 
> plusBoxesConditions=
> Thread[Equal[Flatten[Table[Sum[elem[i,j][m,n],{n,3},{m,3}],{i,3},{j,3}]],
>         45]];
> 
> plusRawsConditions=
> Thread[Equal[Flatten[Table[Sum[elem[i,j][m,n],{j,3},{n,3}],{i,3},{m,3}]],
>         45]];
> 
> plusColumnsConditions=
> Thread[Equal[Flatten[Table[Sum[elem[i,j][m,n],{i,3},{m,3}],{j,3},{n,3}]],
>         45]];
> 
> timesRawsConditions=
>     Thread[Equal[
> Flatten[Table[Product[elem[i,j][m,n],{j,3},{n,3}],{i,3},{m,3}]],9!]];
> 
> timesColumnsConditions=
>     Thread[Equal[
> Flatten[Table[Product[elem[i,j][m,n],{i,3},{m,3}],{j,3},{n,3}]],9!]];
> 
> 
> integerConditions=
> Thread[Equal[Apply[Times,Map[(#-Range[9])&,Flatten[sudokuGeneral]],{1}],
>         0]];
> 
> noZerosCondition=(Times@@Flatten[sudokuGeneral]==Factorial[9]^9);
>  
> allSudokuConditions=
> Flatten[{plusRawsConditions,plusColumnsConditions,plusBoxesConditions,noZerosCondition}];
> 
> 
> (* sudoku sample: zeros are empty boxes *)
> 
> sudokuSample = 
> {{{{0, 0, 1}, {0, 7, 0}, {3, 0, 0}}, {{0, 0, 0}, {3, 1, 0}, {0,4, 5}},
>   {{8, 0, 0}, {0, 9, 0}, {0, 0, 7}}},
>  {{{0, 9, 0}, {0, 4, 2}, {0, 0, 3}}, {{7, 0, 0}, {0, 5, 0}, {0, 0, 9}}, 
>   {{5, 0, 0}, {1, 3, 0}, {0, 4, 0}}},
>  {{{2, 0, 0}, {0, 3, 0}, {0, 0, 4}}, {{5, 7, 0}, {0, 9, 1}, {0, 0, 0}}, 
>   {{0, 0, 4}, {0, 6, 0}, {3, 0, 0}}}};
> 
> sudokuForm[sudokuSample]
> 
> (* try to form simplest equation set: depends of what conditions to
> include*) 
> 
> allEq = DeleteCases[
>     allSudokuConditions /. 
>       Evaluate[DeleteCases[
>           Flatten[MapThread[Rule, {sudokuGeneral, sudokuSample}, 4]], 
>           Rule[_, 0]]], True]
> 
> vars = DeleteCases[
>     Flatten[sudokuGeneral] /. 
>       Evaluate[DeleteCases[
>           Flatten[MapThread[Rule, {sudokuGeneral, sudokuSample}, 4]], 
>           Rule[_, 0]]], _Integer]
> 
> 
> Length/@{allEq,vars}
> Out[46]=
> {28,50}
> 
> 
> sol = FindInstance[allEq, vars, Integers]
> 
> ?Modulus->10?
> (* FindInstance seems to be most promising. Rezult: exit after all 256
> Mb memory being exhausted*) 

Certainly sudoku can be cast as a FindInstance problem. That said, I 
cannot imagine it actually giving a result when the equations are by and 
large nonlinear or are heavily underdetetmined.

A good way to use FindInstance for sudoku is by formulating as a 
knapsack integer programming problem with variables taking on 0-1 
values. When I tried this with FindInstance last May some problems arose 
in that the underlying relaxed LP solver was too slow. The issue, 
roughly and as best I understand, is that we are using an exact simplex 
method that is not taking advantage of potential use of finite precision 
in intermediate steps. One can instead code a branch-and-bound and/or 
cutting plane approach to the knapsack solver, using explicit finite 
precision LP solver beneath the surface (and taking responsibility for 
precision issues).

If done with some reasonable preprocessing heuristics, 9x9 examples are 
solved quite fast, and in many cases (yours is one such) will not even 
reach the branch-and-bound or cutting plane loop. I recoded your input 
to be in row form as that seems to be vastly more common, not to mention 
unambiguous in terms of being independent of how you order the blocks. I 
use "sparseArray" as a dummy head that looks like SparseArray, and has a 
vaguely similar meaning, but is not in fact a Mathematica SparseArray 
data object.

sudokuSample = sparseArray[{
   {1,3}->1, {1,7}->8,
   {2,2}->7, {2,4}->3, {2,5}->1,
   {3,1}->3, {3,5}->4, {3,6}->5, {3,9}->7,
   {4,2}->9, {4,4}->7, {4,7}->5,
   {5,2}->4, {5,3}->2, {5,5}->5, {5,7}->1, {5,8}->3,
   {6,3}->3, {6,6}->9, {6,8}->4,
   {7,1}->2, {7,4}->5, {7,5}->7, {7,9}->4,
   {8,2}->3, {8,5}->9, {8,6}->1, {8,8}->6,
   {9,3}->4, {9,7}->3
   }]

Timing[res = sudoku[sudokuSample]]

Out[5]= {0.076004 Second, {0, {{4, 2, 1, 9, 6, 7, 8, 5, 3},
    {6, 7, 5, 3, 1, 8, 4, 9, 2}, {3, 8, 9, 2, 4, 5, 6, 1, 7},
    {1, 9, 8, 7, 3, 4, 5, 2, 6}, {7, 4, 2, 8, 5, 6, 1, 3, 9},
    {5, 6, 3, 1, 2, 9, 7, 4, 8}, {2, 1, 6, 5, 7, 3, 9, 8, 4},
    {8, 3, 7, 4, 9, 1, 2, 6, 5}, {9, 5, 4, 6, 8, 2, 3, 7, 1}}}}

At some point a couple of us are thinking we might write up the details, 
code and some related work for an article for The Mathematica Journal. I 
will say here that for larger examples it might not compete very well 
with the sudoku solver recently presented by Fred Simons in Mathematica 
in Education and Research. His was based on an explicit backtrack 
mechanism as opposed to equation solving. The 16x16 example he presented 
was managed in a few seconds. That can also be achieved with integer 
linear programming methods but they appear to require more 
sophistication (with cutting planes, I think) than I have at hand. The 
best I could do on the same example, without recourse to voodoo, was 
around a minute. (Linking to a dedicated ILP solver in the COIN-OR 
library brought this to a few seconds, which is how I know "good" ILP 
can do better than I can.)


Daniel Lichtblau
Wolfram Research







  • Prev by Date: Re: Possible Bug in ArcTan ?
  • Next by Date: Re: mathematica to word
  • Previous by thread: FindInstance for sudoku
  • Next by thread: MatrixForm to JPG