Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

colomon (8994)

colomon
  (email not shown publicly)

Journal of colomon (8994)

Wednesday December 24, 2008
09:35 AM

"Finished" script

[ #38155 ]
I don't think this code is going to win any converts to Perl 6, but here's what I've got:

my $wordlist_filename = "wordlist.txt";
my $test_numbers_filename = "numbers.txt";

sub Number (Str $s)
{
    # $s.=trans ('abc' => '2', 'def' => '3', 'ghi' => '4');
    # $s ~~ tr/abcdefghijklmnopqrstuvwxyz/222333444555666777888999/;

    my $result;
    for (0..6) -> $i
    {
        my $c = lc($s.substr($i,1));
        given $c
        {
            when $c eq "a" || $c eq "b" || $c eq "c" { $c = '2'; }
            when $c eq "d" || $c eq "e" || $c eq "f" { $c = '3'; }
            when $c eq "g" || $c eq "h" || $c eq "i" { $c = '4'; }
            when $c eq "j" || $c eq "k" || $c eq "l" { $c = '5'; }
            when $c eq "m" || $c eq "n" || $c eq "o" { $c = '6'; }
            when $c eq "p" || $c eq "r" || $c eq "s" { $c = '7'; }
            when $c eq "t" || $c eq "u" || $c eq "v" { $c = '8'; }
            when $c eq "w" || $c eq "x" || $c eq "y" { $c = '9'; }
            # when $c ~~ /defDEF/ { $c = '3'; }
        }
        $result = $result ~ $c;
    }

    return $result;
}

my $wordlist = open($wordlist_filename);
    # err die "Could not open $wordlist: $!\n";

my %numbers;

for (=$wordlist) -> $word
{
    if ($word ~~ /^\w\w\w\w\w\w\w$/)
    {
        my $number = Number($word);
        say "$word ==> $number";
        %numbers{$number} = $word;
    }
}
close ($wordlist);

my $test_numbers = open($test_numbers_filename);
for (=$test_numbers) -> $number
{
    my $word = %numbers{$number};
    say "$number ==> $word";
}
close ($test_numbers);

Notes: The Number function works okay, but it is an awful hack -- what should be one line of code somehow becomes fifteen. err die error checking sadly does not work. I couldn't find a sane way to get the number of letters in a word. I couldn't figure out how to read from standard input.

On the plus side, the new for syntax is appealing. I love having named parameters for subroutines. The given statement is nice, though I wish I hadn't had to use it in this example. And hashes work correctly.


List all Journal entries
The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.

"Finished" script 7 Comments More | Login | Reply /

 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • I don't really know any Perl 6 syntax, but this was my Perl 5 version:

    #! /Users/jj/bin/perl5.10.0

    use strict;
    use warnings;
    use 5.010;

    say "Please enter a phone number:";
    my $number = <>;
    chomp $number;

    $number =~ s/2/[ABC]/g;
    $number =~ s/3/[DEF]/g;
    $number =~ s/4/[GHI]/g;
    $number =~ s/5/[JKL]/g;
    $number =~ s/6/[MNO]/g;
    $number =~ s/7/[PRS]/g;
    $number =~ s/8/[TUV]/g;
    $number =~ s/9/[WXY]/g;

    open WORDLIST,'<','wordlist.txt' or die "Cannot open wordlist.txt: $!";

    [<WORDLIST>] ~~ /^($number)\s*$/i and say uc $
    • Ha! That's brilliant.

      I've no idea if that basic approach will work in current Perl 6. I may give it a try if I get a chance...

  • sub Number (Str $s) {
        my @digit = gather for $s.lc().split('') {
            when 'a' | 'b' | 'c' { take 2 }
            when 'd' | 'e' | 'f' { take 3 }
            when 'g' | 'h' | 'i' { take 4 }
            when 'j' | 'k' | 'l' { take 5 }
            when 'm' | 'n' | 'o' { take 6 }
            when 'p' | 'q' | 'r' | 's' { take 7 }
            when 't' | 'u' | 'v' { take 8 }
       

    • I actually prefer what I ended up with when I got trans working:

      sub Number (Str $s)
      {
          my $result = lc($s);
          $result.=trans('abc' => '2', 'def' => '3', 'ghi' => '4',
                         'jkl' => '5', 'mno' => '6', 'prs' => '7',
                         'tuv' => '8', 'wxy' => '9');
          return $result;
      }

      But I'm intrigued by that gather / take in there -- that seem

      • Yes, that is nicer. But with this version I wonder why you first make a copy, then mutate it, then return it. I would simply return the copy returned by trans:

        sub Number (Str $s) {
            return $s.lc.trans(
                'abc' => '2', 'def'  => '3', 'ghi'  => '4',
                'jkl' => '5', 'mno'  => '6', 'pqrs' => '7',
                'tuv' => '8', 'wxyz' => '9',
            );
        }

        Oh, and you can avoid writing down redundan

        • The quick answer to the first is that I still think in terms of old tr and mutating in place -- habits developed hacking out quick Perl scripts back in the mid-90s. Your way is both more elegant and more efficient, a beautiful combination.

          Your second suggestion there is nifty, but I think I find your first a bit more elegant. Just a matter of taste.

          BTW, the reason I keep on leaving out q and z is Microsoft defined the problem that way, and I'm trying to conform to their statements of the problem, even

Stories, comments, journals, and other submissions on use Perl; are Copyright 1998-2006, their respective owners.