#! perl -slw
use strict;
use Time::HiRes qw[ time ];

my $start = time;

my @lookup = map{ ($_+1) * $_ /2 } 0 .. 80;
sub calcScore {
    my( %chars, $score );
    $chars{ $_ }++ for map{ split'' } @{ $_[0] };
    $score += $lookup[ $_ ] for values %chars;
    return $score;
}

my @cats = map{ [ split ' ' ] } <DATA>;
close DATA;

## Sort the words in each category by their individual scores (descending)
my %wordScores;
@{ $cats[ $_ ] } = sort{
    ( $wordScores{ $b } ||= calcScore [$b] )
    <=>
    ( $wordScores{ $a } ||= calcScore [$a] )
} @{ $cats[ $_ ] } for 0 .. $#cats;

## form our guess from the highest scoring words in each category
my @guess = map{ $cats[ $_ ][ 0 ] } 0 .. $#cats;
my $best = calcScore \@guess;

##</code><code>##

my (@candidate, %freq);
while (<DATA>) {
    chomp;
    my @list = split ' ';
    push @candidate, \@list;
    for my $word (@list) {
        ++$freq{$_} for split //, $word;
    }
}
my $tot = sum(values %freq);
$freq{$_} = ($freq{$_} / $tot) * 100 for keys %freq;

my (@solution, %let);
for my $list (@candidate) {
    my ($best, $item) = (0, '');
    for my $word (@$list) {
        my $score = sum(map $freq{$_}, split //, $word);
        ($best, $item) = ($score, $word) if $score > $best;
    }
    ++$let{$_} for split //, $item;
    push @solution, $item;
}
my $total = sum(map {my $n = $let{$_}; ($n * $n + $n) / 2} keys %let);
print "$total : [ @solution ]\n";

##</code><code>##

my (@candidate, %freq);
while (<DATA>) {
    chomp;
    my @list = split ' ';
    push @candidate, \@list;
    for my $word (@list) {
        ++$freq{$#candidate}{$_} for split //, $word;
    }
}

for my $idx (keys %freq) {
    my $tot = sum(values %{$freq{$idx}});
    for my $let (keys %{$freq{$idx}}) {
        $freq{$idx}{$let} = ($freq{$idx}{$let} / $tot) * 100;
    }
}

for my $let ('a' .. 'z') {
    my $val = 0;
    for my $idx (0 .. $#candidate) {
        $val += $freq{$idx}{$let} if $freq{$idx}{$let};
    }
    $freq{$let} = $val;
}

my (@solution, %let);
for my $list (@candidate) {
    my ($best, $item) = (0, '');
    for my $word (@$list) {
        my $score = sum(map $freq{$_}, split //, $word);
        ($best, $item) = ($score, $word) if $score > $best;
    }
    ++$let{$_} for split //, $item;
    push @solution, $item;
}
my $best = sum(map {my $n = $let{$_}; ($n * $n + $n) / 2} keys %let);
print "$best : [ @solution ]\n";

##</code><code>##

## Loop over the categories swaping the other words in that cateory 
## for the guessed word. If we get a better score, start again.
LOOP:
for my $iCat ( 0 .. $#cats ) {
    my $cat = $cats[ $iCat ];
    for my $iWord ( 1 .. $#$cat ) {
        my $test = calcScore [ 
            @guess[ 0 .. $iCat -1 ], 
            $cat->[ $iWord ], 
            @guess[ $iCat+1 .. $#guess ] 
        ];
        if( $test > $best ) {
            $best = $test;
            $guess[ $iCat ] = $cat->[ $iWord ];
            print "$best : [ @guess ]";
            redo LOOP;
        }
    }
}

##</code><code>##

my %seen;
eval {
    local $SIG{ALRM} = sub { die "Timed Out\n"; };
    alarm 60;
    my @work = [$best, \@solution];
    while (@work) {
        my $item = pop @work;
        my ($cur_best, $cur_guess) = @$item;
        for my $idx (0 .. $#candidate) {
            for my $word (@{$candidate[$idx]}) {
                my @new_guess = @$cur_guess;
                $new_guess[$idx] = $word;
                next if $seen{"@new_guess"}++;
                my $new_tot = calc_score(@new_guess);
                if ($new_tot > $cur_best) {
                    push @work, [$new_tot, \@new_guess];
                    if ($new_tot > $best) {
                        $best = $new_tot;
                        print "$best : [ @new_guess ]\n";
                    }
                }
            }
        }
    }
    alarm 0;
};