#! /bin/bash # \ export TCL_LIBRARY=$HOME/tcl/lib/tcl ; \ exec /usr/local/bin/tclsh $0 "$@" array set Env \ [list \ {wlFile} {h:/TclStuff/wordhash.tcl} \ {fixfmt} {h:/TclStuff/fixarray_%02d.tcl} \ {alpha} {abcdefghijklmnopqrstuvwxyz} \ {minsize} 2 \ {maxsize} 15 \ {defsize} 5 \ {debug} 0 \ ] # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # First, check for a parameter # if {[string length [set Size [lindex $argv 0]]]} { # There will be no "Starter": # set Starter 0 # # Yes. Is it an integer? # if {[catch {incr Size}]} { # # No. # puts stderr "Parameter must be an integer (not \"$Size\"!)" exit 2 } # Readjust downward. # incr Size -1 # Is the size big enough? # if {$Size < $Env(minsize)} { # # No. # puts stderr \ "Parameter must be greater than or equal to $Env(minsize)!" exit 3 } # Is the size small enough? # if {$Size > $Env(maxsize)} { # # No. # puts stderr \ "Parameter must be smaller than or equal to $Env(maxsize)!" exit 4 } } else { regsub -all -- {-} [info hostname] {} FirstWordFile append FirstWordFile {.txt} set Env(start) \ [expr { [catch {open $FirstWordFile} fwfCHAN] ? {} : [lindex [gets $fwfCHAN] 0] }] if {[set Starter [string length $Env(start)]]} { # # Use the "start" word size as the square size. # set Size $Starter # If the User hasn't set a debug level, we'll set it to 1 # so they can monitor their progress. # if {!$Env(debug)} { set Env(debug) 1 } } else { # # Use the default size. # set Size $Env(defsize) } } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Create indent array (if we're debugging). # if {$Env(debug) == 2} { for {set n 0} {$n < ($Env(maxsize) + 2)} {incr n} { set dent($n) {} for {set m 0} {$m < $n} {incr m} { append dent($n) [format {%2d } $m] } } } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # First, try to read the fixarray file. # if {[catch {source [format $Env(fixfmt) $Size]}]} { # # Whoop! We failed. Maybe you should run "genfixarray" for this Size. # # Read the word list file. # puts -nonewline stderr {Reading word hash file...} flush stdout source $Env(wlFile) puts stderr {Done.} set SizeMinOne [expr $Size - 1] # Process the associative array for our purposes. # foreach {ix dat} [array get wordhash] { # We only want to collect words of the correct length. # Is this one? # if {[string length $ix] != $Size} \ continue # Yes, it is. # # Create an array mapping all prefixes to their source words. # foreach aword $dat { for {set n 0} {$n < $SizeMinOne} {incr n} { lappend fixarray([string range $aword 0 $n]) $aword } } } # Get rid of the original (humungous) array to conserve memory. # unset wordhash # Order the words in the prefix array. # puts -nonewline stderr {Ordering prefix array...} flush stdout foreach {ix dat} [array get fixarray] { set fixarray($ix) [lsort $dat] } puts stderr {Done.} } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Here's our recursive procedure that finds the next possible words in our # square. # proc NextWord {squareList} { global Env Size fixarray Starter set len [llength $squareList] switch -exact $Env(debug) { 1 { if {$len == 1} { puts stderr $squareList } } 2 { global dent # Debug info # puts stderr "$dent([info level])[lindex $squareList end]" } } if {$len == 0} { # # Just starting. # # First; is there a "starting point" (Env(start))? # if {$Starter} { # # Yes. Clip the alpha string. # set Env(alpha) \ [string range $Env(alpha) \ [string first [string index $Env(start) 0] $Env(alpha)] \ end] } # Just starting. Loop over the alphabet. # set Start 1 foreach letter [split $Env(alpha) {}] { # # Loop over all words in prefix array for this letter. # Note that this eventually tries *every* word # (of requisite length, that is). # # Are there any words beginning with this letter? # if {[catch {set fixarray($letter)} wlist]} \ continue # Yes. Get on with it. # puts stderr ">>>>>>>>>>> $letter ([llength $wlist])" # Do we need to start in the middle of the wordlist? # if {$Start && $Starter} { # # Yes. First, turn off the "start" bit; we won't be # needing to do this again. # set Start 0 # Now, clip the wlist. # if {[set ix [lsearch -sorted $wlist $Env(start)]] == -1} { puts stderr "Start parameter \"$Env(start)\" not found!" exit 5 } set wlist [lrange $wlist $ix end] } foreach aword $wlist { NextWord $aword } } } elseif {$len == $Size} { # # List parameter is of our target length; we have a solution! # Print it, and return. # puts {} puts [string toupper [join $squareList \n]] puts {} } else { # # Incomplete solution, needing more words; are there any? # Let's find out. # # First, create the prefix key which will, of necessity, limit # the words that can be used in the next position. # set key {} foreach aword $squareList { append key [string range $aword $len $len] } # We have our prefix key. But; are there any words in our # wordlist beginning with this key? # if {[catch {set fixarray($key)} nextwords]} \ return # Yes! Let's tack them, one-by-one, to our solution list # and recursively call this proceedure to continue our # discovery process. # foreach aword $nextwords { NextWord [concat $squareList [list $aword]] } } return } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Our initial call to begin finding solutions. # NextWord {} exit 0