use Modern::Perl qw/2015/;
use List::MoreUtils qw/zip natatime/;
use autodie;

open( my $DICT, '<', './wordsEn.txt' ) or die "Could not open dictionary - $!";
my @dict;
print scalar <$DICT>; # show copyright message of word list

# step 1: sort the dictionary into bins per length of the word
while ( my $word = <$DICT> ) {
    chomp $word;
    next unless $word;
    push @{ $dict[ length $word ] }, $word;
}
close $DICT;

# step 2: for each bin look for words that differ in one place only
my %results;
for my $length ( 2 .. @dict - 1 ) {
    next unless $dict[$length]; # skip if no words of this length
    my @bin = @{ $dict[$length] };
    next if @bin < 2; # skip if only one word of this length
    say "*********** Testing words of length $length ***********";
    while ( my ( $index, $test ) = each @bin ) {
        for my $check ( @bin[ $index + 1 .. @bin - 1 ] ) {
            my $diff = $test ^ $check;
            if ( 1 == $diff =~ tr/\x00//c ) { # only one character different
                # find which characters are different
                my @first  = split '', $test;
                my @second = split '', $check;
                my @test = zip @first, @second;
                my $it = natatime 2, @test;
                while ( my @vals = $it->() ) {
                    next if $vals[0] eq $vals[1];
                    my $key =
                      $vals[0] lt $vals[1]
                      ? "$vals[0]$vals[1]"
                      : "$vals[1]$vals[0]";
                    push @{ $results{$key} }, "$test - $check"; # save in hash
                    last;
                }
            }
        }
    }
}

say "Now writing results";
open( my $RESULTS, '>', './results.txt' ) or die "Cannot open output file $!";
for my $key ( sort keys %results ) {
    say $RESULTS "***** $key *****";
    for my $words ( sort @{ $results{$key} } ) {
        say $RESULTS "\t$words";
    }
}
close $RESULTS;