msszczep/subanagram.pl

## subanagram.pl
#!/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 <<ENDDOC;
<HTML>
<HEAD>
<TITLE>Sub-Anagram Generator: Result for $word_input</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF"><P>
<H1>
Sub-Anagram Generator: Result for "$word_input"\n
</H1>
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 (<WORDS>) {

    $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 "<B>Words that are 1 letter long:</B><BR>";
    } else {
	print "<B>Words that are $x letters long:</B><BR>";
    }
    foreach $eachword (sort @{$wordcounts{$x}}) {
	print "$eachword<BR>";
	$subcounter++;
    }
    print "Number of $x-letter words: <B>$subcounter</B><P><P>";
}

print "<P><B>$counter</B> total words were found in the word '$word_input'.<BR>";

close(WORDS);

print <<ENDDOC;
<HR>
<A HREF="http://home.uchicago.edu/~msszczep/subanagram.html">Find subanagrams for another word</A>.<BR>
This page was dynamically generated by a script written by <A HREF="http://home.uchicago.edu/~msszczep/index.html">Mitchell Szczepanczyk</A>.
</BODY></HTML>
ENDDOC
# end subanagram.pl
	#!/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 <<ENDDOC;
	<HTML>
	<HEAD>
	<TITLE>Sub-Anagram Generator: Result for $word_input</TITLE>
	</HEAD>
	<BODY BGCOLOR="#FFFFFF"><P>
	<H1>
	Sub-Anagram Generator: Result for "$word_input"\n
	</H1>
	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 (<WORDS>) {

	$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 "<B>Words that are 1 letter long:</B><BR>";
	} else {
	print "<B>Words that are $x letters long:</B><BR>";
	}
	foreach $eachword (sort @{$wordcounts{$x}}) {
	print "$eachword<BR>";
	$subcounter++;
	}
	print "Number of $x-letter words: <B>$subcounter</B><P><P>";
	}

	print "<P><B>$counter</B> total words were found in the word '$word_input'.<BR>";

	close(WORDS);

	print <<ENDDOC;
	<HR>
	<A HREF="http://home.uchicago.edu/~msszczep/subanagram.html">Find subanagrams for another word</A>.<BR>
	This page was dynamically generated by a script written by <A HREF="http://home.uchicago.edu/~msszczep/index.html">Mitchell Szczepanczyk</A>.
	</BODY></HTML>
	ENDDOC
	# end subanagram.pl