The evolution of a solution to the 11/23 NPR puzzler.

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;
[download]

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;
[download]

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.

Comment on The evolution of a solution to the 11/23 NPR puzzler. Select or Download Code

Replies are listed 'Best First'.
Re: The evolution of a solution to the 11/23 NPR puzzler. by Coruscate (Sexton) on Jan 20, 2004 at 00:05 UTC
Not only can this be made much shorter and more efficient, your second example does not actually find all valid matches. Rewritten, with only one pass through the dictioanry: `#!/usr/bin/perl -w use strict; open my $dict, '<', '/usr/share/dict/words' or die "open failed: $!"; my %words; while (<$dict>) { chomp; next unless s/(?:m\|rn)\z//; ++$words{$_}; } while (my ($word, $count) = each %words) { print "${word}rn / ${word}m\n" if $count > 1; } __END__ darn / dam morn / mom yarn / yam churn / chum modern / modem torn / tom burn / bum stern / stem` [download]	[reply] [d/l]
Re: The evolution of a solution to the 11/23 NPR puzzler. by Abigail-II (Bishop) on Jan 20, 2004 at 14:37 UTC
The following solution only passes once through the dictionary, and doesn't need an additional pass through the hash. It also stores less in the hash. It takes advantage of the fact that the dictionary is sorted, and that a word of the form `Xm` sorts before `Xrn`. #!/usr/bin/perl use strict; use warnings; my $file = "/usr/share/dict/words"; open my $fh => $file or die; my %seen; while (<$fh>) { chomp; if (/m$/) { $seen {+lc} ++; next; } elsif (/rn$/) { if ($seen {lc "$`m"}) { print "$`m/$_\n"; } next; } } __END__ bum/burn chum/churn dam/darn hom/horn modem/modern stem/stern tom/torn [download] Abigail	[reply] [d/l]
Re: The evolution of a solution to the 11/23 NPR puzzler. by Coruscate (Sexton) on Jan 20, 2004 at 21:26 UTC
Ingenious :). I'd been looking for a way to utilize the pre-sorting to my advantage but didn't come up with anything similar to this. ++Abigail-II.	[reply]
Thanks! by grendelkhan (Sexton) on Jan 20, 2004 at 02:23 UTC
As for correctness, did you try running mine? Yours gives only five results on my dictionary as well. If mine isn't capturing everything, I can't figure out why. Help? As for the differing results we got, note that I included the version of `/usr/share/dict/words` that I used; mine, for some wacky reason, doesn't contain the words 'yam', 'mom' or 'tom'. It does contain 'Tom', (not 'Mom' or 'Yam') but I was looking for improper nouns. Good catch on the case issue, though I notice your example has it as well. Eh, it's not a hard fix. The bit about using hashes is quite nifty. I was considering breaking it down to one pass, but couldn't figure out how to get it to be order-agnostic. (I was still using a single pointer in the list.) The hash neatly sidesteps all of that. Cool! I should learn to use non-capturing parentheses when I'm not snagging the output, too. Thanks!	[reply] [d/l]
Case-aware solution to the 11/23 NPR puzzler by Coruscate (Sexton) on Jan 20, 2004 at 04:01 UTC
To fix up the case sensitivity issues, we can do something like what I did here. A new rewrite of the code, will display all matches (2 or more), that follow the 'rn'/'m' rule. For example, 'stern', 'Stern', and 'stem' are all in my dictionary. S it displays all three :) `#!/usr/bin/perl -w use strict; open my $dict, '<', '/usr/share/dict/words' or die "open failed: $!"; my %words; while (<$dict>) { chomp $_; my $index = lc $_; next unless $index =~ s/(m\|rn)\z//i; push @{$words{$index}{$1}}, $_; } while (my ($index, $word) = each %words) { print join(" / ", @{$word->{rn}}, @{$word->{m}}), "\n" if $word->{rn} && $word->{m}; }` [download]	[reply] [d/l]
Re: The evolution of a solution to the 11/23 NPR puzzler. by benizi (Hermit) on Jan 20, 2004 at 14:05 UTC
Since nobody's posted a one-liner yet: `perl -lne '$_=lc; next if $d{$_}++; next unless s/(?:m\|rn)$//; print "${_}m / ${_}rn" if $h{$_}++' /usr/share/dict/words` Doesn't quite handle capitalization correctly. e.g. "bim / barn", where bim is only in as "Bim". And even though all these solutions print pairs of words... I don't see the answer. (benizi guesses he'll be kicking himself later for admitting that) Update: ++halley. (Never having heard the expression, benizi refrains from kicking himself.)	[reply] [d/l]
Re: Re: The evolution of a solution to the 11/23 NPR puzzler. by halley (Prior) on Jan 20, 2004 at 14:33 UTC
"The restless Captain paced his ship from stem to stern." From fore to aft, from front to back. -- `[ e d @ h a l l e y . c c ]`	[reply]
Re: The evolution of a solution to the 11/23 NPR puzzler. by grinder (Bishop) on Jan 20, 2004 at 14:35 UTC
Assuming you pipe the contents of a dict type file into the following script: `#! /usr/bin/perl my %stem; while( <> ) { chomp; next unless /^(.*)(?:m\|rn)$/; print "${1}m -vs- ${1}rn\n" if ++$stem{$1} == 2; }` [download] ... on FreeBSD 5.2 this produces the following: `album -vs- alburn am -vs- arn bam -vs- barn bom -vs- born bum -vs- burn chum -vs- churn cum -vs- curn dam -vs- darn dom -vs- dorn dum -vs- durn gam -vs- garn gim -vs- girn ham -vs- harn hem -vs- hern kim -vs- kirn leam -vs- learn scam -vs- scarn sham -vs- sharn stam -vs- starn stem -vs- stern swom -vs- sworn tam -vs- tarn tum -vs- turn um -vs- urn yam -vs- yarn` [download] The only trouble is... I can't figure out which pair are the antonyms (mad props to halley :-). To tell the truth, I don't even know what a "swom" is...	[reply] [d/l] [select]
Re^2: The evolution of a solution to the 11/23 NPR puzzler. by particle (Vicar) on Jan 20, 2004 at 19:59 UTC
The only trouble is... I can't figure out which pair are the antonyms ...and yet half the answer was right there in your script! `my %stem;` [download] ain't english grand? ~Particle accelerates	[reply] [d/l]