#!/usr/local/bin/perl # subanagram.pl # This program receives as input an English word, and then # delivers as output those English words which can be spelled with the # letters in the input word. # This script is Copyleft 2002 by Mitchell Szczepanczyk under the # terms of the General Public License. Anyone is free to copy, modify, # or distribute this script, without warranty, under the terms that any # copy or copies of this script also fall under the terms of the # General Public License. my ($x, $eachword, $okay, $subcounter, $counter, @letarray1, @letarray2, %wordcounts); %letnum = (a => "0", b => "1", c => "2", d => "3", e => "4", f => "5", g => "6", h => "7", i => "8", j => "9", k => "10", l => "11", m => "12", n => "13", o => "14", p => "15", q => "16", r => "17", s => "18", t => "19", u => "20", v => "21", w => "22", x => "23", y => "24", z => "25", 0 => "26", 1 => "27", 2 => "28", 3 => "29", 4 => "30", 5 => "31", 6 => "32", 7 => "33", 8 => "34", 9 => "35", '-' => "36", A => "0", B => "1", C => "2", D => "3", E => "4", F => "5", G => "6", H => "7", I => "8", J => "9", K => "10", L => "11", M => "12", N => "13", O => "14", P => "15", Q => "16", R => "17", S => "18", T => "19", U => "20", V => "21", W => "22", X => "23", Y => "24", Z => "25"); my ($num_hash) = 37; my ($word_input) = param ("word"); use CGI qw(:standard); use Sys::Hostname; print "Content-type: text/html\n\n"; print < Sub-Anagram Generator: Result for $word_input

Sub-Anagram Generator: Result for "$word_input"\n

ENDDOC $counter = 0; # Assign the letters in the input word to a hash. for ( $x=0; $x < length $word_input ; $x++) { $letarray1[$letnum{substr($word_input, $x, 1)}]++; } open(WORDS, "/usr/dict/words"); # For each word in the dictionary... while () { $okay = 0; chomp $_; # Clear the values in a second hash for ($x=0; $x < $num_hash; $x=$x+1) { $letarray2[$x] = 0; } # Assign the letters in the current word to that second hash for ($x=0; $x < length($_); $x++) { $letarray2[$letnum{substr($_, $x, 1)}]++; } # Compare the two hashes for ($x=0; $x < $num_hash; $x++) { if (($letarray2[$x] > 0) && ($letarray1[$x] > 0)) { if ($letarray2[$x] <= $letarray1[$x]) { $okay = $okay + $letarray2[$x]; # The above line was fixed, 12/8/2002 } } } # If there's a match, put the word in a separate array. if ($okay == length($_)) { push (@{$wordcounts{$okay}}, $_); $counter++; } } # Print out stuff: print each word and affiliated statistics. foreach $x (sort keys %wordcounts) { $subcounter=0; if ($x == 1) { print "Words that are 1 letter long:
"; } else { print "Words that are $x letters long:
"; } foreach $eachword (sort @{$wordcounts{$x}}) { print "$eachword
"; $subcounter++; } print "Number of $x-letter words: $subcounter

"; } print "

$counter total words were found in the word '$word_input'.
"; close(WORDS); print < Find subanagrams for another word.
This page was dynamically generated by a script written by Mitchell Szczepanczyk. ENDDOC # end subanagram.pl