A Su Doku solver
- To: mathgroup at smc.vnet.net
- Subject: [mg60534] A Su Doku solver
- From: "Valeri Astanoff" <astanoff at yahoo.fr>
- Date: Mon, 19 Sep 2005 06:07:07 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Dear group,
Here is my little Mathematica "Su Doku" solver :
In[1]:=sudoku[m_List?MatrixQ /;Length[m] == 9 ]:=
FixedPoint[doku,m];
doku[m_List?MatrixQ /; Length[m] == 9]:=
Module[{mi,r,sq,sel},
mi=MapIndexed[Prepend[#2,#1]&,m,{2}];
r={0,i_Integer,j_Integer} :>
{sq =(Which[
1 <= i <= 3 && 1 <= j <= 3, mi[[{1,2,3}]] [[All,{1,2,3}]],
1 <= i <= 3 && 4 <= j <= 6, mi[[{1,2,3}]] [[All,{4,5,6}]],
1 <= i <= 3 && 7 <= j <= 9, mi[[{1,2,3}]] [[All,{7,8,9}]],
4 <= i <= 6 && 1 <= j <= 3, mi[[{4,5,6}]] [[All,{1,2,3}]],
4 <= i <= 6 && 4 <= j <= 6, mi[[{4,5,6}]] [[All,{4,5,6}]],
4 <= i <= 6 && 7 <= j <= 9, mi[[{4,5,6}]] [[All,{7,8,9}]],
7 <= i <= 9 && 1 <= j <= 3, mi[[{7,8,9}]] [[All,{1,2,3}]],
7 <= i <= 9 && 4 <= j <= 6, mi[[{7,8,9}]] [[All,{4,5,6}]],
7 <= i <= 9 && 7 <= j <= 9, mi[[{7,8,9}]] [[All,{7,8,9}]],
True,Print["err"]] // Flatten[#,1]&)[[All,1]] // Union;
sel := Complement[Range[9], mi[[i,All,1]], mi[[All,j,1]],sq];
If[Length[sel] == 1, sel[[1]],0],i,j};
(mi//.r)[[All,All,1]]
];
A grid example :
In[3]:=
myGrid={{0,8,0,0,0,1,6,0,0},
{0,7,0,4,0,0,0,2,1},
{5,0,0,3,9,6,0,0,0},
{2,0,4,0,5,0,1,3,0},
{0,0,8,9,0,7,5,0,0},
{0,5,7,0,3,0,9,0,2},
{0,0,0,5,6,3,0,0,9},
{3,1,0,0,0,2,0,5,0},
{0,0,5,8,0,0,0,4,0}};
In[4]:=
sudoku[myGrid]//Timing
Out[4]=
{0.016 Second,
{{4,8,3,2,7,1,6,9,5},
{9,7,6,4,8,5,3,2,1},
{5,2,1,3,9,6,4,7,8},
{2,9,4,6,5,8,1,3,7},
{1,3,8,9,2,7,5,6,4},
{6,5,7,1,3,4,9,8,2},
{8,4,2,5,6,3,7,1,9},
{3,1,9,7,4,2,8,5,6},
{7,6,5,8,1,9,2,4,3}}}
It's more fun to compete : does any one have a shorter and/or faster
solution?
v.a.
- Follow-Ups:
- Re: A Su Doku solver
- From: Zhe Hu <iamhuzhe@gmail.com>
- Re: A Su Doku solver