#! /bin/bash
# \
    export TCL_LIBRARY=$HOME/tcl/lib/tcl ; \
    exec /usr/local/bin/tclsh $0 "$@"

array set Env \
    [list \
         {whFile}  {wordhash.tcl} \
         {alpha}   {abcdefghijklmnopqrstuvwxyz} \
        ]

array set Env \
    [list \
         {alphlist} [split $Env(alpha) {}] \
        ]

source h:/fromUTD/tcl/lib/tcl/ListSet.tcl

switch [lassign $argv From To x] {

    2 {
        foreach FT {From To} {
            set $FT [string tolower [string trim [set $FT]]]
            set _LEN_$FT [string length [set $FT]]
        }

        if {$_LEN_From != $_LEN_To} {
            puts stderr {From and To params must be the same length!}
            exit 1
        }

        if {![string compare $From $To]} {
            puts stderr {From and To params must be different strings!}
            exit 2
        }
    }

    default {
        puts stderr {Two params: From, To}
        exit 3
    }
}

#  We could go on and on trying to find a given solution, but let's
#  say that if the search is exceeding twice the length of a word
#  (e.g., starting with "fish" (4 letters long), we've gone thru 8
#  words with no end in sight), we'll bounce out.
#
set MaxTravLen [expr $_LEN_From * 2]

puts -nonewline stderr {Reading word file...}
source $Env(whFile)
puts stderr {Done.}

puts -nonewline stderr {Processing word list...}
foreach {ix dat} [array get wordhash] {
    foreach aword $dat {
        set words($aword) {}
    }
}
unset wordhash
puts stderr {Done.}

foreach i {From To} {
    if {![info exists words([set $i])]} {
        puts stderr "\"[set $i]\" not in $Env(whFile)!"
        exit 4
    }
}

proc NextStep {aword} {

    global Env words Steps To _LEN_From

    #  Oop!  Already got this one!
    #
    if {[info exists Steps($aword)]} { return 0 }

    set Steps($aword) {}

    #  Hey!  If it's our target "$To" word, then that's where
    #    the buck stops.  No use finding the next step....
    #
    if {[string match $To $aword]} { return 0 }

    set alist [split $aword {}]

    for {set a 0} {$a < $_LEN_From} {incr a} {

        foreach alph $Env(alphlist) {

            set newword [join [lreplace $alist $a $a $alph] {}]

            if {![string compare $aword $newword]} continue
            if {![info exists words($newword)]} continue

            lappend Steps($aword) $newword
        }
    }

    return [llength $Steps($aword)]
}

puts -nonewline stderr {Recursively generating "next step" array...}

#  Generate "next step" array element from launch word "$From".
#
NextStep $From

#  Now, recursively generate all needed "next step" array elements
#    from existing elements.
#
while (1) {
    set found 0

    foreach {ix dat} [array get Steps] {
        foreach step $dat {
            incr found [NextStep $step]
        }
    }

    #  Keep going 'til there ain't no more.
    #
    if {!$found} break
}

puts stderr {Done.}

if {![info exists Steps($To)]} {
    puts stderr "No path from \"$From\" to \"$To\"!"
    exit 5
}

proc OneCharDiff {astr bstr} {

    set diff 0

    foreach a [split $astr {}] b [split $bstr {}] {
        if {[string compare $a $b]} {
            incr diff
        }
    }

    return [expr $diff == 1]
}

set Solutions {}

proc traverse {tlist} {

    global Steps Solutions MaxTravLen To

    if {[llength $tlist] >= $MaxTravLen} {
        #
        #  Instruct the lower level call to skip out from sampling
        #    more "next step" words; they all going to breach this
        #    maximum list length.
        #
        return 1
    }

    set latest [lindex $tlist end]

    foreach next $Steps($latest) {

        #  If the new string has already been hit, try another.
        #
        if {[lsearch -exact $tlist $next] > -1} continue

        #  If the new string might have easily been arrived at earlier,
        #    try another.
        #
        set hitOCD 0
        foreach tlistcheck [lrange $tlist 0 [expr [llength $tlist] - 2]] {
            if {[set hitOCD [OneCharDiff $tlistcheck $next]]} break
        }
        if {$hitOCD} continue

        set nextTlist [concat $tlist [list $next]]

        if {![string compare $next $To]} {
            #
            #  Got one!  First, update the MaxTravLen; no use looking
            #    for other solutions longer than this one....
            #
            set MaxTravLen [llength $nextTlist]

            #  Now; throw 'er on the pile!
            #
            puts $nextTlist
            lappend Solutions $nextTlist

            #  Note that we're flagging a return from a successful find.
            #
            return 1
        }

        if {[traverse $nextTlist]} {
            #
            # Note that, by getting a TRUE value back from our
            #   recursive call, we know we've either just come back from
            #   a successful call (having hit our target, "$To"), or one
            #   in which further attempts are futile, because we've
            #   breached the maximum list length.
            #
            # In either case, this means that we are not going to
            #   find any additional solutions at this level, and can,
            #   nay should, jump out of this loop and proceed from a
            #   lower level.
            #
            break
        }
    }

    #  Note that we're flagging a return from an UNsuccessful find.
    #
    return 0
}

puts stderr {Now seeking solutions.}

traverse [list $From]

exit 0