Re^3: Comparing Lines within a Word List

[clueless newbie]

Here you go ... more comments:

#!/usr/bin/env perl

use strict;
use warnings;
use Data::Dumper;
use Time::HiRes qw(time);

die <<"__DOC__"

    perl $0 <dictionary file name> [<optional character> [<option swap
+>]]

so

    perl $0 <dictionary file name> R S

will solve the problem as stated in the OP and

    perl $0 <dictionary file name>

will try all of the pairs. (note that they are symmetrical ie r-s and 
+s-r will be the same)

__DOC__
    unless (@ARGV);
# Get all the words into an array
open(my $DATA,'<',$ARGV[0])
    or die "Couldn't open '$ARGV[0]' for reading! $!";
my @all=<$DATA>;
close($DATA)
    or die "Couldn't close '$ARGV[0]' after reading! $!";
chomp(@all);
# @all now holds all of the words from the dictionary specified by $AR
+GV[0]

my $start=time();
my %counts;
for my $R ($ARGV[1] || ('a'..'y')) { # Take $ARGV[1] or the letters fr
+om a to y (no point to doing z) one at a time
    my $count=0;
    for my $S ($ARGV[2] || (chr(ord($R)+1)..'z')) { # Take $ARGV[2] or
+ the letters following $R one at a time
        my $re=qr{[$R$S]};
        # Filter out everything that isn't relevant
        # (if it doesn't have $R or $s it can't be a word to be altere
+d or a word after alteration)
        my @candidates=grep{ m{$re} } @all;
        # Order them by length (no use comparing a 4 letter word with 
+a 5 letter word)
        @candidates=sort{ length $a <=> length $b } @candidates;
        # Put a guard at the end of the array - to trigger the "comple
+tion"
        push @candidates,'';


        my %hash;
        # Something to count up the number of matches
        my $count;
        # Initialize $length by setting it to length of the first word
+ (failure to do this is of no consequnce!)
        my $length=length $candidates[0];
        for my $word (@candidates) {
            unless (length($word) == $length) { # Current word is of d
+ifferent length - so we need to process everything already in the has
+h
                for my $Rword (grep { m{r} } keys %hash) { # Word has 
+a $R
                    my $pos=0;
                    while (($pos=index($Rword,'r',$pos)) >= 0) { # Fou
+nd a $R in $Rword
                        # Make its S equivalent
                        my $Sword=$Rword;
                        substr($Sword,$pos,1)='s';
                        # Increment $count if $Sword appears in the ha
+sh
                        $count++
                            if (exists $hash{$Sword});
                        # Need to look for the next $R so $pos must be
+ incremented
                        $pos++
                         }
                     }
                # Done with this hash --- so recycle it (hey I'm green
+! --- or really I date back to machines that only had 10,000 digits!)
                %hash=();
                # A new length
                $length=length($word);
                 };
            $hash{$word}=undef;
             };
        #warn "$R-$S: ",$count;
        # Save our count
        $counts{"$R-$S"}=$count;
         };
     };
# All done - see how long all this took
my $end=time();
printf("%.2f\n", $end-$start);
# Dump the counts hash --- but we want the keys in sorted order
$Data::Dumper::Sortkeys=1;
print Data::Dumper->Dump([\%counts],[qw(*counts)]);
# All done
exit;

__DATA__