Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2005

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

Search the Archive

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