my $MIN_BEST = 2;

my @words;
my %letters_cache;
while (<DATA>) {
    my ($i, $word) = split;
    push @{$words[$i-1]}, $word;

    $letters_cache{$word}{$_} = () = $word =~ /($_)/g
        for 'a'..'z';
}

my %best;
my %skip;
for my $i (0 .. $#words) {
    for my $l ('a'..'z') {
        my $best = 0;
        $best{$l}[$i] = [];
        for my $word (@{$words[$i]}) {
            my $c = $letters_cache{$word}{$l};
            if ( $c > $best ) {
                $best{$l}[$i] = [ $word ];
                $best = $c;
            }
            elsif ( $c == $best ) {
                push @{$best{$l}[$i]}, $word;
            }
        }

        $skip{$l}++ if $best < $MIN_BEST;
    }
}

my @best_words;
my $best_score = 0;

foreach my $l ( 'a' .. 'z' ) {
    next if $skip{$l};
    my $iter = NestedLoops($best{$l});
    while ( my @w = $iter->() ) {
        @w = map { ref$_ ? @$_ : $_ } @w;
        my $score = calculate_score( @w );

        if ( $score > $best_score ) {
            $best_score = $score;
            @best_words = @w;
        }
    }
}

sub calculate_score
{
    my %letters;
    foreach my $w (@_)
    {
        my $v = $letters_cache{$w};
        while (my ($l,$n) = each %$v)
        {
            $letters{$l} += $n;
        }
    }

    # add them up.
    our ($a,$b); # get rid of warning?
    reduce { $a + calculate_letter_value($b) } 0, values %letters;
}

sub calculate_letter_value
{
    my $n = shift;
    ($n * ($n + 1)) / 2;
}
[download]