Services & ResourcesWolfram ForumsMathGroup Archive

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

FindInstance for sudoku

• To: mathgroup at smc.vnet.net
• Subject: [mg64808] FindInstance for sudoku
• From: Arturas Acus <acus at itpa.lt>
• Date: Sat, 4 Mar 2006 02:35:19 -0500 (EST)
• Sender: owner-wri-mathgroup at wolfram.com

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*) 


-- 
Arturas Acus <acus at itpa.lt>

• Follow-Ups:
  • Re: FindInstance for sudoku
    • From: Daniel Lichtblau <danl@wolfram.com>