use strict;

open(FIL,"prob98data.txt");
my $txt = <FIL>;
close(FIL);

my @words = split(",", $txt);
@words = map { $_ =~ s/\"//g; $_ } @words;

my %anagrampossibilities = ();
# use sorted hash sets to find anagrams
foreach my $word (@words)
{
        my $sortedword = join('', sort(split('',$word)));
        push (@{$anagrampossibilities{$sortedword}}, $word) if (length($sortedword) <= 10);
}

my @anagramwords = ();
# reduce against the hash set.  also throw a warning if >2 match, just in case
foreach my $k (keys (%anagrampossibilities))
{
        my @v = @{$anagrampossibilities{$k}};
        push (@anagramwords, $k) if ($#v > 0);
        print "WARNING!  " . ($#v + 1) . " in $k\n" if ($#v > 1);
}

print "Found " . ($#anagramwords + 1) . " anagram words...\n";

# now, perform the character substitution
my $largest = 0;
foreach my $anagram (@anagramwords)
{
        my @wordset = @{$anagrampossibilities{$anagram}};
        my $basewordsubstitute = $anagram;
        $basewordsubstitute =~ s/([a-z])(\1+)/$1/g; #make sure we don't have duplicates
        my $i;
        #my $c = substr($basewordsubstitute, $i, 1);
        my $c = $basewordsubstitute;
        my $c2 = $c;
        my $b = &recurse($c, $c2, $wordset[0], $wordset[1]);
        $largest = $b if ($b > $largest);
        print "Largest: $largest\n";
}

sub recurse
{
        my ($chars, $origchars, $word1, $word2) = @_;
        my $j;
        my $biggest = 0;
        my $oldchars = $chars;
        foreach ($j = 0; $j < 10; $j++)
        {
                next if ($oldchars =~ $j);
                $chars = $oldchars;
                if ($chars =~ s/([A-Z])/$j/i)
                {
                        my $maybefirstchar = $1;
                        if (! ($j == 0 && ($word1 =~ m!^$maybefirstchar!i || $word2 =~ m!^$maybefirstchar!i)))
                        {
                                if ($chars =~ m![a-z]!i)
                                {
                                        #make a copy of the variables to avoid the pass-by-reference problem
                                        my ($v1, $v2, $v3, $v4) = ($chars, $origchars, $word1, $word2);
                                        my $retval = &recurse($v1, $v2, $v3, $v4);
										$biggest = $retval if ($retval > $biggest);
                                }
                                else
                                {
                                        # we've hit the end of the recursion, test squarness
                                        my ($rword1, $rword2) = ($word1, $word2);
                                        eval "\$rword1 =~ tr/$origchars/$chars/;";
                                        eval "\$rword2 =~ tr/$origchars/$chars/;";
                                        my ($sword1, $sword2) = (sqrt($rword1), sqrt($rword2));
                                        if ($rword1 !~ m!^0! && $rword2 !~ m!^0!
                                            && abs($sword1 - int($sword1)) < 0.00000001 && abs($sword2 - int($sword2)) < 0.00000001)
                                        {
                                                print "Found square pairs!  $word1 [$rword1] <-> $word2 [$rword2] ($origchars -> $chars)\n";
                                                $biggest = $rword1 if ($rword1 > $biggest);
                                                $biggest = $rword2 if ($rword2 > $biggest);
                                        }
                                }
                        }
                }
        }
        return $biggest;
}