scrabble-lithp.pl

# ~/Src/Perl/scrabble.pl
Usage: scrabble.pl <words-file> <letter> [<letter> ...]
Where: <words-file> is a file of words to search.
       <letter> is a letter [a-z].
Print to STDOUT a list of words from <words-file>
  composed of only the <letter>s specified.
1# ~/Src/Perl/scrabble.pl words-file a b c
Error: Cannot open 'words-file'
Usage: scrabble.pl <words-file> <letter> [<letter> ...]
Where: <words-file> is a file of words to search.
       <letter> is a letter [a-z].
Print to STDOUT a list of words from <words-file>
  composed of only the <letter>s specified.
1# time ~/Src/Perl/scrabble.pl ~/Src/Perl/WORD.LST a mutant lisp
9: matutinal platinums stimulant tantalums
8: aluminas amiantus antismut implants lutanist misplant nuptials pantsuit platinas platinum putamina simulant staminal talisman tantalum tantalus ultimata unplaits
7: alumina alumins animals attains impalas implant laminas lattins manilas manitus mantuas manuals matinal mattins misplan mutants napalms nuptial palmist pastina patinas paulins pinatas pitmans plaints plasmin platans platina pulsant salpian saltant saltpan spatial spatula spinula stamina sultana sunlamp taipans tampans tatamis timpana tsunami ulpanim ultimas unplait unspilt unsplit uptilts
6: alants alumin alumna alumni ampuls amusia animal animas animus aslant atmans attain autism impala inputs instal insult lamias lamina lampas lanais lapins lattin lauans lianas limans limpas linums litmus lumina lupins lutist manats manias manila manitu mantas mantis mantua manual matins mattin miauls milpas muslin mutant napalm nasial paints paisan palais pastil patina patins paulin pausal pilaus pinata pintas pitman plains plaint plaits plants plasma platan pliant ptisan salami salina sampan smalti spinal spital splint statal sultan sunlit taints taipan tamals tampan tanist tatami taunts titans titman tulips ulamas ulpans ultima uptilt
5: alans alant alias alist almas alums amain amias amins amnia ampul anils anima anlas antas antis apian ataps atilt atlas atman atmas aunts inapt input lamas lamia lamps lanai lapin lapis lauan liana liman limas limns limpa limps lints linum litas lumps lunas lunts lupin mails mains maist malts manas manat mania manta manus matin matts mauls mauts miaul milpa milts minas mints minus mitts munis mutts nails nasal natal nipas pails pains paint paisa palms pants pasta patin pians pilau pilus pimas pinas pinta pints pitas plain plait plans plant plasm plats plums psalm pulis pumas punas punts putti putts saint salmi salpa satin sault sauna situp slain slant slipt slump smalt snail spail spait spilt splat split sputa stain stamp stilt stint stump stunt stupa suint sutta tails tains taint talas talus tamal tamis tamps tapas tapis taunt tauts tilts tints titan tulip tumps tunas ulama ulans ulnas ulpan unais unapt units unlit until uplit
4: aals ails aims ains aits alan alas alit alma alms alps alts alum amas amia amin amis amps amus anal anas anil anis ansa anta anti ants anus atap atma aunt imps lain lama lamp lams laps last lati lats lima limn limp lins lint lipa lips lisp list lits litu lump lums luna lunt lust mail main malt mana mans maps mast mats matt maul maun maut mils milt mina mint mist mitt muni muns must muts mutt nail naps nils nims nipa nips nits nuts pail pain palm pals pams pans pant past pats pial pian pias pima pina pins pint pita pits plan plat plum plus pula puli puls puma puna puns punt puts putt sail sain salp salt samp sati saul sial silt sima simp slam slap slat slim slip slit slum slut smit smut snap snip snit spam span spat spin spit spun stat stum stun suit sump tail tain tala tali tamp tams tans tapa taps tats taus taut tils tilt tins tint tips tits tuis tump tuna tuns tups tuts ulan ulna umps unai unit upas utas
3: aal aas ail aim ain ais ait ala alp als alt ama ami amp amu ana ani ant apt asp att imp ins ism its lam lap las lat lin lip lis lit lum man map mas mat mil mis mun mus mut nam nap nil nim nip nit nus nut pal pam pan pas pat pia pin pis pit piu psi pul pun pus put sal sap sat sau sim sin sip sit spa sum sun sup tam tan tap tas tat tau til tin tip tis tit tui tun tup tut ump uns ups uta uts
2: aa ai al am an as at in is it la li ma mi mu na nu pa pi si ta ti um un up us ut

real    0m16.868s
user    0m16.686s
sys     0m0.164s
# cat ~/Src/Perl/scrabble.pl
#! /usr/bin/perl -w

use strict;
use File::Basename;

# Show $error and a usage message for $me on STDERR and exit with a
# failure status.
#
sub fail {
    my ($me, $error) = @_;
    my @usage =
        ("Usage: $me <words-file> <letter> [<letter> ...]",
         'Where: <words-file> is a file of words to search.',
         '       <letter> is a letter [a-z].',
         'Print to STDOUT a list of words from <words-file>',
         '  composed of only the <letter>s specified.');
    unshift(@usage, "Error: $error") if ($error);
    print STDERR join("\n", @usage), "\n";
    exit 1;
}

# Return a sub that returns $word if $word matches @_, or returns
# undef if $word doesn't match @_.  $word matches @_ iff $word
# contains only the letters in @_ at most as often as the letters
# appear in @_.  Ignore case in comparisons.
#
sub makeMatcher {
    my %pattern; ++$pattern{lc $_} for (@_);
    my $max = @_;
    return sub {
        my ($word) = @_;
        return undef if (length $word > $max);
        my %word; ++$word{$_} for (split(//, lc $word));
        for (keys %word) {
            next if ($pattern{$_} && $word{$_} <= $pattern{$_});
            return undef;
        }
        return $word;
    }
}

# Search $file that contains a list of words one per line, for words
# matching makeMatcher(@letters).  Return a hash mapping word size to
# an array of matching words with that size.
#
sub searchFile {
    my ($me, $file, @letters) = @_;
    my %result;
    open (my $dictionary, '<', $file) or fail($me, "Cannot open '$file'");
    my $matcher = makeMatcher(@letters);
    for (<$dictionary>) {
        chomp;
        push(@{$result{length $_}}, $_) if $matcher->($_);
    }
    close $dictionary;
    return %result;
}


# If the command line @args are OK, search $file for words matching
# @letters and print the lists of matches in the order of longest to
# shortest.
#
sub main {
    my ($file, @letters) = @_;
    my $me = basename $0;
    fail($me) if (@_ < 2);
    my %matches = searchFile($me, $file, map { split // } @letters);
    for (sort {$b <=> $a} keys %matches) {
        print "$_: @{$matches{$_}}\n";
    }
    return 1;
}

exit(0) if main(@ARGV);
exit(1);
#