' compact sudoku solving code

'

' sudoku is quite popular these days.

'http://en.wikipedia.org/wiki/sudoku

'

' i am mainly interested in the programming aspect.

'

' recently i came across this very compact and highly interesting code in perl

' for solving sudoku puzzles.

'

' [quote]

'perl sudoku solver in three lines:

'http://www.ecclestoad.co.uk/blog/200...explained.html

'
'

' i was quite intrigued by this simple code made by using this

' high level programming language.

'

' just for fun i produced the following code in powerbasic based on

' the perl code above.

'

' the display can be improved. this i will leave to you.

' i just wanted to demonstrate how any solvable sudoku puzzle can be solved

' using this simple brute force backtracking recursive code. although the code

' is quite fast, there may still be room for improvement.

' thanks to edmund von der burg for his perl code (see link above).

'

' april 10, 2006

'

' best regards

'

' erik

'

' p.s. previous discussion leading to this code can be seen here:

' http://www.powerbasic.com/support/pb...ad.php?t=21942

[this message has been edited by erik christensen (edited april 12, 2006).]

'

' sudoku is quite popular these days.

'http://en.wikipedia.org/wiki/sudoku

'

' i am mainly interested in the programming aspect.

'

' recently i came across this very compact and highly interesting code in perl

' for solving sudoku puzzles.

'

' [quote]

'perl sudoku solver in three lines:

'http://www.ecclestoad.co.uk/blog/200...explained.html

'

Code:

' use integer;@a=split//,<>;sub r{for$i(0..80){next if$a[$i];my%t=map{$_/9 ' ==$i/9| |$_%9==$i%9| |$_/27==$i/27&&$_%9/3==$i%9/3?$a[$_]:0=>1}0..80;r($a[ ' $i]=$_)for grep{!$t{$_}}1..9;return$a[$i]=0}die@a}r '</font>

' i was quite intrigued by this simple code made by using this

' high level programming language.

'

' just for fun i produced the following code in powerbasic based on

' the perl code above.

'

' the display can be improved. this i will leave to you.

' i just wanted to demonstrate how any solvable sudoku puzzle can be solved

' using this simple brute force backtracking recursive code. although the code

' is quite fast, there may still be room for improvement.

' thanks to edmund von der burg for his perl code (see link above).

'

' april 10, 2006

'

' best regards

'

' erik

'

' p.s. previous discussion leading to this code can be seen here:

' http://www.powerbasic.com/support/pb...ad.php?t=21942

Code:

#compile exe #dim all ' #include "win32api.inc" ' %idd_dialog1 = 101 %idc_textbox1 = 1001 %idc_button1 = 1002 %idc_button2 = 1003 ' ' this is the compact perl sudoku solving code by edmund von der burg ' translated to pb with some additions function r(byref a() as long) as long local i as long, j as long, k as long, s as long dim t(1 to 9) as long for i = 0 to 80 if isfalse a(i) then ' cell i is empty reset t() for s = 0 to 80 if istrue a(s) then ' number present in cell s (this if statement was added april 12) if istrue (s\9 = i\9) _ ' s in same row as i ? or _ ' or (s mod 9 = i mod 9) _ ' s in same column as i ? or _ ' or ((s\27 = i\27) and ((s mod 9)\3 = (i mod 9)\3)) _ ' s in same block as i ? then t(a(s)) = a(s) ' if yes, then record this used number end if next for k = 1 to 9 ' test unused numbers if isfalse t(k) then a(i)=k : if istrue r(a()) then goto nex ' this number was useful and was set in this cell end if next a(i)= 0 : function = 0 : exit function ' could not set a number here - then exit this recursion end if nex: next function = 1 end function ' function showdialog1(byval hparent as dword) as long local lrslt as long, hdlg as long dialog new hparent, "sudoku - compact code solver", 70, 70, 292, 248, %ws_overlapped or _ %ws_border or %ws_dlgframe or %ws_sysmenu or %ws_clipsiblings or _ %ws_visible or %ds_modalframe or %ds_3dlook or %ds_nofailcreate or _ %ds_setfont, %ws_ex_controlparent or %ws_ex_left or _ %ws_ex_ltrreading or %ws_ex_rightscrollbar, to hdlg control add button, hdlg, %idc_button1, "&start solving", 8, 230, 64, 14 control add button, hdlg, %idc_button2, "e&xit", 220, 230, 64, 14 control add textbox, hdlg, %idc_textbox1, "textbox1", 8, 10, 274, 214, _ %ws_child or %ws_visible or %ws_tabstop or %ws_vscroll or %es_left _ or %es_multiline, %ws_ex_clientedge or _ %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar control send hdlg, %idc_textbox1, %wm_setfont, getstockobject(%ansi_fixed_font), %true dialog show modal hdlg, call showdialog1proc to lrslt function = lrslt end function ' callback function showdialog1proc() static s as string, i as long static tx as string dim a(0 to 80) as static long select case as long cbmsg case %wm_initdialog ' s="000000060007300900008900000071000000000000008800050604010200090200004000069000070" ' very difficult puzzle - takes some minutes to solve. be patient! ' s="090700860031005020806000000007050006000307000500010700000000109020600350054008070" ' difficult ' s="019300000000094205030200009090000601040050090806000070600009010504830000000007420" ' s="050030006080600047600085000000500038005000100790008000000320004420006080500070010" ' s="000047500024609783000000064060090007940703016100080050450000000671204390008370000" s="000100090900004010000039407403000120000050000026000308605470000080300006040005000" ' s="000000000000000000000000000000000000000000000000000000000000000000000000000000000" ' can fill a blank board. this can potentially - with some random function built-in - be used to construct sudokus. tx = " sudoku puzzle:" + $crlf+" " for i = 0 to 80 a(i)=val(mid$(s, i+1, 1)) if (i+1) mod 3 = 0 and (i+1) mod 9 <> 0 then tx=tx+ mid$(s, i+1, 1)+" | " else tx=tx+ mid$(s, i+1, 1)+" " if (i+1) mod 9 = 0 then tx=tx+$crlf+" " if i = 26 or i = 53 then tx=tx+string$(33,"-")+$crlf+" " next tx = tx +$crlf replace "0" with "-" in tx control set text cbhndl, %idc_textbox1, tx case %wm_command select case as long cbctl case %idc_textbox1 case %idc_button1 ' start if cbctlmsg = %bn_clicked or cbctlmsg = 1 then mouseptr 11 r(a()) mouseptr 1 tx=tx+" solution:"+$crlf+" " for i = 0 to 80 if (i+1) mod 3 = 0 and (i+1) mod 9 <> 0 then tx=tx+ltrim$(str$(a(i)))+" | " else tx=tx+ltrim$(str$(a(i)))+" " if (i+1) mod 9 = 0 then tx=tx+$crlf+" " if i = 26 or i = 53 then tx=tx+string$(33,"-")+$crlf+" " next control set text cbhndl, %idc_textbox1, tx end if case %idc_button2 ' exit if cbctlmsg = %bn_clicked or cbctlmsg = 1 then dialog end cbhndl end select end select end function ' function pbmain() showdialog1 %hwnd_desktop end function

[this message has been edited by erik christensen (edited april 12, 2006).]

## Comment