\ Article: 112901 of comp.lang.forth \ Path: [...] \ From: "Robert Spykerman" \ Newsgroups: comp.lang.forth \ Subject: Re: Sudoku puzzle solver \ Date: 30 Aug 2005 00:31:56 -0700 \ Organization: http://groups.google.com \ Lines: 322 \ Message-ID: <1125387116.262637.309260@g44g2000cwa.googlegroups.com> \ References: <18311112153562@frunobulax.edu> \ NNTP-Posting-Host: 203.212.132.100 \ Mime-Version: 1.0 \ Content-Type: text/plain; charset="iso-8859-1" \ X-Trace: posting.google.com 1125387121 31045 127.0.0.1 (30 Aug 2005 07:32:01 GMT) \ X-Complaints-To: groups-abuse@google.com \ NNTP-Posting-Date: Tue, 30 Aug 2005 07:32:01 +0000 (UTC) \ User-Agent: G2/0.2 \ X-HTTP-UserAgent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.6) Gecko/20050223 Firefox/1.0.1,gzip(gfe),gzip(gfe) \ Complaints-To: groups-abuse@google.com \ Injection-Info: g44g2000cwa.googlegroups.com; posting-host=203.212.132.100; \ posting-account=l83dpA0AAAC07xo3UmTdltRwaFFYtT_E \ Xref: tunews.univie.ac.at comp.lang.forth:112901 \ Marcel Hendrix wrote: \ > A simple game. \ ... snip... \ Did this (below) trying to learn forth. Now I can look at your source \ code and study it, Marcel! \ Anyway, I would like to trouble the lot of you to see if you can \ improve in anywhich way on what I have done. \ Any other algorithms, I'm interested too. \ Thanks all of ye, \ Robert \ And, if I am obviously doing something REALLY unforthlike or wrong, \ please point this out too. \ 'Brute Force' Sudoku Solver in Forth. \ No special extensions were used. \ Tested on in win32forth, VFX and Swift (evaluation). \ No locals were harmed during this experiment ;) \ \ Version: 1300 30052005 - Robert Spykerman \ email: robspyke_nospam@iprimus_no_spam.com.au \ (delete the obvious) \ --------------------- \ Variables \ --------------------- \ Still haven't figured out FSL and the oodles of stuff \ in it so the following will have to do ;) create sudokugrid 0 C, 9 C, 0 C, 0 C, 0 C, 4 C, 0 C, 0 C, 7 C, 0 C, 0 C, 0 C, 0 C, 0 C, 7 C, 9 C, 0 C, 0 C, 8 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 4 C, 0 C, 5 C, 8 C, 0 C, 0 C, 0 C, 0 C, 0 C, 3 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 2 C, 0 C, 0 C, 0 C, 0 C, 0 C, 9 C, 7 C, 0 C, 6 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 4 C, 0 C, 0 C, 3 C, 5 C, 0 C, 0 C, 0 C, 0 C, 0 C, 2 C, 0 C, 0 C, 6 C, 0 C, 0 C, 0 C, 8 C, 0 C, create sudoku_row 9 cells allot create sudoku_col 9 cells allot create sudoku_box 9 cells allot \ --------------------- \ Logic \ --------------------- \ Basically : 1. Parses grid to see if current numbers on it valid \ 2. ... By putting them all in sets of numbers, row \ column, and box. \ 3. Then iterates thru' empty spaces. When hits one, \ tries a number not already conflicting with \ what's in the sets. \ 4. If try succeeds, puts said number into grid and \ updates the sets. Recurses. \ Tries to see if further numbers fit. \ End Condition : No spaces left \ 5. If nothing fits space, recursive word returns \ false... \ 6. Removes failed numbers from grid and sets, \ Tries again till end condition... \ Grid Related : xy 9 * + ; \ x y -- offset ; : getrow 9 / ; : getcol 9 mod ; : getbox dup getrow 3 / 3 * swap getcol 3 / + ; \ Puts and gets numbers from/to grid only : setnumber sudokugrid + c! ; \ n position -- : getnumber sudokugrid swap + c@ ; : cleargrid sudokugrid 81 0 do dup i + 0 swap c! loop drop ; \ -------------- \ Set related: sets are sudoku_row, sudoku_col, sudoku_box \ ie x y -- ; adds x into bitmap y : addbits_row 1 rot lshift swap cells sudoku_row + dup @ rot or swap ! ; : addbits_col 1 rot lshift swap cells sudoku_col + dup @ rot or swap ! ; : addbits_box 1 rot lshift swap cells sudoku_box + dup @ rot or swap ! ; \ ie x y -- ; remove number x from bitmap y : removebits_row 1 rot lshift swap cells sudoku_row + dup @ rot invert and swap ! ; : removebits_col 1 rot lshift swap cells sudoku_col + dup @ rot invert and swap ! ; : removebits_box 1 rot lshift swap cells sudoku_box + dup @ rot invert and swap ! ; \ clears all bitsmaps to 0 : clearbitmaps 9 0 do i cells 0 over sudoku_row + ! 0 over sudoku_col + ! 0 swap sudoku_box + ! loop ; \ Adds number to grid and sets : addnumber \ number position -- 2dup setnumber 2dup getrow addbits_row 2dup getcol addbits_col getbox addbits_box ; \ Remove number from grid, and sets : removenumber \ position -- dup getnumber swap 2dup getrow removebits_row 2dup getcol removebits_col 2dup getbox removebits_box nip 0 swap setnumber ; \ gets bitmap at position, ie \ position -- bitmap : getrow_bits getrow cells sudoku_row + @ ; : getcol_bits getcol cells sudoku_col + @ ; : getbox_bits getbox cells sudoku_box + @ ; \ position -- composite bitmap (or'ed) : getbits dup getrow_bits over getcol_bits rot getbox_bits or or ; \ Try tests a number in a said position of grid \ Returns true if it's possible, else false. : try \ number position -- true/false over 1 swap lshift over getbits and 0= rot rot 2drop ; \ -------------- : parsegrid \ Parses Grid to fill sets.. Run before solver. sudokugrid 81 0 do dup i + c@ dup if dup i try if i addnumber else unloop drop drop FALSE exit then else drop then loop drop TRUE ; \ MAIN SOLVER \ Recursively called. Will unwind when end condition \ reached i.e. when NO MORE SPACES in the grid \ Returns t/f depending if current 'fork' successful. \ Iterates thru' grid. \ If position is occupied, continues to next. \ If not occupied, try and recurse \ Morespaces manually checks for spaces ... \ Obviously this can be optimised to a count, \ Will be faster that way.... : morespaces? 0 81 0 do sudokugrid i + c@ 0= if 1+ then loop ; : solver morespaces? IF \ main exit condition 81 0 do \ Let's find some empty spaces sudokugrid i + c@ IF ELSE \ empty space found ! 10 1 do i j try \ try fitting numbers in... if i j addnumber recurse if unloop unloop TRUE exit else j removenumber then then loop FALSE leave \ none of 1-9 fit, bugger... \ false trail.... THEN loop ELSE TRUE \ NO More spaces, we're thru! THEN ; \ main entry to solver routine : startsolving clearbitmaps \ reparse bitmaps and reparse grid parsegrid \ just in case.. solver AND ; \ --------------------- \ Display Grid \ --------------------- \ \ Prints grid nicely, takes address of grid as argument \ : .sudokugrid CR CR sudokugrid 81 0 do dup i + c@ . ." " i 1+ dup 3 mod 0= if dup 9 mod 0= if CR dup 27 mod 0= if dup 81 < if ." ------+-------+------" CR then then else ." ! " then then drop loop drop CR ; \ --------------------- \ Higher Level Words \ --------------------- : add \ n x y -- xy 2dup try if addnumber .sudokugrid else CR ." Not a valid move. " CR 2drop then ; : rm xy removenumber .sudokugrid ; : clearit cleargrid clearbitmaps .sudokugrid ; : solveit CR CR startsolving if ." Solution Found " CR .sudokugrid else ." No Solution Found " CR CR then ; : showit .sudokugrid ; \ Print help menu : help CR ." Type clearit ; to clear grid " CR ." 1-9 x y add ; to add 1-9 to grid at x y (0 based) " CR ." x y rm ; to remove number at x y " CR ." showit ; redisplay grid " CR ." solveit ; to solve " CR ." help : for help " CR CR ; \ --------------------- \ Execution starts here \ --------------------- : godoit CR clearbitmaps parsegrid if CR ." Grid in source valid. " else CR ." Warning: Grid in source invalid. " then .sudokugrid help ; godoit \ Possible optimisations I see : \ 1. morespaces? end-condtion checking - use a counter. \ 2. Avoid recursion altogether? I can't picture this, \ but I know someone's done it. I think Paul Hsieh has... \ (www.azillionmonkeys.com) \ 3. optimise 3/ and like as discussed already... \ 4. Better idioms and factoring (that's where you come in! ;)