Details for 178_Sudoku3-20-03-08.mw
Download file: 178_Sudoku3-20-03-08.mw (View Live Worksheet on MapleNet)Uploaded by Doug Meade(
610) (View other files uploaded by Doug Meade) The HTML version of this file is shown below. To use the contents of this file in a posting, click here to get the source code
Sudoku Manipulations - Plot-Based
>
Instructions
When the worksheet loads, agree to the the "Autoexecute" regions to be executed.
Scroll down until you can see the Sudoku grid and the table of Puzzle Transformations. Be sure you select the source and target grids for each operation you perform; grids can be overwritten.
Use the Work Area to try to solve a puzzle. Import one of the four grids, or enter a new puzzle. The Check and Fill-In buttons will alert you if there is an error in your puzzle and will show all possible values that can be filled in each cell. Use the Export button to move a grid back to one of the four grids with a plot for visualizing.
>
Auto-Execute Block
> restart;
> #printf("Begining initialization ...");
> #with( DocumentTools );
Manipulating Embedded Elements
> GetPuzzle := proc( base::nonnegint:=0)
> local i, j, n, P;
> uses DocumentTools;
> P := Matrix(9,9, (i,j)->parse(GetProperty( `TextArea`||(9*(i-1)+(j-1)+base), 'value' )) );
> return eval(P,NULL=0);
> end proc:
> SetPuzzle := proc( P::Matrix, base::nonnegint:=0 )
> local i, j, n, P2;
> uses DocumentTools;
> P2 := eval( P, 0=NULL );
> for i from 1 to 9 do
> for j from 1 to 9 do
n := 9*(i-1)+(j-1) + base;
# if P[i,j]=0 then P[i,j]:=NULL end if;
> SetProperty( `TextArea`||n, 'value', P[i,j] );
> end do
> end do;
> if base<>324 then
> SetProperty( `Plot`||(base/81), 'value', PlotPuzzle( P ) );
> end if;
> end proc:
> ClearPuzzle := proc( base::nonnegint:=0 )
> local P;
> P := Matrix(1..9,1..9, NULL );
> SetPuzzle( P, base );
> end proc:
>
> PlotPuzzle := proc( P::Matrix )
> local i, j, Color, P2;
> uses DocumentTools, plots, plottools;
> Color := ["White","Red","Blue","Green","Magenta","Sienna","Cyan","Purple","Gold","Pink"];
> P2 := LinearAlgebra:-Map( x -> `if`(x::posint and x>=1 and x<=9, x, 0 ), eval(P,NULL=0) );
> display( [
> seq( seq( rectangle([j-1,i-1],[j,i],color=Color[P2[10-i,j]+1]), j=1..9 ), i=1..9 ),
> seq( plot( 3*i, x=0..9, thickness=3, color=black ), i=0..3 ),
> seq( plot( [[3*i,0],[3*i,9]], thickness=3, color=black ), i=0..3 )
> ], view=[0..9,0..9], scaling=constrained, axes=NONE );
> end proc:
> Do_It := proc( oper::string )
> local a1, a2, base_source, base_target, Pin, Pout;
> uses DocumentTools;
> base_source := parse(GetProperty( ComboBox0, value ));
> base_target := parse(GetProperty( ComboBox1, value ));
> Pin := GetPuzzle( base_source );
> if oper="SwapRows" then
> a1 := parse(GetProperty( ComboBox2, value ));
> a2 := parse(GetProperty( ComboBox3, value ));
> Pout := SwapRow( Pin, a1, a2 );
> elif oper="SwapColumns" then
> a1 := parse(GetProperty( ComboBox4, value ));
> a2 := parse(GetProperty( ComboBox5, value ));
> Pout := SwapColumn( Pin, a1, a2 );
> elif oper="SwapBands" then
> a1 := parse(GetProperty( ComboBox6, value ));
> a2 := parse(GetProperty( ComboBox7, value ));
> Pout := SwapBand( Pin, a1, a2 );
> elif oper="SwapStacks" then
> a1 := parse(GetProperty( ComboBox8, value ));
> a2 := parse(GetProperty( ComboBox9, value ));
> Pout := SwapStack( Pin, a1, a2 );
> elif oper="Transpose" then
> Pout := Transpose( Pin );
> elif oper="Replace" then
> a1 := [ seq( i=parse(GetProperty( `ComboBox`||(i+9), value )), i=1..9 ) ];
> Pout := Replace( Pin, a1 );
> elif oper="Rotate" then
> a1 := parse(GetProperty( ComboBox19, value ));
> Pout := Rotate( Pin, a1 );
> elif oper="ToStandard" then
> Pout := ToStandardForm( Pin );
> elif oper="Copy" then
> Pout := Pin; print( Pin, Pout, base_source, base_target );
> elif oper="Clear" then
> ClearPuzzle( base_target );
> return;
> elif oper="ClearAll" then
> map( ClearPuzzle, [0,81,162,243] );
> return;
> # elif oper="ValidPuzzle" then
> # a1 := parse(GetProperty( ComboBox15, value ));
> # Pout := ValidPuzzle( a1 );
> # elif oper="SolvePuzzle" then
> # Pout := SolvePuzzle( Pin );
> else
> error "invalid argument, received: %1", oper;
> end if;
> SetPuzzle( Pout, base_target );
> end proc:
>
>
Transformations that can be applied to an order-3 Sudoku puzzle
> SwapColumn := proc( Pin::Matrix, c1::posint, c2::posint )
> local i, Pout;
> if c1>9 or c2>9 then
> error "there are only 9 columns";
> end if;
> # if iquo(c1-1,3)<>iquo(c2-1,3) then
> # error "cannot interchanges columns %1 and %2, columns must be within the same stack", c1, c2;
> # end if;
> Pout := Matrix(1..9,1..9,Pin);
> Pout[1..9,c1]:=Pin[1..9,c2];
> Pout[1..9,c2]:=Pin[1..9,c1];
> return Pout;
> end proc:
> SwapRow := proc( Pin::Matrix, r1::posint, r2::posint )
> local Pout;
> if r1>9 or r2>9 then
> error "there are only 9 rows";
> end if;
> # if iquo(r1-1,3)<>iquo(r2-1,3) then
> # error "cannot interchanges rows %1 and %2, rows must be within the same band", r1, r2;
> # end if;
> Pout := Matrix(1..9,1..9,Pin);
> Pout[r1,1..9]:=Pin[r2,1..9];
> Pout[r2,1..9]:=Pin[r1,1..9];
> return Pout;
> end proc:
> Transpose := proc( Pin::Matrix )
> local i, Pout;
> Pout := LinearAlgebra:-Transpose( Pin );
> return Pout;
> end proc:
> SwapStack := proc( Pin::Matrix, s1::posint, s2::posint )
> local i, Pout;
> if s1>3 or s2>3 then
> error "there are only 3 stacks";
> end if;
> Pout := Matrix(1..9,1..9, Pin );
> for i from 1 to 3 do
> Pout[1..9,i+3*(s1-1)] := Pin[1..9,i+3*(s2-1)];
> Pout[1..9,i+3*(s2-1)] := Pin[1..9,i+3*(s1-1)];
> end do;
> return Pout;
> end proc:
> SwapBand := proc( Pin::Matrix, b1::posint, b2::posint )
> local i, Pout;
> if b1>3 or b2>3 then
> error "there are only 3 bands";
> end if;
> Pout := Matrix(1..9,1..9, Pin );
> for i from 1 to 3 do
> Pout[i+3*(b1-1),1..9] := Pin[i+3*(b2-1),1..9];
> Pout[i+3*(b2-1),1..9] := Pin[i+3*(b1-1),1..9];
> end do;
> return Pout;
> end proc:
> Rotate := proc( Pin::Matrix, angle::posint )
> local i, Pout;
> if angle mod 90 <> 0 then
> error "invalid angle, first argument must be a multiple of 90 degrees, received %1", angle
> end if;
> Pout := Matrix(1..9,1..9);
> for i from 1 to 9 do
> Pout[1..9,i] := Pin[10-i,1..9];
> end do;
> if angle>90 then
> Pout := Rotate( Pout, angle-90 );
> end if;
> return Pout;
> end proc:
> Replace := proc( Pin::Matrix )
> local eq, i, j, Pout, trans;
> if _npassed<2 then
> error "at least two arguments are required";
> end if;
> trans := [ $1..9 ];
> if type(_passed[2],list) then
> if map(lhs,_passed[2])[] <> map(rhs,_passed[2])[] then
> error sprintf("replacement list does not create an equivalent puzzle, received %a", _passed[2])
> end if;
> for eq in _passed[2] do
> trans[lhs(eq)] := rhs(eq);
> end do;
> elif type(_passed[2],`=`) then
> eq := _passed[2];
> trans[lhs(eq)] := rhs(eq);
> trans[rhs(eq)] := lhs(eq);
> else
> error "cannot interpret second argument as valid replacements";
> end if;
> Pout := Matrix( 9,9, (i,j)->`if`(Pin[i,j]>0,trans[Pin[i,j]],0) );
> return Pout;
> end proc:
> ToStandardForm := proc( P::Matrix )
> local base, i, j, Pout, n, trans;
> trans := [seq( seq( P[i,j] = 3*(i-1)+j, j=1..3 ), i=1..3 )];
> Pout := Replace( P, trans );
> return Pout;
> end proc:
>
Puzzle Solver (incomplete)
> CheckPuzzle := proc( Pin::Matrix )
> local badB, badC, badR, good, i, j, msg, r, c, rr, cc, R, C, B;
> userinfo( 3, sudoku, "initial puzzle matrix:", print( Pin ) );
> msg := "";
> for i from 1 to 9 do
> for j from 1 to 9 do
> if Pin[i,j]=NULL or not member( Pin[i,j], [$1..9] ) then
> msg := "found at least one cell that is either empty or a set";
> return false, msg;
> end if;
> end do;
> end do;
>
> badR := NULL;
> badC := NULL;
> badB := NULL;
> for i from 1 to 9 do
> R := Pin[i,1..9];
> if nops(convert(R,set))<>nops(convert(R,list)) then
> # error "Oops! Something is wrong. There is a duplicate value in row %1.", i;
> userinfo( 3, sudoku, "Oops! Something is wrong. There is a duplicate value in row ", i );
> badR := badR, i;
> end if;
> C := Pin[1..9,i];
> if nops(convert(C,set))<>nops(convert(C,list)) then
> # error "Oops! Something is wrong. There is a duplicate value in column %1.", i ;
> userinfo( 3, sudoku, "Oops! Something is wrong. There is a duplicate value in column ", i );
> badC := badC, i;
> end if
> end do;
>
> for r from 1 to 3 do
> for c from 1 to 3 do
> rr := [[1,2,3],[4,5,6],[7,8,9]][r];
> cc := [[1,2,3],[4,5,6],[7,8,9]][c];
> B := [seq(seq( Pin[i,j], j=cc),i=rr)];
> if nops(convert(B,set))<>nops(B) then
> # error "Oops! Something is wrong. There is a duplicate value in the block with entry (%1,%2).", r,c ;
> userinfo( 3, sudoku, "Oops! Something is wrong. There is a duplicate value in a block", r,c );
> badB := badB, [r,c];
> end if;
> end do;
> end do;
> good := evalb( [badR,badC,badB]=[] );
> if good then
> msg := "Congratulations! This grid is correct.";
> else
> msg := "This grid has errors in";
> if badR<>NULL then
> msg := sprintf(" rows %a,", msg, [badR]);
> end if;
> if badC<>NULL then
> msg := sprintf(" columns %a,", msg, [badC]);
> end if;
> if badR<>NULL then
> msg := sprintf(" blocks %a", msg, [badR]);
> end if;
> end if;
> return good, msg;
> end proc:
> SolvePuzzle := proc( Pin::Matrix )
> local aa, bb, good, i, j, P2, Pout, R, C, B, unused, used;
> userinfo( 3, sudoku, "initial puzzle matrix:", print( Pin ) );
> P2 := Matrix( 9, 9, Pin );
> for i from 1 to 9 do
> for j from 1 to 9 do
> if type(Pin[i,j],set) or Pin[i,j]=0 then
P2[i,j]:=NULL;
> end if;
> end do;
> end do;
>
> Pout := Matrix( 9, 9, P2 );
> for i from 1 to 9 do
> for j from 1 to 9 do
> good := true;
> if P2[i,j]<>NULL then next end if;
> userinfo( 5, sudoku, "computing possible values for cell in position", (i,j) );
> R := P2[i,1..9];
> if nops(convert(R,set))<>nops(convert(R,list)) then
> # error "Oops! Something is wrong. There is a duplicate value in row %1.", i;
> userinfo( 3, sudoku, "Oops! Something is wrong. There is a duplicate value in row ", i );
> good := false;
> else
> R := convert(R,set);
> end if;
> C := P2[1..9,j];
> if nops(convert(C,set))<>nops(convert(C,list)) then
> # error "Oops! Something is wrong. There is a duplicate value in column %1.", j ;
> userinfo( 3, sudoku, "Oops! Something is wrong. There is a duplicate value in column ", j );
> good := false;
> else
> C := convert(C,set);
> end if;
> aa := select( has, [[1,2,3],[4,5,6],[7,8,9]], i )[];
> bb := select( has, [[1,2,3],[4,5,6],[7,8,9]], j )[];
> B := [seq(seq( P2[a,b], b=bb),a=aa)];
> if nops(convert(B,set))<>nops(B) then
> # error "Oops! Something is wrong. There is a duplicate value in the block with entry (%1,%2).", i,j ;
> userinfo( 3, sudoku, "Oops! Something is wrong. There is a duplicate value in the block with entry ", i,j );
> good := false;
> else
> B := convert(B,set);
> end if;
> if not good then
> Pout[i,j] := -1;
> next;
> end if;
> used := R union C union B;
> unused := 1,2,3,4,5,6,7,8,9 minus used;
> userinfo( 5, sudoku, "possible values for cell", (i,j), "are", unused );
> # good := true;
> if nops(unused)=0 then
> # error "OOPS! Something is wrong. There are no possible values that can go in location (%1,%2).", i, j ;
> userinfo( 3, sudoku, "Oops! Something is wrong. There are no possible values that can go in location ", i,j );
> good := false;
> next
> elif nops(unused)=1 then
> Pout[i,j] := unused[];
> else
> Pout[i,j] := unused
> end if;
> end do;
> end do;
> userinfo( 3, sudoku, "final puzzle matrix:", print(Pout) );
> if LinearAlgebra:-Equal( Pin, Pout ) then
> return Pout;
> else
> Pout := SolvePuzzle( Pout );
> end if;
> end proc:
>
>
>
>