ZHUOWARE BACKYARD - NOTE INDEX|ZHUOWARE BACKYARD TOP|ZHUOWARE表ページ

Sudoku Solver in tcl/tk and its equivalent in C //　数独求解スクリプトとそのC実装

Apr. 18, 2009 - May 7, 2009 by Zhuo

I have written a Sudoku Solver in tcl/tk, and its equivalent in C. The C version solves a difficult one in about 1 milli-second on my machine (with a Core2 Duo 6600 @ 2.4GHz inside).

May 7, 2009: C version (Rev. 0.02)

I have implemented the algorithm in C. A difficult example (sample01.txt) now takes 1.04 milli-seconds, so it is about 250,000 times faster than the initial algorithm in tcl.

Download:

SudokuSolverC0_02.zip : source files
sudokuSolver002Exe.zip: binary for windows (command line application)

Usage:

Prepare a problem in the plain text format. Just list up the digits for all the tiles (81 in total); 1 thru 9 for a fixed, 0 for an unfixed. You can insert a "CR" at any locations, so you may probably want to begin a new line every 9 digits so the text looks like the original problem. An example text is shown below (sample01.txt):
```
604000900
000070060
500002003
000100400
040020080
007008000
800900001
050030000
003000809
```
Save the text in a file ... say, "sample01.txt".
Type to the command prompt:
```
.\sudokuSolver002.exe < .\sample01.txt 
```
and the answer is printed.
If the problem is incomplete, you will see zeros in the answer, possibly with the message "failed".

Comments:

No doubt there should be way better internal data representaions in terms of efficiency; For instance, instead of modifying bits of all the tiles affected every time, we should hold "candidate mask" for each column/row/box.

However, I think I should stop here --- I have a lot of stuff to work on other than this "sudoku solver", so spending hours on the algorithm itself is actually wasting my precious time, now I feel. Well, who knows. I might come back to this problem all of sudden ... but, maybe, not now.

Apr. 22, 2009: Tcl/Tk script Rev. 0.60

Ok, I introduced branch-cutting. It made things 200 times faster. The attached example takes 1.25 seconds on my machine.

#
# Sudoku Solver
#
# Rev. 0.10   Apr. 18, 2009   zhuo    --- sec.  (reduction only)
# Rev. 0.20   Apr. 19, 2009   zhuo    256 sec.  "inference" introduced
# Rev. 0.30   Apr. 19, 2009   zhuo    249 sec.  string representation.
# Rev. 0.40   Apr. 19, 2009   zhuo    xxx       better reducer? but failed.
#                                               takes 0.032 sec (c.f. 0.008
#                                               at R0.30)
#                                               ...width-search is not so bad.
# Rev. 0.50   Apr. 20, 2009   zhuo    243 sec   yet another reducer: it answeres
#                                               ok or ng
# Rev. 0.60   Apr. 22, 2009   zhuo    1.25 sec  try branch-reducing in infer{}
#                                         OK. 

# Platform:
# Mac/Windows/Linux and any platforms where Tcl/Tk runs. 
#
# Preparation:
# - Install Tcl/Tk.
# - Save this text as xxx.tcl (xxx: any filename you like).
#
# How to run:
# - Click xxx.tcl to start.
# - Enter the numbers. You can use tab / shift-tab for traverse.
# - Click "SOLVE" to have the answer.
# - Click "EXIT" to quit.

array set ::D {}

# inference necessary
set ::sample {
    6  "" 4  "" "" "" 9  "" ""
    "" "" "" "" 7  "" "" 6  ""
    5  "" "" "" "" 2  "" "" 3 
    "" "" "" 1  "" "" 4  "" ""
    "" 4  "" "" 2  "" "" 8  ""
    "" "" 7  "" "" 8  "" "" ""
    8  "" "" 9  "" "" "" "" 1 
    "" 5  "" "" 3  "" "" "" ""
    "" "" 3  "" "" "" 8  "" 9 
}

# inference not necessary
set ::sample1 {
    "" 6  3  "" 5  "" "" "" "" 
    "" 4  "" 2  "" "" 8  6  ""
    "" "" "" 6  "" "" "" 4  ""
    "" "" "" 4  "" "" "" 2  ""
    5  2  "" 3  "" 6  "" 8  9
    "" 7  "" "" "" 1  "" "" ""
    "" 8  "" "" "" 9  "" "" ""
    "" 3  4  "" "" 7  "" 1  ""
    "" "" "" "" 4  "" 9  5  ""
}


frame .p
for { set y 0 } { $y < 9 } { incr y } {
    for { set x 0 } { $x < 9 } { incr x } {
	entry .p.e$x$y -text "" -justify center -font {FixedSys 32} -width 2
	.p.e$x$y insert end [lindex $::sample [expr $y * 9 + $x]]
	grid .p.e$x$y -column $x -row $y -sticky news
    }
}

button .b -text "SOLVE" -command "solve"
button .c -text "CLEAR" -command "clear"
button .d -text "DUMP" -command "dump"
button .e -text "EXIT" -command "destroy ."

pack .b -side top -expand yes -fill both
pack .c -side top -expand yes -fill both
pack .d -side top -expand yes -fill both
pack .e -side top -expand yes -fill both
pack .p -side top -expand yes -fill both

console show

proc clear {} {
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    .p.e$x$y delete 0 end
	}
    }
}

proc dump {} {
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    puts -nonewline "$::D($x,$y) "
	}
	puts ""
    }
}


proc load {} {
    set ::numFixed 0
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    set val [.p.e$x$y get]
	    if { $val == "" } { 
		set ::D($x,$y) "123456789"
	    } else {
		set ::D($x,$y) $val
	    }
	}
    }
}


proc solve {} {
    # load initial settings
    load
    set t0 [clock clicks -milliseconds]
    reduce ::D
    set t1 [clock clicks -milliseconds]
    set reduceSec [format "%6.3f(sec)" [expr (0.0+$t1-$t0)/1000.0]]
    set inferSec [format "%6.3f(sec)" 0.0]
    if { $::numFixed == 81 } {
	tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok
	return 
    }
    set result [infer ::D]
    set t2 [clock clicks -milliseconds]
    set inferSec [format "%6.3f(sec)" [expr (0.0+$t2-$t1)/1000.0]]
    if { $result == "complete" } {
	tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok
	return 
    }
    tk_messageBox -message "Not Solved : Illegal Conditions Suspected.\nReduction: $reduceSec\nInference: $inferSec" -type ok
}


########################################
# 05 yet another better reducer...
########################################
proc reduce {Dname} {
    upvar $Dname d
    
    set ::indice {}
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    if { [string length $d($x,$y)] == 1 } { 
		lappend ::indice $x $y
	    }
	}
    }
    return [reduce5 d]
}


proc reduce5 {Dname} {
    upvar $Dname d
    while { [llength $::indice] } {
	if { ! [reduce5internal d [lindex $::indice 0] [lindex $::indice 1]] } {
	    set ::indice {}
	    return 0
	}
	set ::indice [lreplace $::indice 0 1]
	incr ::numFixed
    }	
    return 1
}


proc reduce5internal {Dname bx by} {
    upvar $Dname d

    set v $d($bx,$by)
    if {$v == ""} { 
	return 0
    }

    set xfrom [expr {($bx/3)*3}]
    set yfrom [expr {($by/3)*3}]
    set xbelow [expr {$xfrom+3}]
    set ybelow [expr {$yfrom+3}]
    for { set y $yfrom } { $y < $ybelow } { incr y } {
	if { $y == $by } { continue }
	for { set x $xfrom } { $x < $xbelow } { incr x } {
	    if { ($bx != $x) && [reduce3elem d $x $y $v] == 0 } {
		return 0
	    }
	}
    }
    for { set i 0 } { $i < 9 } { incr i } { 
	if { ($i != $bx) && [reduce3elem d $i $by $v] == 0 } {
	    return 0
	}
	if { ($i != $by) && [reduce3elem d $bx $i $v] == 0 } {
	    return 0
	}
    }
    return 1
}


proc reduce3elem { Dname ex ey val} {
    upvar $Dname d
    if { [regsub $val $d($ex,$ey) "" new] } {
	if { $new == "" } {
	    return 0
	}
	if { [string length $new] == 1 } {
	    .p.e$ex$ey delete 0 end
	    .p.e$ex$ey insert end $new
	    lappend ::indice $ex $ey
	}
	set d($ex,$ey) $new
    }
    return 1
}


######################################################################
proc findFirstMultiple {dname} {
    upvar $dname orig
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    if { [string length $orig($x,$y)] > 1 } {
		return "$x $y"
	    }
	}
    }
    return ""
}
    
proc infer {dname} {
    upvar $dname orig
    
    # find unfixed elem.
    set xy [findFirstMultiple orig]
    if { $xy == "" } { return "complete"}

    # incomplete
    set x [lindex $xy 0]
    set y [lindex $xy 1]

    # backup
    set backup [array get orig]

    set cands $orig($x,$y)

    foreach cand [split $cands ""] {
	set orig($x,$y) $cand
	.p.e$x$y delete 0 end
	.p.e$x$y insert end $cand
	update
	set ::indice "$x $y"
	if { [reduce5 orig] } {
	    if { [infer orig] == "complete" } {
		return "complete"
	    }
	}
	array set orig $backup
    }
    .p.e$x$y delete 0 end
    update
    return "fail"
}

Apr. 19, 2009: Rev. 0.30 OBSOLETE CODES

Rev. 0.20 is skipped. As of this version it tries to infer the solution, doing combinatory inference. The attached example takes 250 seconds on my machine.

#
# Sudoku Solver
#
# Rev. 0.10   Apr. 18, 2009   zhuo    --- sec.  (reduction only)
# Rev. 0.20   Apr. 19, 2009   zhuo    256 sec.  "inference" introduced
# Rev. 0.30   Apr. 19, 2009   zhuo    249 sec.  string representation.
#
# 
# Platform:
# Mac/Windows/Linux and any platforms where Tcl/Tk runs. 
#
# Preparation:
# - Install Tcl/Tk.
# - Save this text as xxx.tcl (xxx: any filename you like).
#
# How to run:
# - Click xxx.tcl to start.
# - Enter the numbers. You can use tab / shift-tab for traverse.
# - Click "SOLVE" to have the answer.
# - Click "EXIT" to quit.

array set ::D {}

# inference necessary
set ::sample {
    6  "" 4  "" "" "" 9  "" ""
    "" "" "" "" 7  "" "" 6  ""
    5  "" "" "" "" 2  "" "" 3 
    "" "" "" 1  "" "" 4  "" ""
    "" 4  "" "" 2  "" "" 8  ""
    "" "" 7  "" "" 8  "" "" ""
    8  "" "" 9  "" "" "" "" 1 
    "" 5  "" "" 3  "" "" "" ""
    "" "" 3  "" "" "" 8  "" 9 
}

# inference not necessary
set ::sample0 {
    "" 6  3  "" 5  "" "" "" "" 
    "" 4  "" 2  "" "" 8  6  ""
    "" "" "" 6  "" "" "" 4  ""
    "" "" "" 4  "" "" "" 2  ""
    5  2  "" 3  "" 6  "" 8  9
    "" 7  "" "" "" 1  "" "" ""
    "" 8  "" "" "" 9  "" "" ""
    "" 3  4  "" "" 7  "" 1  ""
    "" "" "" "" 4  "" 9  5  ""
}


frame .p
for { set y 0 } { $y < 9 } { incr y } {
    for { set x 0 } { $x < 9 } { incr x } {
	entry .p.e$x$y -text "" -justify center -font {FixedSys 32} -width 2
	.p.e$x$y insert end [lindex $::sample [expr $y * 9 + $x]]
	grid .p.e$x$y -column $x -row $y -sticky news
    }
}

button .b -text "SOLVE" -command "solve"
button .c -text "CLEAR" -command "clear"
button .d -text "DUMP" -command "dump"
button .e -text "EXIT" -command "destroy ."

pack .b -side top -expand yes -fill both
pack .c -side top -expand yes -fill both
pack .d -side top -expand yes -fill both
pack .e -side top -expand yes -fill both
pack .p -side top -expand yes -fill both

console show

proc clear {} {
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    .p.e$x$y delete 0 end
	}
    }
}

proc dump {} {
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    puts -nonewline "$::D($x,$y) "
	}
	puts ""
    }
}


proc load {} {
    set ::numFixed 0
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    set val [.p.e$x$y get]
	    if { $val == "" } { 
		set ::D($x,$y) "123456789"
		set ::D($x,$y,Fixed) 0
	    } else {
		set ::D($x,$y) $val
		set ::D($x,$y,Fixed) 1
		incr ::numFixed
	    }
	    set ::D($x,$y,Used) 0
	}
    }
}


proc solve {} {
    # load initial settings
    load
    set t0 [clock clicks -milliseconds]
    reduce ::D
    set t1 [clock clicks -milliseconds]
    set reduceSec [format "%6.3f(sec)" [expr (0.0+$t1-$t0)/1000.0]]
    set inferSec [format "%6.3f(sec)" 0.0]
    if { $::numFixed == 81 } {
	tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok
	return 
    }
    set result [infer ::D]
    set t2 [clock clicks -milliseconds]
    set inferSec [format "%6.3f(sec)" [expr (0.0+$t2-$t1)/1000.0]]
    if { $result == "complete" } {
	tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok
	return 
    }
    tk_messageBox -message "Not Solved : Illegal Conditions Suspected.\nReduction: $reduceSec\nInference: $inferSec" -type ok
}



proc reduce {Dname} {
    upvar $Dname d
    while { [reduceOne d] > 0 } {}
}

proc reduceOne {Dname} {
    upvar $Dname d
    set reduce 0
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    if { $d($x,$y,Fixed) && (!$d($x,$y,Used)) } {
		incr reduce [reduceOneInternal d $x $y]
		set d($x,$y,Used) 1
	    }
	}
    }	
    return $reduce
}


proc updateElem {dname ex ey val} {
    upvar $dname d
    set reduce 0
    if { [regsub $val $d($ex,$ey) "" d($ex,$ey)] } {
	incr reduce
	if { [string length $d($ex,$ey)] == 1 } {
	    set d($ex,$ey,Fixed) 1
	    set d($ex,$ey,Used) 0
	    .p.e$ex$ey delete 0 end
	    .p.e$ex$ey insert end $d($ex,$ey)
	    incr ::numFixed
	}
    }
    return $reduce
}

proc reduceOneInternal { dname bx by } {
    upvar $dname d
    set reduce 0
    for { set x 0 } { $x < 9 } { incr x } {
	if { (! $d($x,$by,Fixed)) && ($x != $bx) } {
	    incr reduce [updateElem d $x $by $d($bx,$by)]
	}
    }
    for { set y 0 } { $y < 9 } { incr y } {
	if { (! $d($bx,$y,Fixed)) && ($y != $by) } {
	    incr reduce [updateElem d $bx $y $d($bx,$by)]
	}
    }
    set xfrom [expr ($bx/3)*3]
    set xbelow [expr $xfrom+3]
    set yfrom [expr ($by/3)*3]
    set ybelow [expr $yfrom+3]

    for { set x $xfrom } { $x < $xbelow} { incr x } {
	for { set y $yfrom } { $y < $ybelow} { incr y } {
	    if { (! $d($x,$y,Fixed)) && ( ($x != $bx) || ($y != $by) )  } {
		incr reduce [updateElem d $x $y $d($bx,$by)]
	    }
	}
    }
    return $reduce
}


######################################################################
proc findFirstMultiple {dname} {
    upvar $dname orig
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    if { [string length $orig($x,$y)] > 1 } {
		return "$x $y"
	    }
	}
    }
    return ""
}
    
proc infer {dname} {
    upvar $dname orig
    
    # find unfixed elem.
    set xy [findFirstMultiple orig]
    if { $xy == "" } { return "complete"}

    # incomplete
    set x [lindex $xy 0]
    set y [lindex $xy 1]

    #   array set backup [array get orig]
    set cands $orig($x,$y)

    foreach cand [split $cands ""] {
	set orig($x,$y) $cand
	.p.e$x$y delete 0 end
	.p.e$x$y insert end $cand
	update
	if { [isValid orig $x $y] } {
	    if { [infer orig] == "complete" } {
		return "complete"
	    }
	}
    }
    set orig($x,$y) $cands
    .p.e$x$y delete 0 end
    update
    return "fail"
}


proc isValid { dname px py } {
    upvar $dname d

    set val $d($px,$py)
    # row check
    for { set x 0 } { $x < 9 } { incr x } {
	if { $x != $px } { 
	    if { $d($x,$py) == $val } {
		return 0
	    }
	}
    }
    # column check
    for { set y 0 } { $y < 9 } { incr y } {
	if { $y != $py } { 
	    if { $d($px,$y) == $val } {
		return 0
	    }
	}
    }
    # box check
    set xfrom [expr ($px/3)*3]
    set xbelow [expr $xfrom+3]
    set yfrom [expr ($py/3)*3]
    set ybelow [expr $yfrom+3]

    for { set y $yfrom } { $y < $ybelow} { incr y } {
	for { set x $xfrom } { $x < $xbelow } { incr x } {
	    if { ($x != $px) || ($y != $py) } {
		if { $d($x,$y) == $val } {
		    return 0
		}
	    }
	}
    }
    return 1
}

Apr. 18, 2009: Rev. 0.10 Obsolete Code

The code below turned out to be just "reducing". This is ok for easy cases, but for difficult cases which require combinatory inference need Rev. 0.30.

#
# Sudoku Solver
#
# Rev. 0.10   Apr. 18, 2009   zhuo
#
# 
# Platform:
# Mac/Windows/Linux and any platforms where Tcl/Tk runs. 
#
# Preparation:
# - Install Tcl/Tk.
# - Save this text as xxx.tcl (xxx: any filename you like).
#
# How to run:
# - Click xxx.tcl to start.
# - Enter the numbers. You can use tab / shift-tab for traverse.
# - Click "SOLVE" to have the answer.
# - Click "EXIT" to quit.

array set ::Values {}
array set ::Fixed {}
array set ::Used {}

set ::sample {
    "" 6  3  "" 5  "" "" "" "" 
    "" 4  "" 2  "" "" 8  6  ""
    "" "" "" 6  "" "" "" 4  ""
    "" "" "" 4  "" "" "" 2  ""
    5  2  "" 3  "" 6  "" 8  9
    "" 7  "" "" "" 1  "" "" ""
    "" 8  "" "" "" 9  "" "" ""
    "" 3  4  "" "" 7  "" 1  ""
    "" "" "" "" 4  "" 9  5  ""
}


frame .p
for { set y 0 } { $y < 9 } { incr y } {
    for { set x 0 } { $x < 9 } { incr x } {
	entry .p.e$x$y -text "" -justify center -font {FixedSys 32} -width 2
#	.p.e$x$y insert end [lindex $::sample [expr $y * 9 + $x]]
	grid .p.e$x$y -column $x -row $y -sticky news
    }
}

button .b -text "SOLVE" -command "solve"
#button .d -text "DUMP" -command "dump"
button .e -text "EXIT" -command "destroy ."

pack .b -side top -expand yes -fill both
pack .d -side top -expand yes -fill both
pack .e -side top -expand yes -fill both
pack .p -side top -expand yes -fill both

proc dump {} {
    console show
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    puts -nonewline "( $::Values($x,$y) ) "
	}
	puts ""
    }
}

proc load {} {
    set ::numFixed 0
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    set val [.p.e$x$y get]
	    if { $val == "" } { 
		set ::Values($x,$y) {1 2 3 4 5 6 7 8 9}
		set ::Fixed($x,$y) 0
	    } else {
		set ::Values($x,$y) $val
		set ::Fixed($x,$y) 1
		incr ::numFixed
	    }
	    set ::Used($x,$y) 0
	}
    }
}

proc solve {} {
    # load initial settings
    load
    while { $::numFixed < 81 } {
	if { [solveOne] == 0 } {
	    tk_messageBox -message "Not Solved : Illegal Conditions Suspected." -type ok
	    return
	}
    }
    tk_messageBox -message "Solved." -type ok
}

proc solveOne {} {
    set elim 0
    for { set y 0 } { $y < 9 } { incr y } {
	for { set x 0 } { $x < 9 } { incr x } {
	    if { $::Fixed($x,$y) && (!$::Used($x,$y)) } {
		incr elim [eliminateRow $x $y]
		incr elim [eliminateColumn $x $y]
		incr elim [eliminateBox $x $y]
		set ::Used($x,$y) 1
	    }
	}
    }	
    return $elim
}

proc updateElem {ex ey val} {
    set elim 0
    set i [lsearch $::Values($ex,$ey) $val]
    if { $i != -1 } {
	incr elim
	set ::Values($ex,$ey) [lreplace $::Values($ex,$ey) $i $i]
	if { [llength $::Values($ex,$ey)] == 1 } {
	    set ::Fixed($ex,$ey) 1
	    set ::Used($ex,$ey) 0
	    .p.e$ex$ey delete 0 end
	    .p.e$ex$ey insert end $::Values($ex,$ey)
	    incr ::numFixed
	}
    }
    return $elim
}

proc eliminateRow { bx by } {
    set elim 0
    for { set x 0 } { $x < 9 } { incr x } {
	if { (! $::Fixed($x,$by)) && ($x != $bx) } {
	    incr elim [updateElem $x $by $::Values($bx,$by)]
	}
    }
    return $elim
}

proc eliminateColumn { bx by } {
    set elim 0
    for { set y 0 } { $y < 9 } { incr y } {
	if { (! $::Fixed($bx,$y)) && ($y != $by) } {
	    incr elim [updateElem $bx $y $::Values($bx,$by)]
	}
    }
    return $elim
}

proc eliminateBox { bx by } {
    set elim 0
    set xfrom [expr ($bx/3)*3]
    set xbelow [expr $xfrom+3]
    set yfrom [expr ($by/3)*3]
    set ybelow [expr $yfrom+3]

    for { set x $xfrom } { $x < $xbelow} { incr x } {
	for { set y $yfrom } { $y < $ybelow} { incr y } {
	    if { (! $::Fixed($x,$y)) && ( ($x != $bx) || ($y != $by) )  } {
		incr elim [updateElem $x $y $::Values($bx,$by)]
	    }
	}
    }
    return $elim
}

Sudoku Solver in tcl/tk and its equivalent in C // 数独求解スクリプトとそのC実装

May 7, 2009: C version (Rev. 0.02)

Apr. 22, 2009: Tcl/Tk script Rev. 0.60

Apr. 19, 2009: Rev. 0.30 OBSOLETE CODES

Apr. 18, 2009: Rev. 0.10 Obsolete Code

Sudoku Solver in tcl/tk and its equivalent in C //　数独求解スクリプトとそのC実装