       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)&,Flatten[sudokuGeneral]],{1}],
>         0]];
>
> noZerosCondition=(Times@@Flatten[sudokuGeneral]==Factorial^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=
> {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= {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