#!/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