The 11/23/2003 NPR Weekend Edition Sunday puzzler was (roughly) as follows: take an English word that ends in -m. Replace the 'm' with -rn, and you get the antonym of the original word. What is the pair?
As I was just learning Perl at the time, I decided to test out my skills, and this is what I came up with. (The idea behind both versions is that
@solutions is small enough that I can visually pick out the true solution visually. And indeed, using
words-2-16mdk, I get only five pairs back.)
#!/usr/bin/perl
use strict;
# NPR puzzler helper, 11/23/2003
# Find a pair of words, [X]rn and [X]m, which are antonyms.
# We can pull all such pairs from /usr/share/dict/words.
open(FH,"/usr/share/dict/words");
my @big_arr;
# grep through it the slow way
while (<FH>) {
if (/([a-zA-Z]*rn$)/) {
push @big_arr, $1;
}
}
#print @big_arr;
close FH;
# there's got to be a better way to do this.
my @solutions;
#print "|all_words| = ".$#all_words."\n";
my $curr_word;
foreach (@big_arr) {
$curr_word = substr($_,0,-2)."m";
my $cmd = 'grep ^'.$curr_word.'$ /usr/share/dict/words';
my $result = `$cmd`;
if ($result) {
push @solutions, "$_ / $curr_word\n";
}
}
close FH;
print @solutions;
Makes me cringe just to look at it. Yes, I first find every -rn word in the dictionary, then check each and every one of them by grepping (externally, no less!) through the whole dictionary again. Brain-damaged, to say the least. But it worked, and I got the puzzler.
I came back to it a little while later, to make it at least seem smarter. This time, I decided to first pluck out all of the -rn words, then walk through the dictionary a second time, taking advantage of the fact that
@rn_words is already sorted---for instance, there's no point in seeing if 'spurn' has a counterpart in the dictionary if we're already in the t's.
#!/usr/bin/perl
use strict;
# NPR puzzler helper, 11/23/2003
# rewritten 12/15/2003 around 4 am.
# Find a pair of words, [X]rn and [X]m, which are antonyms.
# We can pull all such pairs from /usr/share/dict/words.
open(FH,"/usr/share/dict/words");
my (@rn_words, @solutions);
@rn_words = grep /([a-zA-Z]*rn$)/, <FH>;
chomp(@rn_words);
seek FH,0,0;
my $ptr = 0;
my $this = substr($rn_words[$ptr],0,-2).'m';
LOOP: while (<FH>) {
chomp;
next LOOP if ($_ lt $this);
if ($_ eq $this)
{ push @solutions, "$rn_words[$ptr] / $_\n"; }
$ptr++;
$this = substr($rn_words[$ptr],0,-2).'m';
last unless defined $rn_words[$ptr];
}
close FH;
print @solutions;
I'm pretty sure that two is the mininum number of times the dictionary can be traversed. I considered trying to remember the last -m word seen, and waiting for the corresponding -rn word to see if it existed... but this didn't really work out.
I wonder if there's a good way to benchmark the efficiency of these approaches, since both run quickly on my system, though the second feels a little faster. More importantly, I'm not ashamed of the second one. How quickly we improve.