[Date Prev][Date Next][Thread Prev][Thread Next]
[Search]
[Date Index]
[Thread Index]
Re: [FWP] Call for Programs: the "phonecode" benchmark
>From vlb@cfcl.com Tue Nov 23 01:32:28 1999; sorry for the delay
Date: Tue, 23 Nov 1999 09:29:36 -0000
[Note from the listmaster: Folks - please remember this is a closed list. If
you aren't a subscriber, your postings come to me. That means if you are
subscribed from your home account and post from work, or use an alternate
address of any kind those postings fall in my In-box and I get to them when
I get to them! I generally add the alternate addresses when that happens,
but it can take a few days for things to get through. On the flip side, we
see less spam. I now return you to the regular list. - vlb]
This is a multi-part message in MIME format.
------=_NextPart_000_001B_01BF3595.41CE46A0
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: 7bit
I may as well give this one a try, it'll be a good learning experience.
Please pass comment as this is my first attempt at anything tricky in perl
and only fifth script in total, I write C for a living.
Paul Livesey
p.r.livesey@surfersparadise.net
------=_NextPart_000_001B_01BF3595.41CE46A0
Content-Type: application/octet-stream;
name="phonecode.pl"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="phonecode.pl"
#!/usr/local/bin/perl -w
# ((insert appropriate information replacing each dot))
# Author: Paul R. Livesey
# Email: p.r.livesey@surfersparadise.net
# Language: Perl
#
# How long it took to write the program (in minutes):
# Design: reading the requirements; deciding on algorithm,
# data structure, modularization
# Coding: actually writing the program
# Test/Debug: trying to get the program to work
# ((insert your work times here:))
# Design: In my subconscious for a few days
# Coding: 180 - 240 hours
# Test/Debug: 60
#
# Overall I tend to rate myself as follows compared to all
# other programmers (replace one dot by an X):
# among the upper 10 percent .
# upper 11 to 25 percent X for 'C'
# upper 25 to 40 percent .
# upper 40 to 60 percent .
# lower 25 to 40 percent .
# lower 11 to 25 percent X for Perl
# lower 10 percent .
#
# Special events, remarks, insights, constraints etc:
# I do nasty things with 'C' for a living, Perl is purely for =
recreation.
# This is only the fifth thing I've ever written in Perl (please don't
# tell my current employer that), so comments and advice are =
appreciated.
# Most of the time was spent learning the language not solving the =
problem.
# My first attempt ran like a dog, even on my very fast Sun, so I =
rewrote all
# of it in about 30 minutes. It is now acceptable.
# I suppose a little recursion would be more interesting than my loop =
but
# it's late.
#Better safe than sorry
require 5;
use strict;
use integer;
#Function prototype, is this correct?
sub do_translations($$);
my $dict_file; #Dictionary file
my $num_file; #Phone number file
my $word; #Current word from dictionary file
my $name; #How far we have got in mapping our number
my $read_num; #Current number from phone number file
my $number; #Current number from phone number file (munged)
my %lookup_hash; #Hash of numbers and their words from the dictionary
#The following three hashes all contain the initial word mapping as key
#and the remaining unmapped phone number as the value
my %translations; #Our current hash of things to process
my %working_hash; #Our hash of things to process next
my %temp_hash; #Our tempory hash of things to process next
#Name this was run with
$0 =3D~ s(.*[\\/])();
#Correct number of arguments
if ( @ARGV !=3D 2 )
{
warn "Usage $0 [dictionary file] [phone number file]\n";
exit 1;
}
#Name of dictionary file
$dict_file =3D $ARGV[0];
#Open the dictionary file for reading
if ( !open(DICTFILE, $dict_file) )
{
warn "$0 : Unable to open $dict_file for reading\n";
exit 1;
}
#Name of numbers file
$num_file =3D $ARGV[1];
#Open the numbers file for reading
if ( !open(NUMFILE, $num_file) )
{
warn "$0 : Unable to open $num_file for reading\n";
close DICTFILE;
exit 1;
}
#Read in the dictionary, and translate it to a number
while ( <DICTFILE> )
{
#Remove newline
chomp;
#Store this word somewhere safe for the moment
$word =3D $_;
#Remove anything non-alphabetic
s/[^a-zA-Z]//og;
#Now do the translation from letter to number;
s/[Ee]/0/og;
s/[JjNnQq]/1/og;
s/[RrWwXx]/2/og;
s/[DdSsYy]/3/og;
s/[FfTt]/4/og;
s/[AaMm]/5/og;
s/[CcIiVv]/6/og;
s/[BbKkUu]/7/og;
s/[LlOoPp]/8/og;
s/[GgHhZz]/9/og;
#Store original word and number representation in a hash
#Lookup is by number
push @{$lookup_hash{$_}}, $word;
}
close DICTFILE;
#Now read in numbers one at a time from a file and work out
#all possible representations
#Read in each number, and translate it to a word/number encoding
while ( <NUMFILE> )
{
#Remove newline
chomp;
$read_num =3D $_;
$number =3D $_;
#Munge number into a purely numerical form(sic)
$number =3D~ s/[^[0-9]//og;
#Try and find some matches
%translations =3D do_translations($number, "");
#Anything?
if ( !%translations )
{
#No, so use a leading number
$number =3D~ s/^([0-9])//o;
$translations{$1} =3D $number;
}
#Work through our hash of things to process/print
while ( %translations )
{
while ( ($name, $number) =3D each %translations )
{
#If the remaining string is empty, then we can print out our =
mapping
if ( $number eq "" )
{
print "$read_num: $name\n";
}
else
{
#Try and match remaining number, passing along how far we've =
got
#the " " is to separate word/number tokens
%temp_hash =3D do_translations($number, $name . " ");
#Any matches?
if ( !%temp_hash )
{
#No, can we try a number
if ( $name =3D~ /[^0-9]$/o )
{
#Yes
$number =3D~ s/^([0-9])//o;
$temp_hash{$name . " " . $1} =3D $number;
}
}
#Add what we've got this time through to our
#hash of things to process
%working_hash =3D (%working_hash, %temp_hash);
}
}
#New hash to process
%translations =3D %working_hash;
undef %working_hash;
}
}
#Thank you and goodnight
close NUMFILE;
exit 0;
#This function does the mapping
#We look for each number in the hash and get all mappings that exist
#we then do the same for each that number minus it's last digit and so =
on
#always storing the matches and what substring they leave
sub do_translations($$)
{
my $num;
my $remaining_num =3D "";
my $lead_name;
my %translated;
#Get the function arguments
$num =3D shift;
$lead_name =3D shift;
#Look for this number and all shorter versions in the hash
while ( $num )
{
#Do we have any matches?
if ( defined $lookup_hash{$num} )
{
#Store each match and the remainig digits
foreach ( @{$lookup_hash{$num}} )
{
$translated{$lead_name . $_} =3D $remaining_num;
}
}
#Lop off the last digit and add it to the remainder
$num =3D~ s/([0-9])$//o;
$remaining_num =3D $1 . $remaining_num;
}
return %translated;
}
__END__
------=_NextPart_000_001B_01BF3595.41CE46A0--
==== Want to unsubscribe from Fun With Perl? Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
==== unsubscribe