# Listing of doc/example-scripts/rosetta-sudoku.tcl

## Rosetta Example: Sudoku

Solve a partially filled-in 9x9 Sudoku grid and display the result in a human-readable format. For detailed description of this example, see http://rosettacode.org/wiki/Sudoku_Solver

This implementation is based on http://wiki.tcl.tk/19934

    package require nx

The class `Sudoku` implements the basic interface to a sudoku 9x9 board to load/dump data and to set/access cells, rows, columns and regions.

    nx::Class create Sudoku {

        :variable board

        # Setup an array from 0..9 to ease iterations over the cells of
        # lines and columns.
        for {set i 0} {$i < 9} {incr i} {lappend positions $i}
        :variable positions $positions

        :public method load {data} {
            #
            # Load a 9x9 partially solved sudoku. The unsolved cells are
            # represented by a@ symbols.
            #
            set error "data must be a 9-element list, each element also being a\
                    list of 9 numbers from 1 to 9 or blank or an @ symbol."
            if {[llength $data] != 9} {
                error $error
            }
            foreach y ${:positions} {
                set row [lindex $data $y]
                if {[llength $row] != 9} {
                    error $error
                }
                foreach x ${:positions} {
                    set cell [lindex $row $x]
                    if {![regexp {^[@1-9]?$} $cell]} {
                        error $cell-$error
                    }
                    if {$cell eq "@"} {set cell ""}
                    :set $x $y $cell
                }
            }
        }

        :public method dump {-pretty-print:switch} {
            #
            # Output the current state of the sudoku either as list or in
            # a pretty-print style.
            #
            set rows [lmap y ${:positions} {:getRow 0 $y}]
            if {${pretty-print}} {
                set result +-----+-----+-----+\n
                foreach line $rows postline {0 0 1 0 0 1 0 0 1} {
                    append result |[lrange $line 0 2]|[lrange $line 3 5]|[lrange $line 6 8]|\n
                    if {$postline} {
                        append result +-----+-----+-----+\n
                    }
                }
                return $result
            } else {
                return $rows
            }
        }

        :method log {msg} {
            #puts "log: $msg"
        }

        :method set {x y value:integer,0..1} {
            #
            # Set cell at position x,y to the given value or empty.
            #
            if {$value<1 || $value>9} {
                set :board($x,$y) {}
            } else {
                set :board($x,$y) $value
            }
        }
        :method get {x y} {
            #
            # Get value of cell at position x, y.
            #
            return [set :board($x,$y)]
        }

        :method getRow {x y} {
            #
            # Return a row at constant position y.
            #
            return [lmap x ${:positions} {:get $x $y}]
        }
        :method getCol {x y} {
            #
            # Return a column at constant position x.
            #
            return [lmap y ${:positions} {:get $x $y}]
        }

        :method getRegion {x y} {
            #
            # Return a 3x3 region
            #
            set xR [expr {($x/3)*3}]
            set yR [expr {($y/3)*3}]
            set regn {}
            for {set x $xR} {$x < $xR+3} {incr x} {
                for {set y $yR} {$y < $yR+3} {incr y} {
                    lappend regn [:get $x $y]
                }
            }
            return $regn
        }
    }

The class `SudokuSolver` inherits from `Sudoku`, and adds the ability to solve a given Sudoku game. The method solve applies all rules for each unsolved cell until it finds a safe solution.

    nx::Class create SudokuSolver -superclass Sudoku {

        :public method validchoices {x y} {
            set v [:get $x $y]
            if {$v ne {}} {
                return $v
            }

            set row [:getRow $x $y]
            set col [:getCol $x $y]
            set regn [:getRegion $x $y]
            set eliminate [list {*}$row {*}$col {*}$regn]
            set eliminate [lsearch -all -inline -not $eliminate {}]
            set eliminate [lsort -unique $eliminate]

            set choices {}
            for {set c 1} {$c < 10} {incr c} {
                if {$c ni $eliminate} {
                    lappend choices $c
                }
            }
            if {[llength $choices]==0} {
                error "No choices left for square $x,$y"
            }
            return $choices
        }

        :method completion {} {
            #
            # Return the number of already solved items.
            #
            return [expr {81-[llength [lsearch -all -inline [join [:dump]] {}]]}]
        }

        :public method solve {} {
            #
            # Try to solve the sudoku by applying the provided rules.
            #
            while {1} {
                set begin [:completion]
                foreach y ${:positions} {
                    foreach x ${:positions} {
                        if {[:get $x $y] eq ""} {
                            foreach rule [Rule info instances] {
                                set c [$rule solve [self] $x $y]
                                if {$c} {
                                    :set $x $y $c
                                    :log "[$rule info class] solved [self] at $x,$y for $c"
                                    break
                                }
                            }
                        }
                    }
                }
                set end [:completion]
                if {$end == 81} {
                    :log "Finished solving!"
                    break
                } elseif {$begin == $end} {
                    :log "A round finished without solving any squares, giving up."
                    break
                }
            }
        }
    }

The class rule provides "solve" as public interface for all rule objects. The rule objects apply their logic to the values passed in and return either 0 or a number to allocate to the requested square.

    nx::Class create Rule {

        :public method solve {hSudoku:object,type=::SudokuSolver x y} {
            :Solve $hSudoku $x $y [$hSudoku validchoices $x $y]
        }

        # Get all the allocated numbers for each square in the the row, column, and
        # region containing $x,$y. If there is only one unallocated number among all
        # three groups, it must be allocated at $x,$y
        :create ruleOnlyChoice {
            :object method Solve {hSudoku x y choices} {
                if {[llength $choices] == 1} {
                    return $choices
                } else {
                    return 0
                }
            }
        }

        # Test each column to determine if $choice is an invalid choice for all other
        # columns in row $X. If it is, it must only go in square $x,$y.
        :create RuleColumnChoice {
            :object method Solve {hSudoku x y choices} {
                foreach choice $choices {
                    set failed 0
                    for {set x2 0} {$x2 < 9} {incr x2} {
                        if {$x2 != $x && $choice in [$hSudoku validchoices $x2 $y]} {
                            set failed 1
                            break
                        }
                    }
                    if {!$failed} {return $choice}
                }
                return 0
            }
        }

        # Test each row to determine if $choice is an invalid choice for all other
        # rows in column $y. If it is, it must only go in square $x,$y.
        :create RuleRowChoice {
            :object method Solve {hSudoku x y choices} {
                foreach choice $choices {
                    set failed 0
                    for {set y2 0} {$y2 < 9} {incr y2} {
                        if {$y2 != $y && $choice in [$hSudoku validchoices $x $y2]} {
                            set failed 1
                            break
                        }
                    }
                    if {!$failed} {return $choice}
                }
                return 0
            }
        }

        # Test each square in the region occupied by $x,$y to determine if $choice is
        # an invalid choice for all other squares in that region. If it is, it must
        # only go in square $x,$y.
        :create RuleRegionChoice {
            :object method Solve {hSudoku x y choices} {
                foreach choice $choices {
                    set failed 0
                    set regnX [expr {($x/3)*3}]
                    set regnY [expr {($y/3)*3}]
                    for {set y2 $regnY} {$y2 < $regnY+3} {incr y2} {
                        for {set x2 $regnX} {$x2 < $regnX+3} {incr x2} {
                            if {
                                ($x2!=$x || $y2!=$y)
                                && $choice in [$hSudoku validchoices $x2 $y2]
                            } then {
                                set failed 1
                                break
                            }
                        }
                    }
                    if {!$failed} {return $choice}
                }
                return 0
            }
        }
    }

    SudokuSolver create sudoku {

        :load {
            {3 9 4    @ @ 2    6 7 @}
            {@ @ @    3 @ @    4 @ @}
            {5 @ @    6 9 @    @ 2 @}

            {@ 4 5    @ @ @    9 @ @}
            {6 @ @    @ @ @    @ @ 7}
            {@ @ 7    @ @ @    5 8 @}

            {@ 1 @    @ 6 7    @ @ 8}
            {@ @ 9    @ @ 8    @ @ @}
            {@ 2 6    4 @ @    7 3 5}
        }
        :solve

        puts [:dump -pretty-print]
    }

The dump method outputs the solved Sudoku:

    +-----+-----+-----+
    |3 9 4|8 5 2|6 7 1|
    |2 6 8|3 7 1|4 5 9|
    |5 7 1|6 9 4|8 2 3|
    +-----+-----+-----+
    |1 4 5|7 8 3|9 6 2|
    |6 8 2|9 4 5|3 1 7|
    |9 3 7|1 2 6|5 8 4|
    +-----+-----+-----+
    |4 1 3|5 6 7|2 9 8|
    |7 5 9|2 3 8|1 4 6|
    |8 2 6|4 1 9|7 3 5|
    +-----+-----+-----+