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__
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|