\ by Kresimir Kasal create sudoku ( enter sudoku here ) 2 c, 0 c, 0 c, 6 c, 7 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 6 c, 0 c, 0 c, 0 c, 2 c, 0 c, 1 c, 4 c, 0 c, 0 c, 0 c, 0 c, 0 c, 8 c, 0 c, 0 c, 5 c, 0 c, 0 c, 0 c, 0 c, 9 c, 3 c, 0 c, 0 c, 0 c, 3 c, 0 c, 0 c, 0 c, 0 c, 0 c, 5 c, 0 c, 0 c, 0 c, 2 c, 8 c, 0 c, 0 c, 0 c, 0 c, 7 c, 0 c, 0 c, 1 c, 0 c, 0 c, 0 c, 0 c, 0 c, 4 c, 7 c, 0 c, 8 c, 0 c, 0 c, 0 c, 6 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 5 c, 3 c, 0 c, 0 c, 8 c, : printLine ( addr -- ) 9 0 ?do dup i + c@ . loop CR drop ; : printSudoku ( -- ) CR 9 0 ?do sudoku 9 i * + printLine loop ; : singleRow ( addr num -- flag ) ( 0 = not valid, 1 = valid ) swap 9 0 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop 2drop 1 ; : singleCol ( addr num -- flag ) swap 9 0 ?do 2dup 9 i * + c@ = if 2drop 0 unloop exit else endif loop 2drop 1 ; : calcBox ( cell -- box ) 27 /mod 27 * swap 9 mod 3 / 3 * + ; : singleBox ( addr num -- flag ) swap 3 0 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop 12 9 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop 21 18 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop 2drop 1 ; : getFreeField ( -- pos ) 81 0 ?do sudoku i + c@ 0 = if i unloop exit else endif loop 81 ; : getColAddr ( cell -- addr ) 9 mod sudoku + ; : getRowAddr ( cell -- addr ) 9 / 9 * sudoku + ; : checkValidity ( cell num -- flag ) 2dup 2dup swap getColAddr swap singleCol 1 = if swap getRowAddr swap singleRow 1 = if swap calcBox sudoku + swap singleBox 1 = if 1 else 0 endif else 2drop 0 endif else 2drop 2drop 0 endif ; : solver ( -- ) recursive getFreeField dup 81 = if drop printSudoku exit else 10 1 ?do dup i checkValidity 1 = if dup sudoku + i swap c! solver dup sudoku + 0 swap c! endif loop endif drop ; printSudoku CR solver CR bye