#!/usr/bin/tclsh
set regions {
    0 0 0 0 1 1 2 2 2 
    0 0 0 1 1 1 2 2 2 
    0 0 1 1 1 1 2 2 2 
    3 3 4 4 4 4 5 5 5 
    3 3 3 6 6 4 5 5 5 
    3 3 3 6 6 4 4 5 5 
    3 6 6 6 6 4 4 7 5 
    8 8 8 8 8 6 7 7 7 
    8 8 8 8 7 7 7 7 7 
}

set states { WV KY WY AL FL NV NY VA TN }

set letters { A F K L N T V W Y }

set initpuz {
    W V _ _ _ _ _ _ _ 
    _ _ _ _ K Y _ _ _ 
    _ _ _ _ _ _ _ W Y 
    _ _ F L _ _ _ _ _ 
    _ _ _ _ _ _ N V _ 
    A L _ _ _ _ _ _ _ 
    _ _ N Y _ _ _ _ _ 
    _ _ _ _ _ _ V A _ 
    T N _ _ _ _ _ _ _ 
}


proc search { puz solution } {
    global letters regions states
    
    set grid [lindex $puz 0]
    set marks [lindex $puz 1]

    for { set i 0 } { $i < 81 } { incr i } {
	if { [lindex $grid $i] == "_" } {
	    break
	}
    }
    if { $i == 81 } {
	puts "puzzle is solved:\n$solution"
	printpuz $puz
	return 1
    }
    
    # single value for cell
    for { set r 0 } { $r < 9 } { incr r } {
	for { set c 0 } { $c < 9 } { incr c } {
	    set i [expr $r*9+$c]
	    if { [lindex $grid $i] == "_" &&
		 [llength [lindex $marks $i]] == 1 } {
		set letter [lindex $marks $i]
		return [search [answer $puz $i $letter] "${solution}row [expr $r+1] column [expr $c+1] can only be a $letter\n"]
	    }
	}
    }
    # single candidate in row
    for { set r 0 } { $r < 9 } { incr r } {
	foreach letter $letters {
	    set counts($letter) 0
	}
	for { set c 0 } { $c < 9 } { incr c } {
	    set mark [lindex $marks [expr $r*9+$c]]
	    set cell [lindex $grid [expr $r*9+$c]]
	    foreach letter $letters {
		if { [lsearch $mark $letter] >= 0 } {
		    incr counts($letter)
		    set savecol($letter) $c
		}
		if { $cell == $letter } {
		    incr counts($letter) -1
		}
	    }
	}
	foreach letter $letters {
	    if { $counts($letter) == 1 } {
		return [search [answer $puz [expr $r*9+$savecol($letter)] $letter] "${solution}only one place for letter $letter in row [expr $r+1]\n"]
	    }
	}
    }
    # single candidate in column
    for { set c 0 } { $c < 9 } { incr c } {
	foreach letter $letters {
	    set counts($letter) 0
	}
	for { set r 0 } { $r < 9 } { incr r } {
	    set mark [lindex $marks [expr $r*9+$c]]
	    set cell [lindex $grid [expr $r*9+$c]]
	    foreach letter $letters {
		if { [lsearch $mark $letter] >= 0 } {
		    incr counts($letter)
		    set saverow($letter) $r
		}
		if { $cell == $letter } {
		    incr counts($letter) -1
		}
	    }
	}
	foreach letter $letters {
	    if { $counts($letter) == 1 } {
		return [search [answer $puz [expr $saverow($letter)*9+$c] $letter] "${solution}only one place for letter $letter in column [expr $c+1]\n"]
	    }
	}
    }
    # single candidate in region
    for { set region 0 } { $region < 9 } { incr region } { 
	foreach letter $letters {
	    set counts($letter) 0
	}
	for { set c 0 } { $c < 9 } { incr c } {
	    for { set r 0 } { $r < 9 } { incr r } {
		set mark [lindex $marks [expr $r*9+$c]]
		set cell [lindex $grid [expr $r*9+$c]]
		set a2 [lindex $regions [expr $r*9+$c]]
		if { $a2 == $region } {
		    foreach letter $letters {
			if { [lsearch $mark $letter] >= 0 } {
			    incr counts($letter)
			    set saveloc($letter) [expr $r*9+$c]
			}
			if { $cell == $letter } {
			    incr counts($letter) -1
			}
		    }
		}
	    }
	}
	foreach letter $letters {
	    if { $counts($letter) == 1 } {
		return [search [answer $puz [expr $saveloc($letter)] $letter] "${solution}only one place for letter $letter in [lindex $states $region]\n"]
	    }
	}
    }
    # guessing
    for { set r 0 } { $r < 9 } { incr r } {
	for { set c 0 } { $c < 9 } { incr c } {
	    set i [expr $r*9+$c]
	    if { [llength [lindex $marks $i]] > 1 } {
		foreach letter [lindex $marks $i] {
		    set guess [answer $puz $i $letter]
		    set result [search $guess "${solution}guessing $letter at row [expr $r+1] column [expr $c+1]\n"]
		    if { $result } {
			return 1
		    }
		}
		return 0
	    }
	}
    }
    return 0
}

proc answer { puz location value } {
    global regions

    set grid [lindex $puz 0]
    set marks [lindex $puz 1]
    set grid [lreplace $grid $location $location $value]
    set r1 [expr $location / 9]
    set c1 [expr $location % 9]
    set a1 [lindex $regions $location]
    for { set i 0 } { $i < 81 } { incr i } {
	set r2 [expr $i / 9]
	set c2 [expr $i % 9]
	set a2 [lindex $regions $i]
	if { $r1 == $r2 ||
	     $c1 == $c2 ||
	     $a1 == $a2 } {
	    set oldmarks [lindex $marks $i]
	    set j [lsearch $oldmarks $value]
	    if { $j >= 0 } {
		set oldmarks [lreplace $oldmarks $j $j]
	    }
	    set marks [lreplace $marks $i $i $oldmarks]
	}
    }
    set marks [lreplace $marks $location $location $value]
    set newpuz {}
    lappend newpuz $grid
    lappend newpuz $marks
    return $newpuz
}

proc init {} {
    global grid letters initpuz puz marks
    set puz {}
    lappend puz $initpuz
    for { set i 0 } { $i < 81 } { incr i } {
	lappend marks $letters
    }
    lappend puz $marks
    for { set i 0 } { $i < 81 } { incr i } {
	if {[lindex $initpuz $i] != "_"} {
	    set puz [answer $puz $i [lindex $initpuz $i]]
	}
    }
}

proc printpuz { puz } {
    global regions
    set maxlen 0
    set grid [lindex $puz 0]
    set marks [lindex $puz 1]
    foreach mark $marks {
	if {[llength $mark] > $maxlen} {
	    set maxlen [llength $mark]
	}
    }
    set maxlen2 [expr $maxlen + 2]
    puts -nonewline "+"
    for { set c 0 } { $c < 9 } { incr c } {
	for { set j 0 } { $j < $maxlen2 } { incr j } {
	    puts -nonewline "-"
	}
	puts -nonewline "+"
    }
    puts ""
    for { set r 0 } { $r < 9 } { incr r } {
	puts -nonewline "| "
	for { set c 0 } { $c < 9 } { incr c } {
	    set i [expr $r*9+$c]
	    set previ [expr $i-1]
	    if { $c > 0 } {
		if { [lindex $regions $previ] == [lindex $regions $i] } {
		    puts -nonewline "  "
		} else {
		    puts -nonewline "| "
		}
	    }
	    set mark [join [lindex $marks $i] ""]
	    puts -nonewline [format "%-${maxlen}s " $mark]
	}
	puts "|"
	puts -nonewline "+"
	for { set c 0 } { $c < 9 } { incr c } {
	    set previ [expr $r*9+$c]
	    set i [expr $previ+9]
	    for { set j 0 } { $j < $maxlen2 } { incr j } {
		if { [lindex $regions $previ] == [lindex $regions $i] } {
		    puts -nonewline " "
		} else {
		    puts -nonewline "-"
		}
	    }
	    puts -nonewline "+"
	}
	puts ""
    }
}

init
printpuz $puz
search $puz ""