#!/usr/bin/perl
use warnings;
use strict;
use feature qw(say);


my %lc_words;
my $dict = shift;
my $FH;
open $FH, '<', $dict or $FH = *DATA;

while (<$FH>) {
    chomp;
    next if length > 8;
    my $lc = lc;
    $lc_words{$lc} = 1;
}
say scalar keys %lc_words;

my %sorted_count;

for (keys %lc_words) {
    my @letters = sort split //;
    my $sorted  = join q(), @letters;
    $sorted_count{$sorted}++;
}
say "$_: $sorted_count{$_}"
    for sort { $sorted_count{$a} <=> $sorted_count{$b} }
        keys %sorted_count;

print '-' x 78, "\n";

my %summed = %sorted_count;
for my $length (1 .. 7) {
    warn $length;
    for my $sorted (grep $length == length, keys %sorted_count) {
        my $regex = join '.*', split //, $sorted;
        for my $longer (grep $length < length, keys %sorted_count) {
            $summed{$longer} += $sorted_count{$sorted} if $longer =~ $
+regex;
        }
    }
}

say "$_: $summed{$_}"
    for sort { $summed{$a} <=> $summed{$b} }
        keys %summed;
__DATA__
ffffffff
fffffffa
afffffff
bfffffff
fffffffb
ffffbfff
a
aa
aaa
aaaa
aaaaa
aaaaaa
[download]