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>