# Use of uninitialized value, <DICT> chunk 41.
File 'untitled:Desktop Folder:Will's Stuff:Applications:MacPerl ƒ:add-a-gram redux'; Line 15
# Use of uninitialized value, <DICT> chunk 41.
File 'untitled:Desktop Folder:Will's Stuff:Applications:MacPerl ƒ:add-a-gram redux'; Line 16
##</code><code>##

#!/usr/bin/perl -w
use strict;
my ($dict, $adda, $line, @words, $word, %wordpl, $k, @lengths, $l, @addw, $oword, $lo, $i, %wordr);
$dict="<untitled:Desktop Folder:WORD.LST";

####
#Open the dictionary file and Create a hash (%wordpl) of a hash,
#where each key in 2nd hash is the same length, and the keys for
#the 1st hash represent those lengths
####

open (DICT, $dict) or die ("Can't open $dict: $!\n");
while (<DICT>) {
    chomp;
    push @{ $wordr{sort {lc($a) cmp lc($b)} $_} }, $_;
    $wordpl{length()}{sort {lc($a) cmp lc($b)} $_}++;
}
close (DICT);

####
#Read the keys of %wordpl, i.e. the lengths of the elements in the 2nd hash
#in descending order Start a loop where $_ is the length, or the key,
#for %wordpl.
####

foreach (sort { $b <=> $a } keys %wordpl) {
    push (@addw, word(%wordpl, $_, $oword, @addw));
}

####
#Start a loop where you pick the a word in keys %{ $wordpl{$l} }
#and pass that word and $l-1 (index of hash 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 ( keys %{ $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 hash 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 ( keys %{ $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 hash 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 ( keys %{ $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;
        }
    }
}

####
#print all the anagrams
####

foreach $i (@addw) {
    foreach $lo (@{ $wordr{$i} }) {
        print "$lo\n";
    }
}