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

[Coruscate]

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

[grendelkhan]

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!

[Coruscate]

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};
}

[Abigail-II]

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

Abigail

[Coruscate]

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.