Re: A Su Doku solver

• To: mathgroup at smc.vnet.net
• Subject: [mg60614] Re: A Su Doku solver
• From: "Valeri Astanoff" <astanoff at yahoo.fr>
• Date: Thu, 22 Sep 2005 02:08:09 -0400 (EDT)
• References: <200509191007.GAA25694@smc.vnet.net><dgol73\$hoa\$1@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```Dear Mr. Zhe Hu,

With a couple of modifications, my onepager can now solve your grid :

doku[tab_List /; Length[tab] == 9]:=
Module[{}, loctab = tab;
toDrop[n_,i_,j_]:=
MemberQ[loctab[[i]]     // Select[#,Length[#] == 1&]&,{n}]||
MemberQ[loctab[[All,j]] // Select[#,Length[#] == 1&]&,{n}]||
MemberQ[sq[loctab,i,j]  // Flatten[#,1]&//
Select[#,Length[#] == 1&]&,{n}];
Do[If[Length[loctab[[i,j]]]>1,loctab[[i,j]]=
Select[loctab[[i,j]],Not[toDrop[#,i,j]]&]],{i,1,9},{j,1,9}];
loctab];

g1 = {1,2,3}; g2 = {4,5,6}; g3 = {7,8,9};
t1[i_]:=MemberQ[g1,i];
t2[i_]:=MemberQ[g2,i];
t3[i_]:=MemberQ[g3,i];

sq[tab_List /;Length[tab] == 9,i_Integer,j_Integer]:=Which[
t1[i] && t1[j], tab[[g1]] [[All,g1]],
t1[i] && t2[j], tab[[g1]] [[All,g2]],
t1[i] && t3[j], tab[[g1]] [[All,g3]],
t2[i] && t1[j], tab[[g2]] [[All,g1]],
t2[i] && t2[j], tab[[g2]] [[All,g2]],
t2[i] && t3[j], tab[[g2]] [[All,g3]],
t3[i] && t1[j], tab[[g3]] [[All,g1]],
t3[i] && t2[j], tab[[g3]] [[All,g2]],
t3[i] && t3[j], tab[[g3]] [[All,g3]],
True,Print["err i=",i," j=",j]  ];

sudoku[gri_List?MatrixQ /; Length[gri] == 9 ]:=
Module[{}, tab = gri/.{0 -> Range[9],n_Integer/;n>0 -> {n}};
fp = FixedPoint[doku, tab] ;
sel[row_List]:=(ou = Outer[List, Sequence@@(li = row)] //
Flatten[#,Length[li]-1]&;

Union /@ (Select[ou, Total[#] == 45 && #.# == 285&] //
Transpose));
selrow = sel /@ fp;
selcol = Transpose[sel /@ Transpose[selrow]];
fp2 = FixedPoint[doku, selcol] ;
fp2 /. {n_Integer} -> n ];

A run with your test grid :
mygrid = {
{0,6,0,1,0,4,0,5,0},
{0,0,8,3,0,5,6,0,0},
{2,0,0,0,0,0,0,0,1},
{8,0,0,4,0,7,0,0,6},
{0,0,6,0,0,0,3,0,0},
{7,0,0,9,0,1,0,0,4},
{5,0,0,0,0,0,0,0,2},
{0,0,7,2,0,6,9,0,0},
{0,4,0,5,0,8,0,7,0}};
s = sudoku[mygrid] // Timing

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

Thanks again for the challenge.

Valeri Astanoff

```

• Prev by Date: Re: More strange behavior by ComplexExpand
• Next by Date: Re: More strange behavior by ComplexExpand
• Previous by thread: Re: A Su Doku solver
• Next by thread: Re: A Su Doku solver