#!/usr/bin/bash
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

# ===========================================================================
# File: "sudokut"
#                        Created: 2005-11-21 14:47:04
#              Last modification: 2014-01-03 09:47:34
# Author: Bernard Desgraupes
# e-mail: <bdesgraupes@users.sourceforge.net>
# www: <http://sudokut.sourceforge.net/>
# (c) Copyright: Bernard Desgraupes 2005-2014
# All rights reserved.
# ===========================================================================


namespace eval sdku {
	variable baseList [list ns hs br bb np hp]
	# lv removed
	variable extraList [list nt ht xw xyw nq hq sf jf alsxz alsxyw sb wh]
}


# This is for generating the doc
unset -nocomplain sudp sudt

# Initializations
# ---------------
set sudp(version)		"0.7"
set sudp(als)			0
set sudp(backtracking)	1
set sudp(displayCand)	0
set sudp(candValue)		0
set sudp(checkValid)	0
set sudp(counting)		0
set sudp(displayGrid)	0
set sudp(explain)		0
set sudp(forceCover)	0
set sudp(fromFile)		0
set sudp(incremental)	1
set sudp(oneSolution)	0
set sudp(probes)		""
set sudp(probing)		0
set sudp(rating)		0
set sudp(raw)			0
set sudp(solCount)		0
set sudp(suggestion)	0
set sudp(unicity)		0
set sudp(verbosity)		1
set sudp(buffer)		""
set sudp(currTech)		""
set sudp(ignoredCodes)	""
set sudp(tempSol)		""
set sudp(0)				"row"
set sudp(1)				"column"
set sudp(2)				"block"


# Techniques dictionary
set sudt [dict create]

dict set sudt alsxz name "ALS-XZ"
dict set sudt alsxz proc alsxzReduction

dict set sudt alsxyw name "ALS-XY-Wing"
dict set sudt alsxyw proc alsxywingReduction

dict set sudt bb name "block to block"
dict set sudt bb proc blockToBlockReduction

dict set sudt br name "block to row/col"
dict set sudt br proc blockToRowColReduction

dict set sudt hp name "hidden pair"
dict set sudt hp proc hiddenPairReduction

dict set sudt hq name "hidden quadruplet"
dict set sudt hq proc hiddenQuadrupletReduction

dict set sudt hs name "hidden single"
dict set sudt hs proc hiddenSingleReduction

dict set sudt ht name "hidden triplet"
dict set sudt ht proc hiddenTripletReduction

dict set sudt np name "naked pair"
dict set sudt np proc nakedPairReduction

dict set sudt nq name "naked quadruplet"
dict set sudt nq proc nakedQuadrupletReduction

dict set sudt ns name "naked single"
dict set sudt ns proc nakedSingleReduction

dict set sudt nt name "naked triplet"
dict set sudt nt proc nakedTripletReduction

dict set sudt xw name "X-Wing"
dict set sudt xw proc xwingReduction

dict set sudt sf name "swordfish"
dict set sudt sf proc swordfishReduction

dict set sudt jf name "jellyfish"
dict set sudt jf proc jellyfishReduction

dict set sudt sb name "squirmbag"
dict set sudt sb proc squirmbagReduction

dict set sudt wh name "whale"
dict set sudt wh proc whaleReduction

dict set sudt lv name "leviathan"
dict set sudt lv proc leviathanReduction

dict set sudt xyw name "XY-Wing"
dict set sudt xyw proc xywingReduction



# ------------------------------------------------------------------------
# 
# "sdku::execute" --
# 
# Main proc
# 
# ------------------------------------------------------------------------
proc sdku::execute {args} {
	global sudp
	set len [llength $args]

	if {$len == 0} {
		exitError "wrong number of arguments"
	} 

	# Handle the -h (help) option
	if {$len == 1 && [regexp -- "^--?h" $args]} {
		sdku::usage 
		return
	} 
	# Handle the -v (version) option
	if {$len == 1 && [regexp -- "^--?v" $args]} {
		puts "$sudp(version)"
		return
	} 
	# Handle the -t (techniques) option
	if {$len == 1 && ([lindex $args 0] eq "-t")} {
		printTechniques
		return
	} 
	# Handle the -d (diff) option
	if {$len == 3 && ([lindex $args 0] eq "-d")} {
		sdku::handleDiff [lindex $args 1] [lindex $args 2]
		return
	} 
	# Handle the -m (modify) option
	if {[lindex $args 0] eq "-m"} {
		eval sdku::handleModify [lrange $args 1 end]
		return
	} 
	# Retrieve the last argument
	set lastarg [lindex $args end]
	
	# Parse the options
	incr len -1

	for {set i 0} {$i < $len} {incr i} {
		set elem [lindex $args $i]
		switch -regexp -- $elem {
			"-a" {
				set sudp(als) 1
			}
			"-b" {
				set sudp(forceCover) 1
			}
			"-c" {
				set sudp(counting) 1
			}
			"-e" {
				set sudp(explain) 1
			}
			"-f" {
				set sudp(fromFile) 1
			}
			"-g" {
				set sudp(displayGrid) 1
			}
			"-i" {
				incr i
				if {$i < $len} {
					set sudp(ignoredCodes) [lindex $args $i]
				} else {
					exitError "missing value after option '-i'"
				}
			}
			"-j" {
				set sudp(checkValid) 1
			}
			"-k(\\d|\\+)" {
				set sudp(displayCand) 1
				set sudp(candValue) [string index $elem end]
			}
			"-k" {
				set sudp(displayCand) 1
			}
			"-l" {
				set sudp(rating) 1
				set sudp(verbosity) 1
			}
			"-m" {
				# In case the -m option has not been intercepted yet
				exitError "option '-m' must be used alone"
			}
			"-n" {
				set sudp(backtracking) 0
			}
			"-o" {
				set sudp(oneSolution) 1
			}
			"-p" {
				incr i
				if {$i < $len} {
					set sudp(probes) [lindex $args $i]
					set sudp(probing) 1
				} else {
					exitError "missing value after option '-p'"
				}
			}
			"-q" {
				set sudp(verbosity) 0
			}
			"-r" {
				set sudp(raw) 1
			}
			"-s" {
				set sudp(suggestion) 1
			}
			"-u" {
				set sudp(counting) 1
				set sudp(unicity) 1
			}
			"-v" {
				incr i
				if {$i < $len} {
					set verb [lindex $args $i]
					if {![string is integer $verb]} {
						exitError "option '-v' should have integer value"
					} else {
						set sudp(verbosity) $verb
					}
				} else {
					exitError "missing value after option '-v'"
				}
			}
			default {
				exitError "unknown option $elem"
			}
		}
	} 

	sdku::adjustOptions
	
	if {$sudp(fromFile)} {
		if {$lastarg eq ""} {
			exitError "no file specified"
		} 
		set srcfile [file normalize $lastarg]
		if {![file exists $srcfile]} {
			# Not an absolute path, look in the current directory
			set srcfile [file normalize [file join [pwd] $lastarg]]
			if {![file exists $srcfile]} {
				error "'$srcfile' no such file or directory."
			}
		} 		
		processFile $srcfile
	} elseif {$lastarg eq "-"} {
		sdku::processChannel stdin
	} else {
		processString $lastarg
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::adjustOptions" --
# 
# To test counting, this one has 202 solutions:
# sudokut -c 2.....1.......5368..17.......7.465.....9.8....983....77...3.........7..45........
# 
# ------------------------------------------------------------------------
proc sdku::adjustOptions {} {
	global sudp
	
	# If only counting solutions, set verbosity to 0
	if {$sudp(counting)} {
		set sudp(verbosity) 0
		set sudp(backtracking) 1
		# set sudp(forceCover) 1
		set sudp(incremental) 0
		set sudp(oneSolution) 0
	}
	# If only probing or suggesting, set verbosity to at least 3
	# (explanation level)
	if {$sudp(suggestion) || $sudp(probing)} {
		if {$sudp(verbosity) < 3} {
			set sudp(verbosity) 3
		} 
		set sudp(backtracking) 0
	}
	# Explanatory mode sets verbosity to at least 3
	if {$sudp(explain)} {
		if {$sudp(verbosity) < 3} {
			set sudp(verbosity) 3
		} 
	}
	# If rating the sudoku, set verbosity to 0, enable backtracking and
	# force to stop if multiple solutions are detected
	if {$sudp(rating)} {
		set sudp(backtracking) 1
		set sudp(forceCover) 0
		set sudp(unicity) 1
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::processFile" --
# 
# ------------------------------------------------------------------------
proc sdku::processFile {infile} {
	global sudp
	set sudp(fid) [open $infile]
	# Read line by line
	sdku::processChannel $sudp(fid)
	close $sudp(fid)
}


# ------------------------------------------------------------------------
# 
# "sdku::processChannel" --
# 
# ------------------------------------------------------------------------
proc sdku::processChannel {fileId} {
	set cnt 1
	set linenum 0
	# Read line by line
	while {![eof $fileId]} {
		gets $fileId line
		incr linenum
		# Ignore comments (lines starting with a diaesis) and empty lines
		if {[string range $line 0 0] eq "#" || [string length $line] == 0} {
			continue
		} 
		set msg "# Sudoku $cnt"
		if {$cnt != $linenum} {
			append msg " (line $linenum)"
		} 
		writeToLog "$msg\n" 0
		if {[catch {processString $line} res]} {
			puts $res
		} 
		incr cnt
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::processString" --
# 
# ------------------------------------------------------------------------
proc sdku::processString {sud} {
	global sudp
	
	set sud [sdku::normalize $sud]
	
	# Display the grid even if invalid
	if {$sudp(displayGrid)} {
		sdku::display $sud
		return
	}

	sdku::initSudoku $sud

	# Validity check
	set invalid [catch {sdku::checkSudoku $sud} res]
	if {$invalid} {
		if {$sudp(checkValid)} {
			puts $res
		} else {
			error $res
		}
	} else {
		if {$sudp(checkValid)} {
			puts "sudoku is valid"
		} elseif {$sudp(als)} {
			if {$sudp(verbosity) > 0} {
				sdku::displayCandidates
			} 
			sdku::displayALS
		} elseif {$sudp(displayCand)} {
			sdku::displayCandidates $sud $sudp(candValue)
		} else {
			if {$sudp(suggestion)} {
				sdku::suggest $sud
			} elseif {$sudp(probing)} {
				sdku::probe $sud
			} else {
				if {$sudp(backtracking) != 0} {
					if {!$sudp(explain) && !$sudp(rating) && $sudp(verbosity) <= 1} {
						set sudp(backtracking) 1			
						set sudp(forceCover) 1
					} 
				} 
				set initime [clock clicks -milliseconds]
				sdku::solve $sud
				if {!$sudp(rating)} {
					set millisecs [expr {([clock clicks -milliseconds] - $initime)}]
					writeToLog "Elapsed time [eval expr {$millisecs.0/1000}] seconds\n" 1
				} 
			}
		}
	}
}


# Sudoku task procs
# -----------------

# ------------------------------------------------------------------------
# 
# "sdku::solve" --
# 
# ------------------------------------------------------------------------
proc sdku::solve {sud} {
	global sudp sudso
		
	# Header
	set sudp(given) [regexp -all {[1-9]} $sud]
	if {!$sudp(rating) && !$sudp(raw)} {
		writeToLog "[sdku::grid]\n" 1
		writeToLog "$sudp(given) given values, [expr {81 - $sudp(given)}] to find\n\n" 3
	} 

	# Reductions
	if {!$sudp(forceCover)} {
		sdku::reduce
	} 
	
	# If still unsolved, execute the exact cover algorithm
	if {![sdku::isSolved]} {
		if {$sudp(backtracking) || $sudp(forceCover)} {
			global sudso
			# Update the solution array
			sdku::stringToArray $sudp(curr) sudso
			sdku::solveExactCover
		}
	} else {
		# Add to the solutions list
		if {![catch {sdku::arrayToString sudso} res]} {
			sdku::addSolution $res
		} 
	}
	
	sdku::displayResult
}


# ------------------------------------------------------------------------
# 
# "sdku::suggest" --
# 
# ------------------------------------------------------------------------
proc sdku::suggest {sud} {
	global sudp sudt
	
	variable baseList
	variable extraList
	
	# Remove the ignored techniques
	set basics [sdku::rmIgnoredTechs $baseList]
	set extras [sdku::rmIgnoredTechs $extraList]

	foreach tech [concat $basics $extras] {
		set techProc [dict get $sudt $tech proc]
		writeToBuffer "* [dict get $sudt $tech name] reduction\n" 3
		set count [$techProc]
		if {$count} {
			break
		} 
	} 
	
	if {!$count} {
		writeToBuffer "couldn't find any suggestion: backtracking is needed\n"
	} 
	
	sdku::flushBuffer
}


# ------------------------------------------------------------------------
# 
# "sdku::probe" --
# 
# ------------------------------------------------------------------------
proc sdku::probe {sud} {
	global sudp sudt

	foreach tech $sudp(probes) {
		if {$tech ni [dict keys $sudt]} {
			exitError "unknown technique code '$tech' with option '-p'"
		} 
		sdku::applyReductions $tech
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::initSudoku" --
# 
# ------------------------------------------------------------------------
proc sdku::initSudoku {sud} {
	global sudp sudso sudca
	
	# Make current
	set sudp(curr) $sud

	# Reset arrays
	set sudp(tempSol) ""
	set sudp(solCount) 0
	unset -nocomplain sudso sudca
	array unset sudp "reduc-*"
	
	# Build the array of solved cells
	sdku::stringToArray $sud sudso
	
	# Build the array of candidates
	sdku::buildCandidates $sudp(curr) sudca
}


# ------------------------------------------------------------------------
# 
# "sdku::rmIgnoredTechs" --
# 
# ------------------------------------------------------------------------
proc sdku::rmIgnoredTechs {techs} {
	global sudp
	
	set res [list]
	foreach t $techs {
		if {$t ni $sudp(ignoredCodes)} {
			lappend res $t
		} 
	} 
	
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::reduce" --
# 
# ------------------------------------------------------------------------
proc sdku::reduce {} {
	global sudp sudt
	
	variable baseList
	variable extraList
	
	# Remove the ignored techniques
	set basics [sdku::rmIgnoredTechs $baseList]
	set extras [sdku::rmIgnoredTechs $extraList]
	
	if {[llength $basics] == 0 && [llength $extras] == 0} {
		return
	} 
	
	# Apply the basic reduction techniques
	if {[llength $basics] > 0} {
		sdku::applyReductions $basics
	} 
	
	# Add one reduction technique at a time
	if {![sdku::isSolved] && $sudp(incremental)} {
		set currList $basics
		foreach tech $extras {
			writeToLog "** Adding [dict get $sudt $tech name] reduction technique\n" 2
			lappend currList $tech
			sdku::applyReductions $currList $tech
			if {[sdku::isSolved]} {
				break
			} 
		} 
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::applyReductions" --
# 
# ------------------------------------------------------------------------
proc sdku::applyReductions { {codeList ""} {start ""} } {
	global sudp sudt

	if {$start eq ""} {
		set start [lindex $codeList 0] 
	} 
	
	# Reorder the techniques from the start
	set idx [lsearch $codeList $start]
	set codeList [concat [lrange $codeList $idx end] [lrange $codeList 0 [expr $idx-1]]]
	
	set found 1
	while {$found} {
		set count 0
		foreach tech $codeList {
			if {![sdku::isSolved]} {
				set sudp(currTech) $tech
				set techProc [dict get $sudt $tech proc]
				sdku::emptyBuffer
				writeToBuffer "* [dict get $sudt $tech name] reduction\n" 2
				set removed [$techProc]
				if {$removed} {
					sdku::flushBuffer
					if {$tech ne "ns" && !$sudp(suggestion) && !$sudp(probing)} {
						# Update the candidates array and check for new
						# naked singles
						sdku::updateCandidates
						sdku::applyReductions ns						
					} 
				} else {
					sdku::emptyBuffer
				}
				incr count $removed
			} 
		}
		if {!$sudp(suggestion) && !$sudp(probing)} {
			set found [expr {$count > 0}]
		} else {
			set found 0
		}		
	}
	
	return $count
}


# Reduction procs
# ===============

# ------------------------------------------------------------------------
# 
# "sdku::nakedSingleReduction" --
# 
# Naked single reduction
# It is often the case that a cell can only possibly take a single value,
# when the contents of the other cells in the same row, column and block are
# considered.
# Example:
# sud=...3..8..64.8...5.875.....15...7.2.6....9....2.9.8...54.....769.2...8.13..7..5...
# sudokut -p ns $sud
# 
# ------------------------------------------------------------------------
proc sdku::nakedSingleReduction {} {
	global sudp sudca

	set count 0
	while {1} {
		set subcount 0
		foreach cell [lsort [array names sudca]] {
			set solved [sdku::checkSolveCell $cell 1]
			if {$solved && ($sudp(suggestion) || $sudp(probing))} {
				return 1
			}
			incr subcount $solved
		} 
		if {$subcount} {
			sdku::adjustCount count $subcount
			sdku::updateCandidates
		} else {
			break
		}		
	}

	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::hiddenSingleReduction" --
# 
# Hidden single reduction
# If a cell is the only one in a row, column or block that can take a
# particular value, then it must have that value.
# Note that the [info exists sudca] is needed because, in the case of
# impossible sudokus, different values go to an unique cell, so sudca will
# have been unset for the first value and will throw an error with
# the following ones.
# Example:
# sud=...3..8..64.8...5.875.....15...7.2.6....9....2.9.8...54.....769.2...8.13..7..5...
# sudokut -p hs $sud
# 
# ------------------------------------------------------------------------
proc sdku::hiddenSingleReduction {} {
	global sudp sudca 

	set count 0
	set addList [list]
	for {set k 0} {$k < 3} {incr k} {
		for {set i 0} {$i < 9} {incr i} {
			set indices [getIndicesForUnit $i $sudp($k)]
			foreach idx $indices {
				if {![info exists sudca($idx)]} {
					continue
				} 
				foreach v $sudca($idx) {
					ensureSetArray temp $v $idx
				}
			}

			foreach v [array names temp] {
				if {[llength $temp($v)] == 1} {
					set cell [lindex $temp($v) 0]
					if {[info exists sudca($cell)]} {
						writeToBuffer "Cell [printPosForKey $temp($v)] alone in $sudp($k) [expr {$i+1}] can have value $v\n" 3
						writeToBuffer "\tinsert value $v at position [printPosForKey $temp($v)]\n" 3
						incr count
						lappend addList [list $v $temp($v)]
						if {$sudp(rating)} {
							set len [llength $sudca($cell)]
							updateRating $len
						}
					} 
				} 
			}
			unset -nocomplain temp
		}
	}
	
	if {[llength $addList] > 0} {
		foreach pair [lsort -unique $addList] {
			sdku::solveCellWithValue [lindex $pair 0] [lindex $pair 1]
		} 
	} 

	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::blockToRowColReduction" --
# 
# Block to row/col reduction
# When you examine a block, if a certain value must be in a specific row
# or column of this block, then you can eliminate this candidate value  
# from the cells of the other blocks in the same row or column.
# Example:
# sud=...3..8..64.8...5.875.....15...7.2.6....9....2.9.8...54.....769.2...8.13..7..5...
# sudokut -p br $sud
# 
# ------------------------------------------------------------------------
proc sdku::blockToRowColReduction {} {
	global sudp sudca
	set count 0
	
	for {set b 0} {$b < 9} {incr b} {
		set indices [getIndicesForUnit $b "block"]
		
		# Handle successively rows (k=0) and columns (k=1)
		for {set k 0} {$k < 2} {incr k} {
			unset -nocomplain temp
			foreach idx $indices {
				# Build an array mapping the values to the units where this
				# value appears as a candidate
				if {![info exists sudca($idx)]} {
					continue
				} 
				foreach v $sudca($idx) {
					ensureSetArray temp $v [string index $idx $k]
				}
			}
			# Look for unique units
			foreach v [array names temp] {
				set temp($v) [lsort -unique $temp($v)]
				if {[llength $temp($v)] == 1} {
					set msg "Value $v for block [expr {$b + 1}] can only be in $sudp($k) [expr {$temp($v) + 1}]\n"
					writeToBuffer $msg 3
					set subcount [sdku::removeFromUnitInOtherBlocks $v $k $temp($v) $b]
					sdku::adjustCount count $subcount
				}
				if {$count} {
					return $count
				}
			}
		}
	} 
	
	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::blockToBlockReduction" --
# 
# Block to block reduction
# If a number appears as candidate for only two cells in two different
# blocks, but both cells are in the same row or column, it is possible to
# remove that number as a candidate from the cells of the other block in
# that column or row.
# Example:
# sud=.....39483.9..85....4.....25..9.......7.1.6.......7..1692...1..4387..2.91753.....
# sudokut -p bb $sud
# 
# ------------------------------------------------------------------------
proc sdku::blockToBlockReduction {} {
	global sudca sudp
	
	set count 0
	set rmList [list]
	for {set b 0} {$b < 9} {incr b} {
		set indices [getIndicesForUnit $b "block"]
		# Build 9 value/cells arrays
		foreach idx $indices {
			if {![info exists sudca($idx)]} {
				continue
			} 
			foreach v $sudca($idx) {
				ensureSetArray temp$b $v $idx
			}
		}
	}

	for {set b1 0} {$b1 < 9} {incr b1} {
		for {set b2 [expr {$b1 + 1}]} {$b2 < 9} {incr b2} {
			# Check relative position of blocks: on same horizontal
			# (dir=0) or vertical (dir=1)
			if {[expr {$b1 / 3}] == [expr {$b2 / 3}]} {
				set dir 0
			} elseif {[expr {$b1 % 3}] == [expr {$b2 % 3}]} {
				set dir 1
			} else {
				continue
			}
			
			for {set v 1} {$v <= 9} {incr v} {
				if {[info exists temp${b1}($v)] && [info exists temp${b2}($v)] 
					  && [llength [set temp${b1}($v)]] == 2 
					  && [llength [set temp${b2}($v)]] == 2 } {
					# a and c are row (or col) indices in block 1 
					# b and d are row (or col) indices in block 2
					set a [string index [lindex [set temp${b1}($v)] 0] $dir]
					set b [string index [lindex [set temp${b2}($v)] 0] $dir]
					set c [string index [lindex [set temp${b1}($v)] 1] $dir]
					set d [string index [lindex [set temp${b2}($v)] 1] $dir]
					
					# Make sure they are ordered a<c and b<d
					if {$a > $c} {
						set t $a
						set c $a
						set a $t
					} 
					if {$b > $d} {
						set t $b
						set d $b
						set b $t
					} 
					
					if {$a == $b && $c == $d} {
						if {$dir} {
							set b3 [expr {(2*$b2 - $b1) % 9}]					
						} else {
							set b3 [expr {$b1/3*3 + ((2*$b2 - $b1) % 3)}]
						}
						set msg "Only two cells for value $v in $sudp($dir)s "
						append msg "[expr {$a + 1}] and [expr {$c + 1}] of blocks [expr {$b1 + 1}] and [expr {$b2 + 1}]\n" 
						if {![sdku::valueExistsInBlock $b3 $v]} {
							append msg "\tcandidate $v can be removed from $sudp($dir)s [expr {$a + 1}] and [expr {$c + 1}] " 
							append msg "in block [expr {$b3 + 1}]\n" 
						} 
						set subcount 0

						# Remove candidate v from third block in same rows or cols
						if {[info exists temp${b3}($v)]} {
							foreach cell [set temp${b3}($v)] {
								if {[string index $cell $dir] == $a || [string index $cell $dir] == $c} {
									incr subcount 
									lappend rmList [list $v $cell]
								} 
							} 
						} 
						sdku::adjustCount count $subcount
						if {$subcount} {
							writeToBuffer $msg 3
						}
					} 
				} 
			}
		}
	}

	sdku::removeCandidatesInList $rmList
	
	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::nakedPairReduction" --
# 
# Naked pair
# Example:
# sud=.....39483.9..85....4.....25..9.......7.1.6.......7..1692...1..4387..2.91753.....
# sudokut -p np $sud
# 
# ------------------------------------------------------------------------
proc sdku::nakedPairReduction {} {
	return [sdku::nakedReduction 2]
}


# ------------------------------------------------------------------------
# 
# "sdku::nakedTripletReduction" --
# 
# Naked triplet
# Example:
# sud=.....39483.9..85....4.....25..9.......7.1.6.......7..1692...1..4387..2.91753.....
# sudokut -p nt $sud
# 
# ------------------------------------------------------------------------
proc sdku::nakedTripletReduction {} {
	return [sdku::nakedReduction 3]
}


# ------------------------------------------------------------------------
# 
# "sdku::nakedQuadrupletReduction" --
# 
# Naked quadruplet
# Example:
# sud=.9.8.24..62.3......7..6..528.7..32.93.2.8....9..62...773..9..2.28..4......9238...
# sudokut -p nq $sud
# 
# ------------------------------------------------------------------------
proc sdku::nakedQuadrupletReduction {} {
	return [sdku::nakedReduction 4]
}


# ------------------------------------------------------------------------
# 
# "sdku::hiddenPairReduction" --
# 
# Hidden pair
# Example:
# sud=.....39483.9..85....4.....25..9.......7.1.6.......7..1692...1..4387..2.91753.....
# sudokut -p hp $sud
# 
# ------------------------------------------------------------------------
proc sdku::hiddenPairReduction {} {
	return [sdku::hiddenReduction 2]
}


# ------------------------------------------------------------------------
# 
# "sdku::hiddenTripletReduction" --
# 
# Hidden triplet
# Example:
# sud=3179.648096......1....1.9.6...6.....6.91.2...7523..169.98.6..155..8..6....6...89.
# sudokut -p ht $sud
# NB: this example has 10 solutiolns
# 
# ------------------------------------------------------------------------
proc sdku::hiddenTripletReduction {} {
	return [sdku::hiddenReduction 3]
}


# ------------------------------------------------------------------------
# 
# "sdku::hiddenQuadrupletReduction" --
# 
# Hidden quadruplet
# Example:
# sud=249.6...3.3....2..8.......5.....6......2......1..4.82..9.5..7.4..4.....1.7...3...
# sudokut -p hq $sud
# 
# ------------------------------------------------------------------------
proc sdku::hiddenQuadrupletReduction {} {
	return [sdku::hiddenReduction 4]
}


# ------------------------------------------------------------------------
# 
# "sdku::nakedReduction" --
# 
# If N cells in the same row, column or block have only the same N
# candidates, then those candidates can be removed from the candidates of
# the other cells in that row, column or block.
# 
# ------------------------------------------------------------------------
proc sdku::nakedReduction {N} {
	global sudp sudca
	
	set count 0
	set rmList [list]
	# Handle successively rows (u=0), columns (u=1), and blocks (u=2)
	for {set u 0} {$u < 3} {incr u} {
		for {set i 0} {$i < 9} {incr i} {
			set indices [getIndicesForUnit $i $sudp($u)]
			set unsolved [sdku::getUnsolvedInList $indices]
			if {[llength $unsolved] <= $N} {
				continue
			} 
			set combList [sdku::buildCombinations $unsolved $N]
			
			foreach comb $combList {
				set merge [list]
				foreach cell $comb {
					set merge [concat $merge $sudca($cell)]
				} 
				set vals [lsort -unique $merge]
				if {[llength $vals] == $N} {
					set msg "Cells [sdku::printCells $comb] "
					append msg "in $sudp($u) [expr {$i + 1}] "
					append msg "have only the same $N values [join $vals ","]:\n"
					set subcount 0
					foreach v $vals {
						set others [list]
						foreach cell $unsolved {
							if {($cell ni $comb) && ($v in $sudca($cell))} {
								incr subcount 
								lappend others $cell
								lappend rmList [list $v $cell]
							} 
						} 
						if {[llength $others]} {
							append msg "  value $v can be removed from [sdku::printCells $others]\n"
						} 
					} 
					if {$subcount} {
						writeToBuffer $msg 3
						sdku::adjustCount count $subcount
					} 
				} 
			} 
		}
	} 
	
	sdku::removeCandidatesInList $rmList

	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::hiddenReduction" --
# 
# If there are N cells, with N candidates between them that don't appear
# elsewhere in the same row, column or block, then any other candidates for
# those cells can be eliminated.
# 
# ------------------------------------------------------------------------
proc sdku::hiddenReduction {N} {
	global sudp sudca
	
	set count 0
	set rmList [list]
	# Handle successively rows (u=0), columns (u=1), and blocks (u=2)
	for {set u 0} {$u < 3} {incr u} {
		for {set i 0} {$i < 9} {incr i} {
			# Build a value/cells array
			unset -nocomplain temp
			set indices [getIndicesForUnit $i $sudp($u)]
			
			foreach idx $indices {
				if {![info exists sudca($idx)]} {
					continue
				} 
				foreach v $sudca($idx) {
					ensureSetArray temp $v $idx
				}
			}
			
			if {[array size temp] <= $N} {
				continue
			} 
			
			set vals [list]
			foreach v [array names temp] {
				if {[llength $temp($v)] == $N} {
					lappend vals $v
				} 
			} 
			
			set combList [sdku::buildCombinations $vals $N]
			foreach comb $combList {
				set found 1
				set v1 [lindex $comb 0]
				for {set k 1} {$k < $N} {incr k} {
					set v2 [lindex $comb $k]
					if {$temp($v1) != $temp($v2)} {
						set found 0
						break
					} 
				}
				if {$found} {
					set subcount 0
					set msg "Cells [sdku::printCells $temp($v1)] "
					append msg "alone in $sudp($u) [expr {$i + 1}] "
					append msg "share values [join $vals ","]\n"
					foreach cell [set temp($v1)] {
						if {[info exists sudca($cell)]} {
							foreach val $sudca($cell) {
								if {$val ni $comb} {
									incr subcount 
									lappend rmList [list $val $cell]
								} 
							} 
						} 
					} 
					if {$subcount} {
						writeToBuffer $msg 3
						sdku::adjustCount count $subcount
					} 
				} 
			}
		}
	} 
	
	sdku::removeCandidatesInList $rmList
	
	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::xwingReduction" --
# 
# X-Wing reduction
# When two rows (resp columns) have the same candidate only in the same two
# columns (resp rows), these candidates can be eliminated for the remaining
# cells of the columns (resp rows).
# Example:
# sud=.41729.3.769..34.2.3264.7194.39..17.6.7..49.319537..24214567398376.9.541958431267
# sud=98..62753.65..3...327.5...679..3.5...5...9...832.45..9673591428249.87..5518.2...7
# sud=7...6......3..1.8..2.7..6....8....4.1.......3.9....2....6..8.1..5.2..7......7...8
# sudokut -p xw $sud
# 
# ------------------------------------------------------------------------
proc sdku::xwingReduction {} {
	return [sdku::fishReduction 2]
}


# ------------------------------------------------------------------------
# 
# "sdku::swordfishReduction" --
# 
# Swordfish reduction
# When three rows (resp columns) have the same candidate three times at
# most and only in the same three columns (resp rows), these candidates can
# be eliminated for the remaining cells of the columns (resp rows).
# Example:
# sud=...2.3.4.8.14.9..3.4....96.4....6....1..4..9....9..4.7.58..4.7.2....51.4.743.2...
# sud=16.543.7..786.14354358.76.172.458.696..912.57...376..4.16.3..4.3...8..16..71645.3
# sud=1.85..2345..3.2178...8..5698..6.5793..59..4813....865298.2.631.......8.....78.9..
# sudokut -p sf $sud
# 
# ------------------------------------------------------------------------
proc sdku::swordfishReduction {} {
	return [sdku::fishReduction 3]
}


# ------------------------------------------------------------------------
# 
# "sdku::jellyfishReduction" --
# 
# Jellyfish reduction
# When four rows (resp columns) have the same candidate four times at
# most and only in the same four columns (resp rows), these candidates can
# be eliminated for the remaining cells of the columns (resp rows).
# Example:
# sud=2.......3.8..3..5...34.21....12.54......9......93.86....25.69...9..2..7.4.......1
# sud=2.41.358.....2.3411.34856..732954168..5.1.9..6198324....15.82..3..24.....263....4
# sud=2.....1.......5368..17.......7.465.....9.8....983....77...3....8....7..45........
# sud=..........12..3..4.45..6..3....3..1....7..8...94..5..2....1.9.....5...6..53..4..1
# sudokut -p jf $sud
# 
# ------------------------------------------------------------------------
proc sdku::jellyfishReduction {} {
	return [sdku::fishReduction 4]
}


# ------------------------------------------------------------------------
# 
# "sdku::squirmbagReduction" --
# Example:
# sud=2.....1.......5368..17.......7.465.....9.8....983....77...3....8....7..45........
# sud=..........98..7..6.54..3..2....1..4....5..8...29..4..7....6.9.....3...8..86..2..3
# This one has 3 squirmbags:
# sud=1....23...3..1......45....6..6.....7.8.....5.3.....2..2....81......7..4...76....5
# sudokut -p sb $sud
# 
# ------------------------------------------------------------------------
proc sdku::squirmbagReduction {} {
	return [sdku::fishReduction 5]
}


# ------------------------------------------------------------------------
# 
# "sdku::whaleReduction" --
# Example:
# sud=2....358.....2...1...4.56.....9.4.68..5.1.9..61.8.2.....15.8...3...4.....263....4
# sud=.......215...4.......6......31....8.....7.....2.......6..3..4..4.5...7.....2.....
# sud=.......21.9.3.........6....2.1....5.5..4........97....6....2....8....3........9..
# sud=.......21.5..3.......8.....1.2....7.7..3........54....6....2....3....4........5..
# sud=.......182..4............7......8..3...5..2...1.......5.2...6......4.3......17...
# This one has 2 whales:
# sud=......3.24..5........4..1...18...2.....6.9....3.......6......57....1...........9.
# sudokut -p wh $sud
# 
# ------------------------------------------------------------------------
proc sdku::whaleReduction {} {
	return [sdku::fishReduction 6]
}


# ------------------------------------------------------------------------
# 
# "sdku::leviathanReduction" --
# 
# ------------------------------------------------------------------------
proc sdku::leviathanReduction {} {
	return [sdku::fishReduction 7]
}


# ------------------------------------------------------------------------
# 
# "sdku::fishReduction" --
# 
# Implement fish reductions of size 2 to 7.
# Fish sizes are
#     2: X-Wing
#     3: Swordfish
#     4: Jellyfish
#     5: Squirmbag
#     6: Whale
#     7: Leviathan
# 
# ------------------------------------------------------------------------
proc sdku::fishReduction {N} {
	global sudp sudca sudt
	
	set M 2
	set count 0
	set reduceList [list]

	# Handle successively rows (u=0) and columns (u=1) as base unit
	for {set u 0} {$u < 2} {incr u} {
		# Build a unit u, build an array whose keys are the possible values 
		for {set i 0} {$i < 9} {incr i} {
			unset -nocomplain temp$i
			
			set indices [getIndicesForUnit $i $sudp($u)]
			foreach idx $indices {
				if {![info exists sudca($idx)]} {
					continue
				} 
				foreach v $sudca($idx) {
					ensureSetArray temp$i $v [string index $idx [expr {1 - $u}]]
				}
			}
		}
		
		# Try all values
		for {set v 1} {$v <= 9} {incr v} {
			# Find the units containing N-1 or N values
			set units [list]
			for {set i 0} {$i < 9} {incr i} {
				if {[info exists temp${i}($v)] && [llength [set temp${i}($v)]] >= 2 && [llength [set temp${i}($v)]] <= $N} {
					lappend units $i
				}
			}
			
			set combList [sdku::buildCombinations $units $N]
			foreach comb $combList {
				unset -nocomplain sum				
				foreach uidx $comb {
					# Count the number of base values in the cover units
					foreach vidx [set temp${uidx}($v)] {
						if {![info exists sum($vidx)]} {
							set sum($vidx) 1
						} else {
							incr sum($vidx)
						} 
					} 
				} 
				
				if {[array size sum] == $N} {
					set ok 1
					foreach w [array names sum] {
						if {$sum($w) < 2} {
							set ok 0
							break
						} 
					} 
					if {$ok} {
						lappend reduceList [list $v $u $comb [lsort [array names sum]]]
					} 
				} 
			} 
		}
	} 
	
	if {[llength $reduceList] > 0} {
		foreach item [lsort -unique $reduceList] {
			incr count [sdku::reduceFish [lindex $item 0] [lindex $item 1] [lindex $item 2] [lindex $item 3]]
		} 
	} 
	
	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::xywingReduction" --
# 
# XY-Wing reduction
# If a cell containing XY sees two cells containing respectively XZ and YZ,
# then any cell which sees these two cells can't have the value Z, so it
# can be removed.
# Example:
# sud=.93862..1614573289...914.3.9.138...5.5.1493.83..25.19.875.319.2462795813139.2875.
# sudokut -p xyw $sud
#     L1C8: 4 7-L3C9: 6 7-L7C8: 4 6 - vals: 4 6 7
# 
# ------------------------------------------------------------------------
proc sdku::xywingReduction {} {
	global sudp sudca
	set count 0
	
	# Build a list of the cells containing two values
	set cellsList [list]
	set allCells [array names sudca]
	foreach key $allCells {
		if {[llength $sudca($key)] == 2} {
			lappend cellsList $key
		} 
	} 
	set cellsList [lsort $cellsList]
	
	# Examine the triplets of such cells
	set rmList [list]
	set len [llength $cellsList]
	set num 1
	for {set i 0} {$i < $len} {incr i} {
		set c0 [lindex $cellsList $i]
		for {set j [expr $i+1]} {$j < $len} {incr j} {
			set c1 [lindex $cellsList $j]
			for {set k [expr $j+1]} {$k < $len} {incr k} {
				set c2 [lindex $cellsList $k]
				
				set vals [lsort -unique [concat $sudca($c0) $sudca($c1) $sudca($c2)]]
				
				if {[llength $vals] == 3 } {
					set w0 [join $sudca($c0) ""]
					set w1 [join $sudca($c1) ""]
					set w2 [join $sudca($c2) ""]
					if {$w0 != $w1 && $w1 != $w2 && $w2 != $w0} {
						if {![sdku::inSameUnitOfKind 0 [list $c0 $c1 $c2]]
							&& ![sdku::inSameUnitOfKind 1 [list $c0 $c1 $c2]]} {
							for {set n 0} {$n < 3} {incr n} {
								set k0 [set c$n]
								set k1 [set c[expr ($n+1)%3]]
								set k2 [set c[expr ($n+2)%3]]
								if {[sdku::seeEachOther $k0 $k1] && [sdku::seeEachOther $k0 $k2]} {
									
									# Find the z-value
									foreach v $sudca($k1) {
										set z $v
										if {$v ni $sudca($k0)} {
											break
										} 
									} 
									# Find cells which contain the z-value and can see k1 and k2
									foreach key $allCells {
										if {$z in $sudca($key) 
										&& $key != $k1 && $key != $k2
										&& [sdku::seeEachOther $key $k1] && [sdku::seeEachOther $key $k2]} {
											set msg "[sdku::printPosForKey ${k0}] (values [join $sudca($k0) ","]) "
											append msg "can see [sdku::printPosForKey ${k1}] (values [join $sudca($k1) ","]) "
											append msg "and [sdku::printPosForKey ${k2}] (values [join $sudca($k2) ","])\n"
											writeToBuffer $msg 3
											sdku::adjustCount count 1
											if {$count} {
												sdku::removeCandidateFromCell $z $key 
												return $count
											} 
											lappend rmList [list $z $key]
										} 
									} 
								} 					
							}							
						} 
					} 
				} 
			}
		}
	}
	
	sdku::removeCandidatesInList $rmList
		
	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::displayALS" --
# 
# Almost Locked Sets
# Almost locked sets are sets of n cells containing (n+1) candidate values.
# Display almost locked sets present in various units.
# Example:
# sud=1..5.6....5279.14..8.4.175.5..1...74.....5...86...45.1495612387....5741....34...5
# Difficult:
# sud=.....7.95.....1...86..2.....2..73..85......6...3..49..3.5...41724................
# sudokut -a $sud
# 
# ------------------------------------------------------------------------
proc sdku::displayALS {} {
	global sudp sudca alsdict
	set count 0
	
	###set initime [clock clicks -milliseconds]
	# Rebuild the ALS dictionary
	unset -nocomplain alsdict
	sdku::buildALS
	
	if {$sudp(verbosity) == 0} {
		set prefix ""
	} else {
		set prefix "ALS in "
	}
	
	foreach comb [lsort [dict keys $alsdict]] {
		sdku::writeToLog "$prefix[sdku::printCells $comb]: [join [dict get $alsdict $comb vals] ""]\n" 0							
	} 
	sdku::writeToLog "found [dict size $alsdict] ALS\n" 
	###set millisecs [expr {([clock clicks -milliseconds] - $initime)}]
	###writeToLog "Elapsed time [eval expr {$millisecs.0/1000}] seconds\n" 4
	return
}


# ------------------------------------------------------------------------
# 
# "sdku::alsxzReduction" --
# 
# ALS-XZ reduction
# ALS-XZ are pairs of almost locked sets with an exclusive common
# candidate (ECC) and another common value (OCC). The OCC can be removed
# from any external cell which sees all the OCCs in both ALSs.
# Example:
# sud=1..5.6....5279.14..8.4.175.5..1...74.....5...86...45.1495612387....5741....34...5
# sudokut -p alsxz $sud
# 
# ------------------------------------------------------------------------
proc sdku::alsxzReduction {} {
	global sudp sudca alsdict
	set count 0
	
	# Rebuild the ALS dictionary
	unset -nocomplain alsdict
	sdku::buildALS
	
	set combsList [dict keys $alsdict]
	set clen [llength $combsList]
	set rmList [list]
	
	for {set i 0} {$i < $clen} {incr i} {
		set als1 [lindex $combsList $i]
		set eccs1 [list]
		set cells1 [list]
		foreach ecc [dict get $alsdict $als1 eccs] {
			lappend eccs1 [string index $ecc 0]
			lappend cells1 [string range $ecc 1 2]
		} 
		for {set j [expr $i+1]} {$j < $clen} {incr j} {
			set als2 [lindex $combsList $j]
			# The ALS must not intersect
			if {[sdku::intersect $als1 $als2]} {
				continue
			} 
			set eccs2 [list]
			set cells2 [list]
			foreach ecc [dict get $alsdict $als2 eccs] {
				lappend eccs2 [string index $ecc 0]
				lappend cells2 [string range $ecc 1 2]
			} 

			for {set k1 0} {$k1 < [llength $eccs1]} {incr k1} {
				for {set k2 0} {$k2 < [llength $eccs2]} {incr k2} {
					if {[lindex $eccs1 $k1] == [lindex $eccs2 $k2]} {
						if {([lindex $cells1 $k1] != [lindex $cells2 $k2]) && [sdku::seeEachOther [lindex $cells1 $k1] [lindex $cells2 $k2]]} {
							set occs [sdku::commonExcept [dict get $alsdict $als1 vals] [dict get $alsdict $als2 vals] [lindex $eccs1 $k1]]
							if {[llength $occs]} {
								set union [concat $als1 $als2]
								foreach o $occs {
									set found 0
									foreach key [sdku::otherCellsForValue $o $union] {
										if {[sdku::seeValueInCells $key $o $union]} {
											incr found
											if {$found == 1} {
												writeToBuffer "Found 2 almost locked sets (ALS):\n" 3
												writeToBuffer "  [sdku::printCells $als1]: [join [dict get $alsdict $als1 vals] ""]\n" 3
												writeToBuffer "  [sdku::printCells $als2]: [join [dict get $alsdict $als2 vals] ""]\n" 3
												writeToBuffer "\twith exclusive common candidate (ECC)=[lindex $eccs1 $k1] in [printPosForKey [lindex $cells1 $k1]] and [printPosForKey [lindex $cells2 $k2]]\n" 3
												writeToBuffer "\tother common candidates: [join $occs ","]\n" 3
											} 
											writeToBuffer "\t-> remove value $o from [printPosForKey $key]\n" 3
											sdku::adjustCount count 1
											if {$sudp(suggestion)} {
												sdku::removeCandidateFromCell $o $key 0
												return $count
											} else {
												lappend rmList [list $o $key]
											}
										} 
									} 
								} 
							} 
						} 
					} 
				}
			}
		}
	}

	sdku::removeCandidatesInList $rmList

	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::alsxywingReduction" --
# 
# ALS-XY-Wing reduction
# 
# ALS-XY-Wing is based on triplets of almost locked sets (ALS) with two
# exclusive common candidates (ECC) and an other common value (OCC). Say ALS
# A has an ECC with ALS C, and ALS B also has an ECC with C (both ECCs must
# be different). The OCC can be removed from any external cell which sees
# all the OCCs in ALSs A and B.
# 
# Example:
# sud=..25.........8..5285...2.1...98.63..38.....46..54.31...7.6...3443..9.........47..
# sud=..25....3....8..5285...2.1.1498.63..387....46..54731...7.6...3443..9........347..
# sudokut -p alsxyw $sud
# 
# ------------------------------------------------------------------------
proc sdku::alsxywingReduction {} {
	global sudp sudca alsdict
	set count 0
	
	# Rebuild the ALS dictionary
	unset -nocomplain alsdict
	sdku::buildALS
	set combsList [dict keys $alsdict]
	set clen [llength $combsList]
	set rmList [list]

	for {set i 0} {$i < $clen} {incr i} {
		# ALS A
		set alsA [lindex $combsList $i]
		set eccsA [list]
		set cellsA [list]
		foreach ecc [dict get $alsdict $alsA eccs] {
			lappend eccsA [string index $ecc 0]
			lappend cellsA [string range $ecc 1 2]
		} 
		for {set j [expr $i+1]} {$j < $clen} {incr j} {
			# ALS B differs from A but A and B are interchangeable, so we start from j=i+1
			set alsB [lindex $combsList $j]
			# The ALS must not intersect
			if {[sdku::intersect $alsA $alsB]} {
				continue
			} 
			set eccsB [list]
			set cellsB [list]
			foreach ecc [dict get $alsdict $alsB eccs] {
				lappend eccsB [string index $ecc 0]
				lappend cellsB [string range $ecc 1 2]
			} 
			for {set k 0} {$k < $clen} {incr k} {
				# ALS C is any ALS different from A and B, so we start from k=0
				if {$k == $i || $k == $j} {
					continue
				} 
				set alsC [lindex $combsList $k]
				# The ALS must not intersect
				if {[sdku::intersect $alsA $alsC] || [sdku::intersect $alsB $alsC]} {
					continue
				} 
				set eccsC [list]
				set cellsC [list]
				foreach ecc [dict get $alsdict $alsC eccs] {
					lappend eccsC [string index $ecc 0]
					lappend cellsC [string range $ecc 1 2]
				} 
			
				# ALS C must provide two different eccs
				if {[llength $eccsC] < 2} {
					continue
				} 
				
				# Find an ECC between A and C, and a different one between B and C
				for {set a 0} {$a < [llength $eccsA]} {incr a} {
					for {set c1 0} {$c1 < [llength $eccsC]} {incr c1} {
						if {[lindex $eccsA $a] == [lindex $eccsC $c1]} {
							# A and C share a unique value. Make sure it is mutually exclusive.
							if {([lindex $cellsA $a] != [lindex $cellsC $c1]) && [sdku::seeEachOther [lindex $cellsA $a] [lindex $cellsC $c1]]} {
								for {set b 0} {$b < [llength $eccsB]} {incr b} {
									for {set c2 0} {$c2 < [llength $eccsC]} {incr c2} {
										if {$c1 == $c2} {
											continue
										} 
										if {[lindex $eccsB $b] == [lindex $eccsC $c2]} {
											# B and C share a unique value. Make sure it is mutually exclusive.
											if {([lindex $cellsB $b] != [lindex $cellsC $c2]) && [sdku::seeEachOther [lindex $cellsB $b] [lindex $cellsC $c2]]} {
												set occs [sdku::commonExcept [dict get $alsdict $alsA vals] [dict get $alsdict $alsB vals] [list [lindex $eccsA $a] [lindex $eccsB $b]]]
												if {[llength $occs]} {
													set union [concat $alsA $alsB]
													foreach o $occs {
														set found 0
														foreach key [sdku::otherCellsForValue $o $union] {
															if {[sdku::seeValueInCells $key $o $union]} {
																incr found
																if {$found == 1} {
																	writeToBuffer "Found 3 almost locked sets (ALS):\n" 3
																	writeToBuffer "  A- [sdku::printCells $alsA]: [join [dict get $alsdict $alsA vals] ""]\n" 3
																	writeToBuffer "  B- [sdku::printCells $alsB]: [join [dict get $alsdict $alsB vals] ""]\n" 3
																	writeToBuffer "  C- [sdku::printCells $alsC]: [join [dict get $alsdict $alsC vals] ""]\n" 3
																	writeToBuffer "\twith exclusive common candidate (ECC)\n" 3
																	writeToBuffer "\t\tbetween A and C=[lindex $eccsA $a] in [printPosForKey [lindex $cellsA $a]] and [printPosForKey [lindex $cellsC $c1]]\n" 3
																	writeToBuffer "\t\tbetween B and C=[lindex $eccsB $b] in [printPosForKey [lindex $cellsB $b]] and [printPosForKey [lindex $cellsC $c2]]\n" 3
																	writeToBuffer "\tother common candidates: [join $occs ","]\n" 3
																} 
																writeToBuffer "\t-> remove value $o from [printPosForKey $key]\n" 3
																sdku::adjustCount count 1
																if {$sudp(suggestion)} {
																	sdku::removeCandidateFromCell $o $key 0
																	return $count
																} else {
																	lappend rmList [list $o $key]
																}
															} 
														} 
													} 
												} 
											}
										}
									}
								}
							} 
						} 
					}
				}
			}
		}
	}

	sdku::removeCandidatesInList $rmList

	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::otherCellsForValue" --
# 
# ------------------------------------------------------------------------
proc sdku::otherCellsForValue {v l} {
	global sudca
	set res [list]
	foreach key [array names sudca] {
		if {$v in $sudca($key) && $key ni $l} {
			lappend res $key
		} 
	} 
	return [lsort $res]
}


# ------------------------------------------------------------------------
# 
# "sdku::seeValueInCells" --
# 
# ------------------------------------------------------------------------
proc sdku::seeValueInCells {c v l} {
	global sudca
	set ok 1
	foreach k $l {
		if {$v ni $sudca($k)} {
			continue
		} 
		if {![sdku::seeEachOther $c $k]} {
			set ok 0
			break
		} 
	} 
	return $ok
}


# ------------------------------------------------------------------------
# 
# "sdku::printCells" --
# 
# ------------------------------------------------------------------------
proc sdku::printCells {cells} {
	set rows [list]
	set cols [list]
	set res [list]
	foreach itm $cells {
		lappend rows [string index $itm 0]
		lappend cols [string index $itm 1]
	} 
	set rows [lsort -unique $rows]
	set cols [lsort -unique $cols]
	if {[llength $rows] <= [llength $cols]} {
		foreach r $rows {
			set sub "L[expr $r +1]C"
			foreach pos $cells {
				if {[string index $pos 0] == $r} {
					append sub [expr [string index $pos 1]+1]
				} 
			} 
			lappend res $sub
		} 
	} else {
		foreach c $cols {
			set lines "L"
			foreach pos $cells {
				if {[string index $pos 1] == $c} {
					append lines [expr [string index $pos 0]+1]
				} 
			} 
			lappend res "${lines}C[expr $c +1]"
		} 
	} 
	return [join $res "-"]
}


# ------------------------------------------------------------------------
# 
# "sdku::buildALS" --
# 
# Build a dictionary where the ALS (cell combinations) are the keys and
# each key has two subkeys associated: 'vals' which is the list of the
# values contained in the ALS and 'eccs' is a list of potential exclusive
# commons. Each element of the 'eccs' list is stored as a three-digit
# string "erc" where "e" is the value of the ECC, "r" the row and "c" the
# column.
# For instance, an entry of the dictionary looks like this:
#     {64 65 73 83 84} {vals {1 2 3 5 7 8} eccs {865 773}}
# Here the five cells 64, 65, 73, 83, 84 share the six values 1, 2, 3, 5,
# 7, 8 and there are two candidate eccs: 8 in cell 65 and 7 in cell 73.
# ------------------------------------------------------------------------
proc sdku::buildALS {} {
	global sudp sudca alsdict
	set total 0

	writeToLog "start building the array of almost locked sets (ALS)...\n" 4
	set alsdict [dict create]
	# Handle successively rows (u=0), columns (u=1) and blocks (u=2)
	for {set u 0} {$u <= 2} {incr u} {	
		for {set i 0} {$i < 9} {incr i} {
			# Find unsolved cells in the unit
			set indices [list]
			foreach idx [getIndicesForUnit $i $sudp($u)] {
				if {[info exists sudca($idx)]} {
					lappend indices $idx
				} 
			} 
			set nbc [llength $indices]
			writeToLog "$nbc unsolved cells in $sudp($u) [expr $i+1]\n" 4
			
			if {$nbc > 1} {
				# Try all combinations of 1 to nbc-1 cells.
				# There are 2^{nbc}-2 possibilities.
				set cnt [expr {2**$nbc-2}]
				incr total $cnt
				writeToLog "trying all combinations ($cnt possibilities)\n" 4
				for {set n 1} {$n < $nbc} {incr n} {
					set combList [sdku::buildCombinations $indices $n]
					foreach comb $combList {
						set vals [list]
						unset -nocomplain eccArr cellsArr
						foreach pos $comb {
							set vals [concat $vals $sudca($pos)]							
							foreach v $sudca($pos) {
								if {[info exists cellsArr($v)]} {
									lappend cellsArr($v) $pos
								} else {
									set cellsArr($v) $pos
								} 
							} 
						} 
						
						foreach v [array names cellsArr] {
							if {[llength $cellsArr($v)] == 1} {
								set eccArr($v) $cellsArr($v)
							} 
						}
						
						set vals [lsort -unique $vals]
						if {([llength $vals] == [expr $n+1]) && [info exists eccArr]} {
							set res [list]
							foreach v [array names eccArr] {
								lappend res "$v[set eccArr($v)]"
							} 	
							dict set alsdict $comb vals $vals
							dict set alsdict $comb eccs $res
						} 
					} 
				}
			} 
		}
	} 
	writeToLog "done: examined $total combinations\n" 4
	return $total
}


# ------------------------------------------------------------------------
# 
# "sdku::buildCombinations" --
# 
# Build all combinations of n elements out of list l
# 
# ------------------------------------------------------------------------
proc sdku::buildCombinations {l n} {
	set result [list]
	set len [llength $l]
	
	if {$n == 1} {
		set result $l
	} else {
		for {set i 0} {$i < $len} {incr i} {
			set subl [lreplace $l $i $i]
			set comb [buildCombinations $subl [expr $n-1]]
			foreach c $comb {
				lappend result [lsort [concat [lindex $l $i] $c]]
			} 
		}
	} 	
	
	return [lsort -unique $result]
}


# ------------------------------------------------------------------------
# 
# "sdku::reduceFish" --
# 
# ------------------------------------------------------------------------
proc sdku::reduceFish {val kind base cover} {
	global sudp sudca sudt
	
	array set code {
		2	xw
		3	sf
		4	jf
		5	sb
		6	wh
		7	lv
	}
	set count 0
	set subcount 0
	set N [llength $base]
	set name [dict get $sudt $code($N) name]
	set rmList [list]
	
	set msg "$name for value $val in $sudp($kind)s [join [sdku::incrIndices $base] ","] "
	append msg "and $sudp([expr {1 - $kind}])s [join [sdku::incrIndices $cover] ","]\n"
	append msg "  candidate $val can be removed from other cells in $sudp([expr {1 - $kind}])s [join [sdku::incrIndices $cover] ","]\n"
	
	for {set i 0} {$i < $N} {incr i} {
		set t [lindex $cover $i]
		for {set j 0} {$j < 9} {incr j} {
			if {$j ni $base} {
				switch $kind {
					"0" { set cell $j$t }
					"1" { set cell $t$j }
				}
				if {[info exists sudca($cell)] && [expr {$val in $sudca($cell)}]} {
					lappend rmList [list $val $cell]
				}				
			} 
		}	
	}
	
	if {[llength $rmList] > 0} {
		writeToBuffer $msg 3
		sdku::adjustCount count [llength $rmList]		
		sdku::removeCandidatesInList $rmList
	} 
	
	return $count
}



# Sudoku exact cover procs
# ========================

# ------------------------------------------------------------------------
# 
# "sdku::solveExactCover" --
# 
# Explanation: 
#     if the reduction methods have not entirely solved the puzzle, the
#     last resort is to solve it as an exact-cover problem. The method
#     relies on D. Knuth's dancing links. They are implemented here using
#     Tcl arrays instead of pointers.
# 
# 
# The matrix encoding chart below was provided by Daniel Seiler on the 
# sudoku forum:
#     http://www.setbb.com/phpbb/viewtopic.php?t=119&highlight=dancing+links&mforum=sudoku
# 
# The cover matrix has the following format:
# 			__________________________________________________________________________________________ 
# 			|  Cell#  |           1            |           2            |   |            9           | 
# 			|123...81 |r1...r9 c1...c9 b1...b9 |r1...r9 c1...c9 b1...b9 |...|r1...r9 c1...c9 b1...b9 | 
# 	________|_________|________________________|________________________|___|________________________| 
# 	1 -> 1,1| 
# 	1 -> 1,2| 
# 	  .     |
#	  .     |
#	  .     |
# 	9 -> 9,9|
# 
# Dimensions:
# Rows:		[number of cells] multiplied by [number of possible digits]
# 			That makes (9*9) * 9 = 9^3 = 729
# Columns:	[number of columns + rows + blocks] multiplied by [number of different digits]
# 			plus
# 			[number of cells]
# 			That makes 3 * 9^2  +  9^2  =  324
# 			
# 			
# All indices start from 0
# Still the possible values in the cells are in the 1-9 range
# 
# For a particular triple {v, r, c} (value, row, col), we know exactly which
# elements of the corresponding row of the matrix have value 1: 
# 
# If R and C are the row and the col indices of an element of the cover matrix:
#   0 <= R < 729
#   0 <= C < 324
#   
#   v = R / 81 + 1
#   r = ( R % 81 ) / 9
# 	c = ( R % 81 ) % 9
# 	b = r/3 * 3 + c/3
# 	
#	C_base				(v - 1) * 27 + 81 = R/81 * 27 + 81
#	cell_constraint		r * 9 + c
#	row_constraint		C_base + r
#	col_constraint		C_base + 9 + c
#	block_constraint	C_base + 18 + b
#	
#	If 0 <= C < 81		--->  cell_constraint
#	Else
#	v = (C - 81) / 27 + 1
# 	If 0 <= C % 81 < 8		--->  row_constraint
# 	If 9 <= C % 81 < 17		--->  col_constraint
# 	If 18 <= C % 81 < 26	--->  block_constraint
# 	
# 	
# The cover array (ec_cv) has keys only for the non null elements of the matrix. 
# The ec_ prefix stands for "exact cover".
# Convention: 
# 			the key is a four digits number 
# 				$v$r$c$t
# 			where v is the value, r the cell row, c the cell column and t
# 			is 0, 1, 2, or 3 corresponding to cell_constraint,
# 			row_constraint, col_constraint and block_constraint resp.
# 		
#		Row $v$r$c has four 1's: $v$r$c0, $v$r$c1, $v$r$c2 and $v$r$c3
# 		
# 		That makes a maximum of 729 * 4 = 2916 keys.
# 		In fact, this will be less because there is no need to create
# 		entries for some rows:
# 			- already determined cells (in sudso array) are skipped
# 			- non permitted values (not in sudca array) are skipped
# 			
# 		A column corresponding to a cell constraint is designated by 
# 		        0$r$c
# 		
# 		A column corresponding to a row, col or block constraint is 
# 		designated by $v$i$t
# 			where v is the value, i the (row|col|block)'s index, and t
# 			is 1, 2, or 3 like above.
# 			 		
# 		For each key of the ec_cv array (i-e each 1 in the cover matrix),
# 		we need to have the left, right, up and down "pointers". They are
# 		stored in the "ec_lt", "ec_rt", "ec_up" and "ec_dn" arrays
# 		respectively. Additionally, there must be a linked left-right list
# 		of column headers: it is also handled by the "ec_lt", "ec_rt",
# 		"ec_up" and "ec_dn" arrays.
# 		
# 
# ------------------------------------------------------------------------
proc sdku::solveExactCover {} {
	writeToLog "** Exact cover algorithm...\n" 3
	sdku::initExactCover
	sdku::dancingSearch 0
}


# ------------------------------------------------------------------------
# 
# "sdku::initExactCover" --
# 
# ------------------------------------------------------------------------
proc sdku::initExactCover {} {
	global ec_cv ec_lt ec_rt ec_up ec_dn ec_sz
	unset -nocomplain ec_cv ec_lt ec_rt ec_up ec_dn ec_sz
	global sudp sudca
	set sudp(currTech) "bt"
	if {$sudp(rating)} {
		set count 0
		# Calculate the remaining number of candidates
		foreach cell [array names sudca] {
			incr count [llength $sudca($cell)]
		} 
		updateRating $count	
	} 
	sdku::createCoverArray
	sdku::createLinkArrays
}


# ------------------------------------------------------------------------
# 
# "sdku::createCoverArray" --
# 
# ------------------------------------------------------------------------
proc sdku::createCoverArray {} {
	global ec_cv sudso ec_sz 
	for {set v 1} {$v <= 9} {incr v} {
		for {set r 0} {$r < 9} {incr r} {
			for {set c 0} {$c < 9} {incr c} {
				if {![info exists sudso($r$c)] && [isAllowableValue $r $c $v]} {
					for {set i 0} {$i < 81} {incr i} {
						if {[expr {$r * 9 + $c}] == $i} {
							set ec_cv($v$r${c}0) 1
							if {[info exists ec_sz(0$r$c)]} {
								incr ec_sz(0$r$c)
							} else {
								set ec_sz(0$r$c) 1
							}
						}
					}
					set b [expr {$r/3*3 + $c/3}]
					for {set i 0} {$i < 9} {incr i} {
						if {$i == $v - 1} {
							for {set j 0} {$j < 27} {incr j} {
								if {$j == $r || $j == [expr {9 + $c}] || $j == [expr {18 + $b}]} {
									# Type t: 1, 2, 3 for row, col, block resp
									set t [expr {$j/9 + 1}]
									set ec_cv($v$r$c$t) 1
									# Build the array of sizes
									set pos [expr {$j % 9}]
									if {[info exists ec_sz($v$pos$t)]} {
										incr ec_sz($v$pos$t)
									} else {
										set ec_sz($v$pos$t) 1
									}
								} 
							}
						} 
					}
				}
			} 
		}	
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::createLinkArrays" --
# 
# ------------------------------------------------------------------------
proc sdku::createLinkArrays {} {
	global ec_cv ec_lt ec_rt ec_up ec_dn ec_sz

	# Create the up and down links arrays
	foreach col [array names ec_sz] {
		buildLinkArraysFromList ec_up ec_dn [concat $col [sdku::colItemsList $col]]
	} 

	# Create the left and right links arrays
	foreach row [array names ec_cv *0] {
		set r [string range $row 0 2]
		buildLinkArraysFromList ec_lt ec_rt [list ${r}0 ${r}1 ${r}2 ${r}3]
	} 
	
	# Iterate over all the cols to create the linked list of headers
	buildLinkArraysFromList ec_lt ec_rt [sdku::colHeadersList]
}


# ------------------------------------------------------------------------
# 
# "sdku::buildLinkArraysFromList" --
# 
# ------------------------------------------------------------------------
proc sdku::buildLinkArraysFromList {arr1 arr2 l} {
	upvar $arr1 a1
	upvar $arr2 a2
	set len [llength $l]
	# Create the up and down arrays
	for {set i 1} {$i < $len - 1} {incr i} {
		set a1([lindex $l $i]) [lindex $l [expr $i - 1]]
		set a2([lindex $l $i]) [lindex $l [expr $i + 1]]
	}
	set a1([lindex $l 0]) [lindex $l end]
	set a2([lindex $l 0]) [lindex $l 1]
	set a1([lindex $l end]) [lindex $l end-1]
	set a2([lindex $l end]) [lindex $l 0]
}


# ------------------------------------------------------------------------
# 
# "sdku::colHeadersList" --
# 
# ------------------------------------------------------------------------
proc sdku::colHeadersList {} {
	global ec_sz
	# "chm" is the column headers master
	set res "chm"
	# Columns 1 to 81 correspond to the cell_constraint
	for {set r 0} {$r < 9} {incr r} {
		for {set c 0} {$c < 9} {incr c} {
			if {[info exists ec_sz(0$r$c)]} {
				lappend res 0$r$c
			}
		}
	}	
	for {set v 1} {$v <= 9} {incr v} {
		for {set t 1} {$t <= 3} {incr t} {
			for {set j 0} {$j < 9} {incr j} {
				if {[info exists ec_sz($v$j$t)]} {
					lappend res $v$j$t
				} 
			}
		}
	}
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::colItemsList" --
# 
# Returns the list of the elements belonging to a column of the cover
# matrix
# 
# ------------------------------------------------------------------------
proc sdku::colItemsList {col} {
	global ec_cv
	set res ""
	set v [string range $col 0 0]

	if {$v == 0} {
		foreach item [lsort [array names ec_cv *0]] {
			if {[sdku::getHeader $item] eq $col} {
				lappend res $item
			} 
		} 
	} else {
		set t [string range $col 2 2]
		foreach item [lsort [array names ec_cv $v*$t]] {
			if {[sdku::getHeader $item] eq $col} {
				lappend res $item
			} 
		} 
	}
	
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::dancingSearch" --
# 
# Implements the dancing links algorithm described by D. Knuth. See:
# http://www-cs-faculty.stanford.edu/~knuth/papers/dancing-color.ps.gz
# 
# Description
# 		If A is empty, the problem is solved; terminate successfully
# 		Otherwise choose a column, c (deterministically)
# 		Choose a row r, such that A[r,c] = 1 (nondeterministically)
# 		Include r in the partial solution
# 		For each j such that A[r,j] = 1, 
# 			Delete column j from matrix
# 			For each i such that A[i,j] = 1,   
# 				Delete row i from matrix A
# 		Repeat this algorithm recursively on the reduced matrix A
# 		
# Implementation (algorithm search(k))
# 		If R[h] = h, print the current solution and return
# 		Otherwise choose a column object c 
# 		Cover column c 
# 		For each r <- D[c], D[D[c]],..., while r  c,
# 			set O_k <- r ; 
# 			for each j <- R[r], R[R[r]],..., while j  r,  
# 				cover column j ; 
# 				search(k + 1);
# 				set r <- O_k and c <- C[r];
# 				for each j <- L[r], L[L[r]],..., while j  r, 
# 					uncover column j 
# 		Uncover column c and return
# 
# ------------------------------------------------------------------------
proc sdku::dancingSearch {level} {
	global sudp ec_up ec_dn ec_lt ec_rt sudso

	if {$ec_rt(chm) eq "chm"} {
		writeToLog "No more cols in cover matrix (reached chm)\n" 4
		return
	} 
	
	if {$sudp(oneSolution) && $sudp(solCount) > 0} {
		return
	} 

	if {$sudp(unicity) && $sudp(solCount) >= 2} {
		return
	} 

	writeToLog "Entering level $level\n" 4

	set found [array size sudso]
	set col [sdku::chooseColumn]
	writeToLog "\tCovering chosen column $col\n" 4
	sdku::coverColumn $col
	
	set cell $ec_dn($col)
	
	while {$cell != $col} {
		set row [string range $cell 0 2]
		writeToLog "Processing row of $cell found in col $col\n" 4
		
		if {$level < [sdku::solutionTempSize]} {
			sdku::solutionTempRemove $level
		}
		sdku::solutionTempAdd $level $row
		
		set right $ec_rt($cell)

		while {$right ne $cell} {
			writeToLog "\tCovering column of $right in row $row\n" 4
			sdku::coverColumn [sdku::getHeader $right]
			set right $ec_rt($right)
		}
		
		# Recursive invocation one level down
		sdku::dancingSearch [expr $level + 1]
		
		set left $ec_lt($cell)
		while {$left ne $cell} {
			writeToLog "\tUncovering column of $left in row $row\n" 4
			sdku::uncoverColumn [sdku::getHeader $left]
			set left $ec_lt($left)
		}
		set cell $ec_dn($cell);
		
		# Store the current solution
		if {[expr {$level + $found}] == 80} {
			sdku::registerNewCoverSolution 
		} 
	}
	
	writeToLog "\tUncovering column $col\n" 4
	sdku::uncoverColumn $col

	writeToLog "Leaving level $level\n" 4
}


# ------------------------------------------------------------------------
# 
# "sdku::chooseColumn" --
# 
# Return the first column in the linked list of headers with the smallest 
# number of non null items
# 
# ------------------------------------------------------------------------
proc sdku::chooseColumn {} {
	global ec_rt ec_sz
	
	set head $ec_rt(chm)
	set size $ec_sz($head)
	set res $head
	
	while {$head ne "chm"} {
		if {$ec_sz($head) < $size} {
			set size $ec_sz($head)
			set res $head
		}         
		set head $ec_rt($head)
	}      
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::coverColumn" --
# 
# ------------------------------------------------------------------------
proc sdku::coverColumn {col} {
	global ec_up ec_dn ec_lt ec_rt ec_sz

	set ec_lt([set ec_rt($col)]) $ec_lt($col)
	set ec_rt([set ec_lt($col)]) $ec_rt($col)
	
	set down $ec_dn($col)
	
	while {$down ne $col} {
		set right $ec_rt($down)
		while {$right ne $down} {
			set ec_up([set ec_dn($right)]) $ec_up($right)
			set ec_dn([set ec_up($right)]) $ec_dn($right)
			incr ec_sz([sdku::getHeader $right]) -1
			set right $ec_rt($right)
		}
		set down $ec_dn($down)
	}	
}


# ------------------------------------------------------------------------
# 
# "sdku::uncoverColumn" --
# 
# ------------------------------------------------------------------------
proc sdku::uncoverColumn {col} {
	global ec_up ec_dn ec_lt ec_rt ec_sz
	
	set up $ec_up($col)
	
	while {$up ne $col} {
		set left $ec_lt($up)
		while {$left ne $up} {
			incr ec_sz([sdku::getHeader $left])
			set ec_up([set ec_dn($left)]) $left
			set ec_dn([set ec_up($left)]) $left
			set left $ec_lt($left)
		}
		set up $ec_up($up)
	}
	
	set ec_lt([set ec_rt($col)]) $col
	set ec_rt([set ec_lt($col)]) $col
}


# ------------------------------------------------------------------------
# 
# "sdku::getHeader" --
# 
# ------------------------------------------------------------------------
proc sdku::getHeader {item} {
	if {[string length $item] == 3} {
		return $item
	} 
	set r [string range $item 1 1]
	set c [string range $item 2 2]
	set t [string range $item 3 3]

	switch -- $t {
		"0" {
			return "0$r$c"
		}
		"1" {
			return [string replace $item 2 2]
		}
		"2" {
			return [string replace $item 1 1]
			
		}
		"3" {
			set b [rowColToBlock $r $c]
			return [string replace $item 1 2 $b]
		}
	}
}



# Sudoku solutions procs
# ----------------------

# ------------------------------------------------------------------------
# 
# "sdku::solutionTempAdd" --
# 
# The temporary solution is a list of acceptable rows from the cover matrix
# 
# ------------------------------------------------------------------------
proc sdku::solutionTempAdd {idx row} {
	global sudp
	set sudp(tempSol) [linsert $sudp(tempSol) $idx $row]
	writeToLog "Adding row [sdku::solutionTempGet $idx] at level $idx\n" 4
}


# ------------------------------------------------------------------------
# 
# "sdku::solutionTempRemove" --
# 
# ------------------------------------------------------------------------
proc sdku::solutionTempRemove {idx} {
	global sudp
	set sudp(tempSol) [lreplace $sudp(tempSol) $idx $idx]
	writeToLog "Removing row [sdku::solutionTempGet $idx] at level $idx\n" 4
}


# ------------------------------------------------------------------------
# 
# "sdku::solutionTempGet" --
# 
# ------------------------------------------------------------------------
proc sdku::solutionTempGet {idx} {
	global sudp
	return [lindex $sudp(tempSol) $idx]
}


# ------------------------------------------------------------------------
# 
# "sdku::solutionTempSize" --
# 
# ------------------------------------------------------------------------
proc sdku::solutionTempSize {} {
	global sudp
	return [llength $sudp(tempSol)]
}


# ------------------------------------------------------------------------
# 
# "sdku::registerNewCoverSolution" --
# 
# ------------------------------------------------------------------------
proc sdku::registerNewCoverSolution {} {
	global sudp sudso
	if {!$sudp(counting)} {
		array set arr [array get sudso]
		foreach row $sudp(tempSol) {
			set arr([string range $row 1 2]) [string range $row 0 0]
		} 
		# Add to the solutions list
		if {![catch {sdku::arrayToString arr} res]} {
			addSolution $res
			writeToLog "\tRegistered temp sol: $sudp(tempSol)\n" 4
		} 
	} else {
		incr sudp(solCount)
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::addSolution" --
# 
# ------------------------------------------------------------------------
proc sdku::addSolution {sud} {
	global sudp 
	incr sudp(solCount)
	writeToLog "Adding solution $sudp(solCount)\n" 4
	if {!$sudp(counting) && !$sudp(rating)} {
		printSolution $sud
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::printSolution" --
# 
# ------------------------------------------------------------------------
proc sdku::printSolution {sud} {
	global sudp 	
	writeToLog "Solution $sudp(solCount):\n"
	if {$sudp(raw)} {
		puts $sud
	} else {
		sdku::display $sud
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::displayResult" --
# 
# ------------------------------------------------------------------------
proc sdku::displayResult {} {
	global sudp sudca
	
	set len $sudp(solCount)
	if {$sudp(rating)} {
		if {$len > 1} {
			puts "Level n/a (multiple solutions)"
		} elseif {$len == 1} {
			calculateLevel
		} else {
			puts "Level n/a (no solution)"
		}
		return
	}

	if {$len == 0} {
		if {$sudp(backtracking)} {
			if {$sudp(unicity) || $sudp(counting)} {
				puts "0"
			} else {
				puts "No solution found"
				foreach cell [lsort [array names sudca]] {
					if {[llength $sudca($cell)] == 0} {
						writeToLog "No value for cell [printPosForKey $cell]\n" 1
					} 
				} 
			}
		} else {
			writeToLog "Partial solution (don't disable backtracking to get a complete resolution)\n" [expr {!$sudp(counting)}]
			if {$sudp(raw)} {
				puts $sudp(curr)
			} else {
				sdku::display
			}
		}
	} else {
		if {$sudp(unicity)} {
			puts [expr {$len == 1}]
		} elseif {$sudp(counting)} {
			puts $len
		} 
	}
}



# Sudoku accessors procs
# ======================

# ------------------------------------------------------------------------
# 
# "sdku::getUnitValuesAtIndex" --
# 
# ------------------------------------------------------------------------
proc sdku::getUnitValuesAtIndex {idx kind} {
	global sudso
	set res ""
	set indices [sdku::getIndicesForUnit $idx $kind]
	foreach cell $indices {
		if {[info exists sudso($cell)]} {
			append res $sudso($cell)
		} 
	} 
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::getValueAtPos" --
# 
# ------------------------------------------------------------------------
proc sdku::getValueAtPos {sud row col} {
	return [string index $sud [expr {$row * 9 + $col}]]
}


# ------------------------------------------------------------------------
# 
# "sdku::setValueAtPos" --
# 
# ------------------------------------------------------------------------
proc sdku::setValueAtPos {sud row col val} {
	set pos [expr {$row * 9 + $col}]
	return [string replace $sud $pos $pos $val]
}


# ------------------------------------------------------------------------
# 
# "sdku::insertValueInCell" --
# 
# ------------------------------------------------------------------------
proc sdku::insertValueInCell {val cell} {
	global sudp
	set r [string index $cell 0]
	set c [string index $cell 1]
	set sudp(curr) [sdku::setValueAtPos $sudp(curr) $r $c $val]	
}


# ------------------------------------------------------------------------
# 
# "sdku::getIndicesForUnit" --
# 
# Returns the indices ($row$col) of the elements belonging to a particular unit
# 
# ------------------------------------------------------------------------
proc sdku::getIndicesForUnit {idx kind} {
	set res ""
	switch -- $kind {
		"row" {
			for {set i 0} {$i < 9} {incr i} {
				lappend res $idx$i
			}
		}
		"column" {
			for {set i 0} {$i < 9} {incr i} {
				lappend res $i$idx
			}
		}
		"block" {
			set ridx [expr {($idx / 3) * 3}]
			set cidx [expr {($idx % 3) * 3}]
			for {set i 0} {$i < 3} {incr i} {
				for {set j 0} {$j < 3} {incr j} {
					lappend res [expr {$ridx + $i}][expr {$cidx + $j}]
				}
			}
		}
	}
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::getBlockForCell" --
# 
# ------------------------------------------------------------------------
proc sdku::getBlockForCell {cell} {
	set row [string index $cell 0]
	set col [string index $cell 1]
	set r [expr $row/3]
	set c [expr $col/3]
	return [expr $r*3+$c]
}


# ------------------------------------------------------------------------
# 
# "sdku::ensureSetArray" --
# 
# ------------------------------------------------------------------------
proc sdku::ensureSetArray {arr key val} {
	upvar $arr a
	if {![info exists a($key)]} {
		set a($key) $val
	} else {
		lappend a($key) $val
	}	
}


# Sudoku formatting procs
# =======================

# ------------------------------------------------------------------------
# 
# "sdku::normalize" --
# 
# ------------------------------------------------------------------------
proc sdku::normalize {sud {symb 0}} {
	set len [string length $sud]
	if {$len != 81} {
		set msg "invalid sudoku: total length should be 81 (got $len)"
		if {$len > 81} {
			set sud [string range $sud 0 80]
		} else {
			set sud "$sud[string repeat "." [expr 81-$len]]"
		} 
		sdku::display $sud
		error $msg
	} 
	regsub -all {[^1-9]} $sud $symb sud
	return $sud
}


# ------------------------------------------------------------------------
# 
# "sdku::stringToArray" --
# 
# Undetermined values (zeros in the sudoku chain) are not stored in the
# array so that one can test the existence of a key to see if a value has
# been found for this key
# 
# ------------------------------------------------------------------------
proc sdku::stringToArray {sud arr} {
	upvar $arr a
	set sud [split $sud ""]
	for {set i 0} {$i < 9} {incr i} {
		for {set j 0} {$j < 9} {incr j} {
			set val [lindex $sud [expr {9*$i+$j}]]
			if {$val} {
				set a($i$j) $val
			} 
		}
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::arrayToString" --
# 
# ------------------------------------------------------------------------
proc sdku::arrayToString {arr {symb 0}} {
	upvar $arr a
	set sud ""
	for {set r 0} {$r < 9} {incr r} {
		for {set c 0} {$c < 9} {incr c} {
			if {[info exists a($r$c)]} {
				append sud $a($r$c)
			} else {
				append sud $symb
			}
		}
	}
	return $sud
}


# ------------------------------------------------------------------------
# 
# "sdku::incrIndices" --
# 
# ------------------------------------------------------------------------
proc sdku::incrIndices {indices} {
	set res [list]
	foreach idx $indices {
		lappend res [expr {$idx + 1}]
	} 
	return $res
}


# Display procs
# -------------

# ------------------------------------------------------------------------
# 
# "sdku::grid" --
# 
# ------------------------------------------------------------------------
proc sdku::grid { {sud ""} {framed 1}} {
	global sudp	
	
	if {$sud eq ""} {
		set sud $sudp(curr)
	} 
	
	set res ""
	regsub -all "0" $sud "." sud
	if {$framed} {
		set horiz [string repeat - 23]
		regsub -all {[\d.]{3}} $sud "&|" sud
		lappend res "+$horiz+"
		for {set i 0} {$i < 9} {incr i} {
			set line "|"
			append line [string range $sud [expr {$i * 12}] [expr {($i * 12) + 11}]]
			lappend res [split $line ""]
			if {[expr $i % 3] == 2 && $i != 8} {
				lappend res "|-------|-------|-------|"
			} 
		}
		lappend res "+$horiz+"
	} else {
		for {set i 0} {$i < 9} {incr i} {
			set line [string range $sud [expr {$i * 9}] [expr {($i * 9) + 8}]]
			lappend res [split $line ""]
		}
	}
	return [join $res "\n"]
}


# ------------------------------------------------------------------------
# 
# "sdku::display" --
# 
# ------------------------------------------------------------------------
proc sdku::display { {sud ""} {framed 1}} {
	global sudp	
	if {$sud eq ""} {
		set sud $sudp(curr)
	} 
	puts [sdku::grid $sud $framed]
}


# ------------------------------------------------------------------------
# 
# "sdku::displayCandidates" --
# 
# If 'val' is not null, display only candidate sets containing this value.
# This is specified by option -k[1-9].
# 
# ------------------------------------------------------------------------
proc sdku::displayCandidates { {sud ""} {val 0} } {	
	global sudp sudca sudso
	
	if {$sud eq ""} {
		set sud $sudp(curr)
	} 
	
	if {$val == "+"} {
		for {set i 1} {$i <= 9} {incr i} {
			sdku::displayCandidates $sud $i
		}
	} elseif {$val == 0} {
		if {$sudp(raw)} {
			foreach key [lsort [array names sudca]] {
				puts "[printPosForKey $key]\t[join $sudca($key) ""]"
			}
		} else {
			set cw 1
			foreach key [lsort [array names sudca]] {
				set carr($key) [join $sudca($key) ""]
				set kl [string length $carr($key)]
				if {$kl > $cw} {
					set cw $kl
				} 
			}
			incr cw 2
			set wd [expr $cw*9+2]
			set sep "+[string repeat "-" $wd]+"
			puts $sep
			for {set i 0} {$i < 9} {incr i} {
				set line "|"
				for {set j 0} {$j < 9} {incr j} {
					set k $i$j
					if {[info exists carr($k)]} {
						append line "[sdku::center $carr($k) $cw]"
					} else {
						append line "[sdku::center $sudso($i$j) $cw]"
					}
					if {[expr $j % 3] == 2} {
						append line "|"
					} 
				}
				puts $line
				if {[expr $i % 3] == 2} {
					puts $sep
				} 
			}
		} 		
	} else {
		if {$sudp(raw)} {
			foreach key [lsort [array names sudca]] {
				if {$val in $sudca($key)} {
					puts "[printPosForKey $key]\t[join $sudca($key) ""]"
				} 
			}
		} else {
			set cw 1
			foreach key [lsort [array names sudca]] {
				if {$val in $sudca($key)} {
					set carr($key) [join $sudca($key) ""]
					set kl [string length $carr($key)]
					if {$kl > $cw} {
						set cw $kl
					} 					
				} 
			}
			if {![info exists carr]} {
				return
			} 
			writeToLog "Candidates with value $val:\n" 1
			incr cw 2
			set wd [expr $cw*9+2]
			set sep "+[string repeat "-" $wd]+"
			puts $sep
			for {set i 0} {$i < 9} {incr i} {
				set line "|"
				for {set j 0} {$j < 9} {incr j} {
					set k $i$j
					if {[info exists carr($k)]} {
						append line "[sdku::center $carr($k) $cw]"
					} else {
						append line "[sdku::center "." $cw]"
					}
					if {[expr $j % 3] == 2} {
						append line "|"
					} 
				}
				puts $line
				if {[expr $i % 3] == 2} {
					puts $sep
				} 
			}
		} 
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::center" --
# 
# ------------------------------------------------------------------------
proc sdku::center {str wd} {
	set diff [expr $wd - [string length $str]]
	set lft [expr $diff/2]
	set rt [expr $diff - $lft]
	return "[string repeat " " $lft]$str[string repeat " " $rt]"
}


# ------------------------------------------------------------------------
# 
# "sdku::currentString" --
# 
# ------------------------------------------------------------------------
proc sdku::currentString {} {
	global sudso
	return [sdku::arrayToString sudso "."]
}



# Sudoku utils procs
# ==================

# Sudoku validation procs
# -----------------------

# ------------------------------------------------------------------------
# 
# "sdku::checkSudoku" --
# 
# ------------------------------------------------------------------------
proc sdku::checkSudoku {sud} {
	foreach kind [list "row" "column" "block"] {
		sdku::checkAllForType $sud $kind
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::checkAllForType" --
# 
# The 'kind' argument specifies the kind of unit: "row", "column" or
# "block".
# 
# ------------------------------------------------------------------------
proc sdku::checkAllForType {sud kind} {	
	for {set i 0} {$i < 9} {incr i} {
		set seq [sdku::getUnitValuesAtIndex $i $kind]
		if {[catch {sdku::checkSequence $seq} res]} {
			error "invalid $kind [expr $i + 1]: $res"
		} 		
	}	
}


# ------------------------------------------------------------------------
# 
# "sdku::checkSequence" --
# 
# ------------------------------------------------------------------------
proc sdku::checkSequence {seq} {
	# Remove the zeros
	regsub -all "0" $seq "" seq
	# Check that it is made up of digits
	if {![string is integer $seq]} {
		error "non digit elements"
	} 
	set digits [split $seq ""]
	# Look for multiple digits
	foreach d $digits {
		if {[info exists arr($d)]} {
			error "multiple digit $d"
		} else {
			set arr($d) 1
		}
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::isAllowableValue" --
# 
# ------------------------------------------------------------------------
proc sdku::isAllowableValue {row col val} {
	global sudca
	return [expr {$val in $sudca($row$col)}]
}


# ------------------------------------------------------------------------
# 
# "sdku::isSolved" --
# 
# ------------------------------------------------------------------------
proc sdku::isSolved {} {
	global sudso
	return [expr {[array size sudso] == 81}]
}


# ------------------------------------------------------------------------
# 
# "sdku::getUnsolvedInList" --
# 
# ------------------------------------------------------------------------
proc sdku::getUnsolvedInList {indices} {
	global sudca
	set res [list]
	foreach idx $indices {
		if {[info exists sudca($idx)]} {
			lappend res $idx
		} 
	} 
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::inSameUnitOfKind" --
# 
# Return whether the given indices are in the same row (kind=0), column
# (kind=1) or block (kind=2)
# 
# ------------------------------------------------------------------------
proc sdku::inSameUnitOfKind {kind indices} {
	set same 1
	set len [llength $indices]
	set c1 [lindex $indices 0]
	if {$kind == 2} {
		for {set i 1} {$i < $len} {incr i} {
			set b1 [sdku::getBlockForCell $c1]
			if {[sdku::getBlockForCell [lindex $indices $i]] != $b1} {
				set same 0
				break
			} 
		} 
	} else {
		set u [string index $c1 $kind]
		for {set i 1} {$i < $len} {incr i} {
			if {[string index [lindex $indices $i] $kind] ne $u} {
				set same 0
				break
			} 
		} 
	} 
	return $same
}


# ------------------------------------------------------------------------
# 
# "sdku::seeEachOther" --
# 
# Return whether to cells belong to a same unit (row, col or block)
# 
# ------------------------------------------------------------------------
proc sdku::seeEachOther {c1 c2} {
	# Are they in the same row or col ?
	if {([string index $c1 0] == [string index $c2 0])
		|| ([string index $c1 1] == [string index $c2 1])} {
		return 1
	} 
	# Are they in the same block ?
	if {[sdku::getBlockForCell $c1] == [sdku::getBlockForCell $c2]} {
		return 1
	} 
	return 0
}


# ------------------------------------------------------------------------
# 
# "sdku::valueExistsInBlock" --
# 
# ------------------------------------------------------------------------
proc sdku::valueExistsInBlock {idx val} {
	global sudp
	set block [sdku::getUnitValuesAtIndex $idx "block"]
	if {[string first $val $block] != -1} {
		return 1
	} 
	return 0
}


# ------------------------------------------------------------------------
# 
# "sdku::intersect" --
# 
# ------------------------------------------------------------------------
proc sdku::intersect {l1 l2} {
	set inter 0
	foreach itm $l1 {
		if {$itm in $l2} {
			set inter 1
			break
		} 
	} 
	return $inter
}											


# ------------------------------------------------------------------------
# 
# "sdku::commonExcept" --
# 
# ------------------------------------------------------------------------
proc sdku::commonExcept {v1 v2 w} {
	set res [list]
	foreach itm $v1 {
		if {($itm in $v2) && ($itm ni $w)} {
			lappend res $itm
		} 
	} 
	return $res
}											
																	
										
# ------------------------------------------------------------------------
# 
# "sdku::center" --
# 
# ------------------------------------------------------------------------
proc sdku::center {str wd} {
	set diff [expr $wd - [string length $str]]
	set lft [expr $diff/2]
	set rt [expr $diff - $lft]
	return "[string repeat " " $lft]$str[string repeat " " $rt]"
}


# Utility procs
# -------------

# ------------------------------------------------------------------------
# 
# "sdku::rowColToBlock" --
# 
# ------------------------------------------------------------------------
proc sdku::rowColToBlock {row col} {
	set lidx [expr $row/3]
	set cidx [expr $col/3]
	return [expr {$cidx + 3 * $lidx}]
}


# ------------------------------------------------------------------------
# 
# "sdku::buildCandidates" --
# 
# For each cell, find the allowable values. They are returned in an array
# specified in the second argument. The keys of the array are the cells,
# the values are lists of possible values. If the value of a cell is
# already determined, nothing is stored in the array.
# 
# ------------------------------------------------------------------------
proc sdku::buildCandidates {sud arr} {
	upvar $arr tmp
	for {set i 0} {$i < 9} {incr i} {
		for {set j 0} {$j < 9} {incr j} {
			if {![getValueAtPos $sud $i $j]} {
				set res [sdku::getAllowablesForCell $sud $i$j]
				if {[llength $res] == 0} {
					error "no candidate for cell [printPosForKey $i$j]"
				} else {
					set tmp($i$j) $res
				}
			} 
		}
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::updateCandidates" --
# 
# When values have been found and inserted, the array of candidates
# must be updated. We can't just call sdku::buildCandidates because it
# could re-introduce values which have already been eliminated by some
# other technique.
# 
# ------------------------------------------------------------------------
proc sdku::updateCandidates {} {
	global sudca sudp
	for {set i 0} {$i < 9} {incr i} {
		for {set j 0} {$j < 9} {incr j} {
			if {[info exists sudca($i$j)]} {
				set res [getAllowablesForCell $sudp(curr) $i$j]
				set temp [list]
				foreach val $sudca($i$j) {
					if {$val in $res} {
						lappend temp $val
					} else {
						writeToLog "candidate $val removed from [printPosForKey $i$j]\n" 4
					}
				} 
				if {[llength $temp] == 0} {
					error "impossible sudoku\nno more candidates for cell [printPosForKey $i$j]"
				} 
				set sudca($i$j) $temp
			} 
		}
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::getAllowablesForCell" --
# 
# ------------------------------------------------------------------------
proc sdku::getAllowablesForCell {sud cell} {
	set r [string index $cell 0]
	set c [string index $cell 1]
	set values [getUnitValuesAtIndex $r "row"]
	append values [getUnitValuesAtIndex $c "column"]
	append values [getUnitValuesAtIndex [rowColToBlock $r $c] "block"]
	regsub -all "0" $values "" values
	set reject [lsort -uniq [split $values ""]]
	set res ""
	for {set v 1} {$v <= 9} {incr v} {
		if {$v ni $reject} {
			lappend res $v
		} 
	}
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::checkSolveCell" --
# 
# ------------------------------------------------------------------------
proc sdku::checkSolveCell {cell {ns 0}} {
	global sudca sudso

	set solved 0
	if {[info exists sudca($cell)] && [llength $sudca($cell)] == 1} {
		# If only one possibility, insert it in the solution
		set val [lindex $sudca($cell) 0]
		writeToBuffer "Cell [printPosForKey $cell] has unique candidate $val\n" 3
		sdku::solveCellWithValue $val $cell
		set solved 1
	} 
	return $solved
}


# ------------------------------------------------------------------------
# 
# "sdku::solveCellWithValue" --
# 
# ------------------------------------------------------------------------
proc sdku::solveCellWithValue {val cell} {
	global sudca sudso
	writeToBuffer "Solving cell [printPosForKey $cell] with value $val\n" 4
	set sudso($cell) $val 
	unset sudca($cell)	
	writeToBuffer "\tinserted value $val in [printPosForKey $cell]\n" 3
	writeToBuffer "\t[sdku::currentString]\n" 3
}


# ------------------------------------------------------------------------
# 
# "sdku::removeCandidateFromCell" --
# 
# ------------------------------------------------------------------------
proc sdku::removeCandidateFromCell {val cell {verbose 1}} {
	global sudca sudp

	if {[info exists sudca($cell)]} {
		set found [lsearch $sudca($cell) $val]
		if {$found != -1} {
			set sudca($cell) [lreplace $sudca($cell) $found $found]
			if {$verbose} {
				writeToBuffer "\tremoved candidate $val from [printPosForKey $cell]\n" 3
				writeToBuffer "\tremaining candidates for cell [printPosForKey $cell]: $sudca($cell)\n" 4
			} 
			sdku::checkSolveCell $cell
			return 1
		} 
	} 
	return 0
}


# ------------------------------------------------------------------------
# 
# "sdku::removeCandidatesInList" --
# 
# ------------------------------------------------------------------------
proc sdku::removeCandidatesInList {rmList} {
	if {[llength $rmList] > 0} {
		foreach pair [lsort -unique $rmList] {
			sdku::removeCandidateFromCell [lindex $pair 0] [lindex $pair 1]
		} 
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::removeFromUnitInOtherBlocks" --
# 
# Remove value from the rest of a particular unit (row/col) in the other
# two blocks. Kind 0 is a row, kind 1 is a column.
# 
# ------------------------------------------------------------------------
proc sdku::removeFromUnitInOtherBlocks {val kind index block} {
	global sudp sudca
	set count 0
	
	switch $kind {
		"0" { set bi [expr {$block % 3}] }
		"1" { set bi [expr {$block / 3}] }
	}

	for {set i 0} {$i < 9} {incr i} {
		if {[expr {$i/3 != $bi}]} {
			switch $kind {
				"0" { set cell $index$i }
				"1" { set cell $i$index }
			}
			incr count [removeCandidateFromCell $val $cell]
		} 
	}
	
	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::removeFromUnitInOtherCells" --
# 
# ------------------------------------------------------------------------
proc sdku::removeFromUnitInOtherCells {val indices skip} {
	global sudp sudca
	set count 0
	foreach cell $indices {
		if {[lsearch $skip $cell] == -1} {
			incr count [removeCandidateFromCell $val $cell]
		} 
	} 
	
	return $count
}


# ------------------------------------------------------------------------
# 
# "sdku::adjustCount" --
# 
# ------------------------------------------------------------------------
proc sdku::adjustCount {countVar subcount} {
	global sudp
	upvar $countVar count
	if {$subcount} {
		incr count $subcount
		if {$sudp(rating)} {
			updateRating $subcount
		}
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::updateRating" --
# 
# ------------------------------------------------------------------------
proc sdku::updateRating {{count 1} {tech ""}} {
	global sudp 
	if {$tech eq ""} {
		set tech $sudp(currTech)
	} 
	writeToLog "$tech technique ($count reduced)\n" 4
	if {[info exists sudp(reduc-$tech)]} {
		incr sudp(reduc-$tech) $count
	} else {
		set sudp(reduc-$tech) $count
	}
}


# ------------------------------------------------------------------------
# 
# "sdku::calculateLevel" --
# 
# Level rating 
# 
# The resolution process uses various techniques to reduce the number of
# candidates for every cell until there is only one left. The techniques
# are more or less sophisticated: they are ordered and the level is
# calculated based on the highest technique used.
# 
# ------------------------------------------------------------------------
proc sdku::calculateLevel {} {
	global sudp 

	variable baseList
	variable extraList
	set order [concat $baseList $extraList]
	set len [llength $order]
	set idx 0
	set numReduc 0
	set techUsed [list]
	
	for {set i 0} {$i < $len} {incr i} {
		set tech [lindex $order $i]
		if {[info exists sudp(reduc-$tech)]} {
			set idx $i
			writeToLog "# of $tech reductions: $sudp(reduc-$tech)\n" 4
			incr numReduc $sudp(reduc-$tech)
			lappend techUsed $tech
		} 
	}
	
	if {$numReduc > 0} {
		set topTech [lindex $order $idx]
		set bonus [expr {$sudp(reduc-$topTech) * 0.2/$len}]
		if {$bonus > 0.9} {
			set bonus 0.9
		} 
		set rate [eval expr ($idx+1+$bonus)/$len]
		set level [expr round($rate*10)]
		
		writeToLog "Techniques used: [join $techUsed ","]\n" 3
		writeToLog "Top technique: $topTech\n" 4
		writeToLog "Total reductions: $numReduc\n" 4
		writeToLog "Level: [expr $idx+1] (/$len)\n" 4
		writeToLog "Bonus: $bonus\n" 4
		writeToLog "Rate $rate\n" 4
		# Adjustments
		# If only ns and hs techniques used, limit level to 4
		if {[llength $techUsed] <= 2 && $level > 3} {
			set level 3
		} 
		# For low levels, take the number of given values into account
		if {$level < 4 && $sudp(given) < 35} {
			writeToLog "Less than 35 given: level incremented\n" 4
			incr level
		} 
		if {$level > 10} {
			set level 10
		} 
		# If backtracking (bt) necessary, append a '+' sign.
		if {[info exists sudp(reduc-bt)]} {
			append level "+"
			lappend techUsed bt
		} 
		if {$sudp(verbosity) == 0} {
			puts $level
		} else {
			puts "Level $level ([join $techUsed ","])"
		}
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::exitError" --
# 
# ------------------------------------------------------------------------
proc sdku::exitError {msg} {
	puts "Error: $msg"
	sdku::usage
	exit 1
}


# Log procs
# ---------

# ------------------------------------------------------------------------
# 
# "sdku::writeToLog" --
# 
# ------------------------------------------------------------------------
proc sdku::writeToLog {str {debug 1}} {
	global sudp
	if {$sudp(verbosity) >= $debug} {
		puts -nonewline $str
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::writeToBuffer" --
# 
# ------------------------------------------------------------------------
proc sdku::writeToBuffer {str {debug 1}} {
	global sudp
	if {$sudp(verbosity) >= $debug} {
		append sudp(buffer) $str
	} 
}


# ------------------------------------------------------------------------
# 
# "sdku::emptyBuffer" --
# 
# ------------------------------------------------------------------------
proc sdku::emptyBuffer {} {
	global sudp
	set sudp(buffer) ""
}


# ------------------------------------------------------------------------
# 
# "sdku::flushBuffer" --
# 
# ------------------------------------------------------------------------
proc sdku::flushBuffer {} {
	global sudp
	puts -nonewline $sudp(buffer)
	sdku::emptyBuffer
}


# ------------------------------------------------------------------------
# 
# "sdku::printPosForKey" --
# 
# This is used for output information. Prints natural positions (starting 
# from 1, not from 0)
# 
# ------------------------------------------------------------------------
proc sdku::printPosForKey {key} {
	return "L[expr {[string index $key 0] + 1}]C[expr {[string index $key 1] + 1}]"
}


# ------------------------------------------------------------------------
# 
# "sdku::usage" --
# 
# ------------------------------------------------------------------------
proc sdku::usage {} {
	global sudp
	set script [file tail [info script]]
	set year [clock format [clock seconds] -format "%Y"]
	puts "$script, version $sudp(version)"
	puts "Copyright (c) 2005-$year, Bernard Desgraupes <bdesgraupes@users.sourceforge.net>"
	puts "Usage:\n\t$script ?options? (<string> | -f <file>)"
	puts "\t$script -d string1 string2"
	puts "\t$script -m row col val ?row col val...? string"
	puts "\t$script (-h|-t|-v)"
	puts "A sudoku string is 81-chars long (use any symbol other than 1-9 digits for the unsolved cells)."
	puts "Options:"
	puts "\t-a\t\tdisplay almost locked sets (ALS)"
	puts "\t-b\t\tforce backtracking (exact cover algorithm)"
	puts "\t-c\t\tcount solutions"
	puts "\t-d\t\tdiff between two sudokus"
	puts "\t-e\t\texplain resolution process"
	puts "\t-f\t\tread sudoku strings from file (one string per line)"
	puts "\t-g\t\tdisplay grid"
	puts "\t-h\t\tusage"
	puts "\t-i codes\tignore specified techniques. See codes below."
	puts "\t-j\t\ttest validity of sudoku"
	puts "\t-k\t\tdisplay candidates"
	puts "\t-k<n>\t\tdisplay candidates containing value <n>"
	puts "\t-l\t\trate level of difficulty"
	puts "\t-m\t\tmodify a sudoku"
	puts "\t-n\t\tno backtracking"
	puts "\t-o\t\tfind only one solution"
	puts "\t-p codes\tprobe with specified techniques. See codes below."
	puts "\t-q\t\tquiet (verbosity = 0)"
	puts "\t-r\t\traw result (return solutions as raw strings)"
	puts "\t-s\t\tsuggest next move"
	puts "\t-t\t\tdisplay available techniques"
	puts "\t-u\t\ttest unicity of solution"
	puts "\t-v num\t\tverbosity (0 to 4; default 1)"
	puts "\t-v\t\tIf no arg, print version"
	sdku::printTechniques
}


# ------------------------------------------------------------------------
# 
# "sdku::printTechniques" --
# 
# ------------------------------------------------------------------------
proc sdku::printTechniques {} {
	global sudp sudt
	puts "Codes for reduction techniques (used with -i and -p):"	
	foreach code [lsort [dict keys $sudt]] {
		set desc [dict get $sudt $code name]
		puts "\t$code\t$desc reduction"
	} 	
}


# ------------------------------------------------------------------------
# 
# "sdku::handleDiff" --
# 
# ------------------------------------------------------------------------
proc sdku::handleDiff {string1 string2} {
	if {[catch {sdku::diff $string1 $string2} res]} {
		puts $res
	} else {
		set len [llength $res]
		if {$len == 0} {
			writeToLog "Sudokus are identical\n"
		} else {
			writeToLog "Found $len difference[expr $len>1?"s":""]\n"
			puts [join $res "\n"]
		}
	}
}
	

# ------------------------------------------------------------------------
# 
# "sdku::diff" --
# 
# ------------------------------------------------------------------------
proc sdku::diff {sud1 sud2} {
	set sud1 [sdku::normalize $sud1 "."]
	set sud2 [sdku::normalize $sud2 "."]
	
	set res [list]
	for {set i 0} {$i < 81} {incr i} {
		set lf [string index $sud1 $i]
		set rt [string index $sud2 $i]
		if {$lf ne $rt} {
			set r [expr {$i/9}]
			set c [expr {$i % 9}]
			lappend res "[printPosForKey $r$c]: $lf <> $rt"
		} 
	}
	return $res
}


# ------------------------------------------------------------------------
# 
# "sdku::handleModify" --
# 
# ------------------------------------------------------------------------
proc sdku::handleModify {args} {
	set sud [lindex $args end]
	set args [lreplace $args end end]
	set len [llength $args]
	if {[expr $len % 3] != 0} {
		puts "Wrong number of args: sudokut -m row col val ?row col val...? string"
		return
	} else {
		foreach {row col val} $args {
			incr row -1
			incr col -1
			set sud [eval setValueAtPos $sud $row $col $val]
		}
		puts $sud	
	}
}


# # Execute the command line now
# # ============================


if {[catch {eval sdku::execute $argv} err]} {
	if {$sudp(counting)} {
		puts "0"
	} else {
		puts "Error: $err"
	}
	# Don't leave pending file refs
	catch {close sudp(fid)}
} 

