Thank you for your help. While I didnt turn on warnings, it should compile if you turn them on. I am all about learning for the other two sources posted so far, but also want to see what I can do with the code I came up with on my own. Thanks alot, and any suggestions on the new code I am posting are also extremely welcome!
use strict;
my ($dict, $adda, $line, @words, $word, %wordpl, $k, @lengths, $l, @ad
+dw, $oword, $lo, $i);
$dict="<untitled:Desktop Folder:WORD.LST";
$adda=">untitled:Desktop Folder:addagram.lst";
####
#Open the dictionary file and read each word into @words
####
open (DICT, $dict) or die ("Can't open $dict: $!\n");
while(defined($line=readline(*DICT))) {
chomp $line;
push @words, $line;
}
close (DICT);
####
#Create a hash (%wordpl) of arrays, where each element in each array i
+s
#the same length, and the keys represent those lengths
####
foreach $word (@words) {
push @{ $wordpl{length($word)} }, $word;
}
####
#Read the keys of %wordpl, i.e. the lengths of the elements in the arr
+ay
#@{ $wordpl{length($word)} } in @lengths and sort @length numerically
#in descending order
####
foreach $k (keys %wordpl ) {
push @lengths, $k;
}
@lengths = sort {$b <=> $a} @lengths;
####
#Start a loop where $l is the length, or the key, for %wordpl.
####
foreach $l (@lengths) {
@addw=word(%wordpl, $l, $oword, @addw);
}
####
#Start a loop where you pick the a word in @{ $wordpl{$l} }
#and pass that word and $l-1 (index of array of words with one
#less character then aforementioned word) to word1()
####
sub word {
my ($word, $l, %wordpl, $oword, $p, @addw, $oword);
%wordpl=$_[0];
$l=$_[1];
$oword=$_[2];
@addw=$_[3];
foreach $word ( @{ $wordpl{$l} } ) {
$oword=$word; #define original word
my $p=$l-1;
word1($p, $word, %wordpl, $l, $oword, @addw);
}
return @addw;
}
####
#Split $word from sub word into an @a, do the same for the word
#picked by WO. If the two words differ by one character, and the
#newest word ($sword) is greater then 3 characters, pass $sword
#and $p-1 (index of array of words with one less character then
#aforementioned word) to word2(). When word2() exits, exit WO
#and return to word(). If the newest word is equal to three
#characters in length, push that word into the array of
#add-a-grams and exit WO to word() to restart process
####
sub word1 {
my ($p, @a, %wordpl, $l, $sword, @b, %seen, @aonly, $item, @addw,
+$oword);
$p=$_[0];
@a=split(//,$_[1]);
%wordpl=$_[2];
$l=$_[3];
$oword=$_[4];
@addw=$_[5];
WO: foreach $sword ( @{ $wordpl{$p} } ) {
@b=split(//,$sword);
%seen = ();
@aonly = ();
@seen{@b}=();
foreach $item (@a) {
push (@aonly, $item) unless exists $seen{$item};
}
if (length(@aonly)==1) {
if ($p==3) {
push @addw, $oword;
last WO;
}
$p--;
word2($p, $sword, %wordpl, $l, $oword, @addw);
last WO;
}
}
}
####
#Split $sword from sub word1 into an @a, do the same for the word
#picked by WT. If the two words differ by one character, and the
#newest word ($sword) is greater then 3 characters, pass $sword
#and $p-1 (index of array of words with one less character then
#aforementioned word) to word1(). When word1() exits, exit WT
#and return to word(). If the newest word is equal to three
#characters in length, push that word into the array of
#add-a-grams and exit WT to word() to restart process
####
sub word2 {
my ($p, @a, %wordpl, $l, $sword, @b, %seen, @aonly, $item, @addw,
+$oword);
$p=$_[0];
@a=split(//,$_[1]);
%wordpl=$_[2];
$l=$_[3];
$oword=$_[4];
@addw=$_[5];
WT: foreach $sword ( @{ $wordpl{$p} } ) {
@b=split(//,$sword);
%seen = ();
@aonly = ();
@seen{@b}=();
foreach $item (@a) {
push (@aonly, $item) unless exists $seen{$item};
}
if (length(@aonly)==1) {
if ($p==3) {
push @addw, $oword;
last WT;
}
$p--;
word2($p, $sword, %wordpl, $l, $oword, @addw);
last WT;
}
}
}
####
#determine the longest add-a-gram and print it and the
#others to a file
####
$lo="";
foreach $i (@addw) {
if ( length($lo)<length($i) ) {
$lo=$i;
}
}
open (ADD, $adda) or die ("Cant open $adda: $!\n");
foreach $i (@addw) {
if ($i ne $lo) {
print ADD "$i\n";
} else {
print ADD "longest: $i\n";
}
}
close (ADD);