#!/usr/bin/perl

use 5.16.2;
use warnings;

say "Reading ...";
my %magic;
my %stats;
open   my $fh, "<", "/usr/share/dict/words";
while (<$fh>) {
    lc =~ m/^([a-z]{1,8})$/ or next;
    my $key = pack "(A)*", sort unpack "(A)*", $1;
    my $l = length $key;
    $magic{$key}{len} //= $l;
    $magic{$key}{cnt}++;
    push @{$magic{$key}{words}}, $1;
    $stats{$l}++;
    }
say "   length $_: $stats{$_}" for sort { $b <=> $a } keys %stats;
say "Extending 7 ...";
foreach my $w7 (grep { $magic{$_}{len} == 7 } keys %magic) {
    #$magic{$w7.$_} //= { len => 8, cnt => 0, words => [] } for "a" .. "z";
    }
say "Preparing ...";
my %x8;
foreach my $key (keys %magic) {
    my $l = length $key;
    if ($l == 8) {
        $magic{$key}{ext}[$_] = [] for 1 .. 7;
        my $x8 = join "" => map "$_?" => unpack "(A)*" => $key;
        $x8{$key} = qr{^$x8$};
        next;
        }
    push @{$stats{key}[$l]}, $key;
    }
my @k8 = keys %x8;
my $n8 = @k8;
say "Prepared $n8";
foreach my $k8 (@k8) {
    --$n8 % 10 == 0 and print STDERR " $n8 \r";
    my $x8 = $x8{$k8};
    foreach my $l (reverse 1 .. 7) {
        foreach my $key (grep m/$x8/ => @{$stats{key}[$l]}) {
            push @{$magic{$k8}{ext}[$l]}, $key;
            $magic{$k8}{cnt} += $magic{$key}{cnt};
            }
        }
    }

say "Sorting ...";
my @top = sort { $magic{$b}{cnt} <=> $magic{$a}{cnt} } keys %magic;
for (@top[0..19]) {
    printf "%6d %-8s %s\n", $magic{$_}{cnt}, $_, $magic{$_}{words}[0];
    }

my $best = $top[0];
say $magic{$best}{cnt}, " ", $best;

sub showfirst
{
    my ($l, $w) = @_;
    $w = substr $w, 0, 80 or return;
    $w =~ s/ \w+$//;
    say "$l $w";
    } # showfirst

showfirst ($magic{$best}{len}, join " " => sort @{$magic{$best}{words}});

foreach my $l (reverse 1 .. 7) {
    my @w = map { @{$magic{$_}{words}} } @{$magic{$best}{ext}[$l]};
    showfirst ($l, join " " => sort @w);
    }