########SuMaker############# #Author: Andrew Baxter (SudokuG.txt written by Bobby Griffin) #Version 2.1 #Date: May 12, 2006 #Purpose: Creates standard n by n Sudoku puzzles #Requirements: You need Bobby Griffin's Sudoku solver, downloadable from #http://www.math.rutgers.edu/~zeilberg/tokhniot/SuDokuGriffn #Notes: At the end of this file are two utility procedures that could be useful # outside the context of a Sudoku solver. ############################ with(combinat): read SuDokuGriffin: Help:=proc(): print(`'SuMaker'`): print(`Written by Andrew Baxter using code from Bobby Griffin`): print(`______________________`): print(`Use the command SuMaker(n,MaxTime) to generate an n by n Sudoku Puzzle (n a square)`): print(`MaxTime places a time limit (in seconds) on the amount of time taken`): print(`to generate the puzzle. To get as few clues as possible, use infinity`): print(`in place of a number.`): print(`SuMaker prints out the puzzle, but returns the solution as its value. Thus`): print(`you may hide the solution by using a colon instead of a semicolon`): print(`The solution is stored as the global variable solution, so you may check`): print(`your solution at a later date simply by calling 'solution;'`): print(`The conventions of the puzzle are that there must be a unique solution,`): print(`and that there must be half-turn symmetry in the clues given.`): print(`You must have the Sudoku program written by Bobby Griffin (elsewhere on`): print(`Dr Zeilberger's website). Place it with the path 'C:\\maple\\SudokuG.txt'`): print(`or change the path in the txt file.`): print(`Happy Solving!`): end: ### #SuMaker(n,MaxTime) gives an n by n puzzle as described in the Help procedure. # It is the only one a user needs to call. # The procedure first forms a fully-solved grid via the FullChart procedure, then # whittles away the clues given (replacing them with zeros) until one of two things occurs # 1. The removal of any more clues causes multiple solutions # 2. The procedure has run for longer than MaxTime seconds ### SuMaker:=proc(n,MaxTime) local P,P1,i,j,change,filledcells,cell,t0: global solution: t0:=time(): P:=FullChart(n): filledcells:={seq(seq([i,j],i=j..n),j=1..n)}: change:=true: while change=true and time()-t0MaxTime then print(`Time's up!`): fi: print(matrix(P)): print(`Number of clues:`,nops(filledcells)): print(`Total time`,time()-t0): solution:=matrix(op(Su(P))): end: ### #FullChart(n) returns a random n by n standard Sudoku puzzle. I am not certain if # the process followed here can give any possible Sudoku grid, but it certainly pulls # from a very large set of filled grids. ### FullChart:=proc(n) RandPerm(FillIn(n),rand(30..50)()): end: ### #FillIn(n) Gives a completed n by n standard Sudoku puzzle, which acts as a base # whose rows and columns RandPerm will act on. ### FillIn:=proc(n) local rootN,Basic,base1, i: rootN:=sqrt(n): if not evalb(rootN::integer) then error(`n must be a square`): fi: Basic:=[[0$n]$n]: base1:=randperm([$1..n]): for i from 1 to n do Basic[i]:=Wrap(ceil(i/rootN)-1 + rootN*modp(i-1,rootN),base1): od: Basic: end: ### #RandPerm(P,m) performs m permutations on the completed grid P. The # permutations used are permutations of rows and permutations of columns. # Permutations of blocks are not implemented. ### RandPerm:=proc(P,m) local k,n,i,j,pi,P1,P2: P1:=P: n:=nops(P): for k from 1 to m do pi:=randperm({$1..n}): P2:=PermRows(P1,pi): if ValidQ(P2) then P1:=P2: fi: pi:=randperm({$1..n}): P2:=PermCols(P1,pi): if ValidQ(P2) then P1:=P2: fi: od: P1: end: ### #PermRows(P,pi) applies permutation pi (on n elements) to the rows of grid P ### PermRows:=proc(P,pi) local P1,n,i: P1:=P: n:=nops(pi): for i from 2 to n do P1[pi[i]]:=P[pi[i-1]]: od: P1[pi[1]]:=P[pi[n]]: P1: end: ### #PermCols(P,pi) applies permutation pi (on n elements) to the columns of grid P ### PermCols:=proc(P,pi) Transpose(PermRows(Transpose(P),pi)): end: ### #ValidQ(P) Checks if the grid P is a valid solution to standard Sudoku. ### ValidQ:=proc(P) local n,i,j,B,y,z,rootN,wB: n:=nops(P): #Check Rows for i from 1 to n do if {op(P[i])}<>{$1..n} then RETURN(false): fi: od: #Check Columns for j from 1 to n do if {seq(P[i][j],i=1..n)}<>{$1..n} then RETURN(false): fi: od: #Check Blocks rootN:=sqrt(n): B:=[[]$n]: for i from 1 to n do for j from 1 to n do wB:=(ceil(i/rootN)-1)*rootN+ceil(j/rootN): B[wB]:= [op(B[wB]),[i,j]]: od: od: for i from 1 to n do if {seq(P[B[i][j][1]][B[i][j][2]],j=1..n)}<>{$1..n} then RETURN(false): fi: od: true: end: #------------- UTILITIES ----------------- #Here I've listed some useful procedures that are useful in contexts # outside of a Sudoku solver. ### #Wrap(i,list) cycles list i places to the right, wrapping the # (i.e. list[j]->list[j+i mod nops(list)]) ### Wrap:=proc(i,list) local n: n:=nops(list): [op(n-i+1..n,list),op(1..n-i,list)]: end: ### #Tranpose(M) gives the transpose of a matrix (list of lists) M. It is used here for PermCols. ### Transpose:=proc(M) local i,j,M1: M1:=[[0$nops(M)]$nops(M[1])]: for i from 1 to nops(M) do for j from 1 to nops(M[i]) do M1[j][i]:=M[i][j]: od: od: M1: end: