#!/usr/bin/tclsh
proc search { l1 } {
    global words
    #puts "search $l1"
    set answers {}
    for { set i 0 } { $i < [llength $l1] } { incr i } {
	set l2 [lindex $l1 $i]
	if {[llength $l2] > 1} {
	    foreach letter $l2 {
		set l1 [lreplace $l1 $i $i $letter]
		set result [search $l1]
		if {[llength $result]} {
		    set answers [concat $answers $result]
		}
	    }
	    return $answers
	}
    }
    set try [join $l1 ""]
    #puts "looking up $try ($l1)"
    if {[lsearch -exact -sorted $words $try] >= 0} {
	#puts $try
	return "{ $l1 }"
    }
    return {}
}

proc diffwords {w1 w2} {
    set len1 [string length $w1]
    set len2 [string length $w2]
    set result {}
    if { [expr $len1-$len2] == 1 } {
	set shorter [split $w2 {}]
	set longer [split $w1 {}]
    } elseif { [expr $len2-$len1] == 1 } {
	set shorter [split $w1 {}]
	set longer [split $w2 {}]
    } else {
	return $result
    }
    foreach letter $shorter {
	set where [lsearch -exact $longer $letter]
	if {$where < 0} {
	    return $result
	}
	set longer [lreplace $longer $where $where]
    }
    lappend result [lindex $longer 0]
    lappend result $w2
    return $result
}

set puzzles {
    { levee ennui imp bent fortune nerves handout }
    { finder hairdo bonnets resonance shame firearms amused }
    { clerics lathering bologna tonnage hombre salvo }
    { lyrics continents inane wader situating preset }
    { hermit makes burnt lived foraged herniate faze elbow }
    { earth heat rustic atheism ounces uncross }
}
set fp [open ../word.list r]
set words {}
while {[gets $fp line] >= 0} {
    lappend words $line
}
close $fp
puts "[llength $words] words"
foreach puzzle $puzzles {
    puts "puzzle = $puzzle"
    set list1 {}
    set list5 {}
    foreach pword $puzzle {
	puts "working on $pword"
	set list2 {}
	set list3 {}
	foreach word $words {
	    set result [diffwords $pword $word]
	    if {[llength $result]} {
		lappend list2 $result
		#puts $result
	    }
	}
	foreach list4 $list2 {
	    lappend list3 [lindex $list4 0]
	}
	set list3 [lsort -unique $list3]
	#puts $list3
	lappend list5 $list3
	lappend list1 $list2
    }
    puts $list1
    puts $list5
    puts "searching answers"
    set list5 [search $list5]
    foreach letters $list5 {
	puts -nonewline "[join $letters ""] = "
	for { set i 0 } { $i < [llength $letters] } { incr i } {
	    set letter [lindex $letters $i]
	    #puts "looking for $letter with word $i ([lindex $list1 $i])"
	    set temp {}
	    foreach keyedword [lindex $list1 $i] {
		#puts "checking $keyedword"
		set key [lindex $keyedword 0]
		set word [lindex $keyedword 1]
		if {[string equal $key $letter]} {
		    #puts "found it!"
		    lappend temp $word
		}
	    }
	    puts -nonewline "[join $temp "|"] "
	}
	puts ""
    }
}