#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

use 5.010;

$| = 1;

my %words;
my %sorted;
my %alphabet;
while(defined(my $line = <>)) {
    chomp $line;
    next if $line =~ /%$/;    # ignore entries with '%' at the end
    my $slot = length $line;
    $line = lc $line;
    next if $slot > 8;
    next if exists $words{$line};
    $words{$line} = 1;
    my @chars = sort split //, $line;
    %alphabet = (%alphabet, map { $_ => 1 } @chars);
    my $characters = join('', @chars);
    if(defined $sorted{$characters}) {
        push @{$sorted{$characters}}, $line;
    }
    else {
        $sorted{$characters} = [$line];
    }
}
my @sorted = keys %sorted;
say "Base: " . scalar @sorted . " unique words";

my @alphabet = sort keys %alphabet;

my $word;
my $count = @alphabet;
my $permutations = 0;
my %found;
my $max_found = 0;
foreach (my $pos1 = 0; $pos1 < $count; $pos1++) {
    foreach (my $pos2 = 0; $pos2 < $count; $pos2++) {
        next if $pos2 < $pos1;
        foreach (my $pos3 = 0; $pos3 < $count; $pos3++) {
            next if $pos3 < $pos2;
            foreach (my $pos4 = 0; $pos4 < $count; $pos4++) {
                next if $pos4 < $pos3;
                foreach (my $pos5 = 0; $pos5 < $count; $pos5++) {
                    next if $pos5 < $pos4;
                    foreach (my $pos6 = 0; $pos6 < $count; $pos6++) {
                        next if $pos6 < $pos5;
                        foreach (my $pos7 = 0; $pos7 < $count; $pos7++) {
                            next if $pos7 < $pos6;
                            foreach (my $pos8 = 0; $pos8 < $count; $pos8++) {
                                next if $pos8 < $pos7;
                                # Check what can be produced by this combination
                                $permutations++;
                                say $permutations if $permutations % 1000 == 0;
                                my %source;
                                $source{$_}++ for(@alphabet[$pos1, $pos2, $pos3, $pos4, $pos5, $pos6, $pos7, $pos8]);
                                #say "===========================================";
                                #say "Source: ". Dumper(\%source);
                                my @last;
                                my $source;
                                INNER: foreach my $word (@sorted) {
                                    #say "Word: $word";
                                    my %source_copy = (%source);
                                    for(my $i = 0; $i < length $word; $i++) {
                                        my $c = substr($word, $i, 1);
                                        next INNER unless $source_copy{$c};
                                         $source_copy{$c}--;
                                    }
                                    $source = join '', @alphabet[$pos1, $pos2, $pos3, $pos4, $pos5, $pos6, $pos7, $pos8];
                                    #say join(', ', @{$sorted{$word}}) . "' can be produced by '$source'";
                                    push @last, @{$sorted{$word}};
                                }
                                # something found which can be produced
                                if(@last) {
                                    if(@last > $max_found) {
                                        %found = ();
                                        $found{$source} = [@last];
                                        $max_found = @last;
                                    }
                                    elsif (@last == $max_found) {
                                        $found{$source} = [@last];
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
    }
}

say "Found. $permutations out of $count unique characters";
say Dumper(\%found);