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

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

Replies are listed 'Best First'.
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
    Abigail

      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.

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!

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