All the Perl that's Practical to Extract and Report

"Finished" script

colomon on 2008-12-24T14:35:42

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.

Let the regex engine do the work...

jj on 2008-12-24T16:27:53

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 $1;

__END__

This converts the number into a regex, e.g. "42" would become "[GHI][ABC]" and then uses a smart match to go through the list of words.

Would this approach look any different in Perl 6? (it would be good if there was a way to smart match against the filehandle without having to load it).

JJ

Re:Let the regex engine do the work...

colomon on 2008-12-24T17:07:51

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...

Well, you can at least make `Number` much nicer

Aristotle on 2008-12-25T20:26:20

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 }
        when 'w' | 'x' | 'y' | 'z' { take 9 }
    }
    return @digit.join('');
}

Re:Well, you can at least make `Number` much nicer

colomon on 2008-12-26T12:26:55

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 seems like a very useful trick!

Re:Well, you can at least make `Number` much nicer

Aristotle on 2008-12-26T19:23:11

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 redundant stuff:

sub Number (Str $s) {
    my @block = < abc def ghi jkl mno pqrs tuv wxyz >;
    return $s.lc.trans( @block.kv.map({ $^str => $^idx+2 }) );
}

I wanted to write constant @block there actually, but Rakudo does not support constants yet.

Re:Well, you can at least make `Number` much nicer

colomon on 2008-12-26T20:41:16

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 when they are being obviously stupid.

Re:Well, you can at least make `Number` much nicer

Aristotle on 2008-12-26T21:07:43

Microsoft defined the problem that way

Oh! I missed that part of the description.