Re: [FWP] Call for Programs: the "phonecode" benchmark

["Ronald J. Kimball" <rjk@linguist.dartmouth.edu>]

Having convinced to install perl5.005_3, I decided to submit a phonecode
program as well.  And here it is.


#!/usr/local/bin/perl -w

# Author:   Ronald J Kimball
# Email:    rjk@linguist.dartmouth.edu
# 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:      30 minutes
#   Coding:      30 minutes
#   Test/Debug:  15 minutes
#
# 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
#   upper 25 to 40 percent         .
#   upper 40 to 60 percent         .
#   lower 25 to 40 percent         .
#   lower 11 to 25 percent         .
#   lower 10 percent               .
#
# Special events, remarks, insights, constraints etc:
#
#   My original working code took about 20 minutes to design, 15 minutes
#     to code, and 5 minutes to test/debug.  However, it was not efficient
#     enough, so I spent the time to make these changes:
#
#   Originally intended to keep the dictionary as a list, and use a regex
#     to find matches for each substring.  This made the dictionary search
#     too inefficient, so I decided to store the dictionary as a hash,
#     keyed by encoding, which means the only searching done is a hash
#     lookup.
#
#   Originally recursed once for each word matching each substring, but
#     this duplicated all the work for encoding the remainder of the
#     number.  I decided instead to recurse once for each substring, with
#     and then use a separate function to create all the possible
#     combinations for output.
#

require 5.004;

use strict;

# dictionary hash: keys are numeric encodings, values are original words
my %dict;

# input files
my $dict_file  = shift || "test.w";
my $phone_file = shift || "test.t";

# populate %dict
{
  open(DICT, $dict_file) or die "Unable to open $dict_file: $!\n";

  my %ltr2num = (A => 5, B => 7, C => 6, D => 3, E => 0,
                 F => 4, G => 9, H => 9, I => 6, J => 1,
                 K => 7, L => 8, M => 5, N => 1, O => 8,
                 P => 8, Q => 1, R => 2, S => 3, T => 4,
                 U => 7, V => 6, W => 2, X => 2, Y => 3,
                 Z => 9);

  my $enc;

  while (<DICT>) {
    chomp;
    $enc = $_;
    
    # remove non-letters
    $enc =~ tr/A-Za-z//cd;
    
    # create numeric encoding
    $enc =~ s/([A-Z])/$ltr2num{uc($1)}/gi;
    
    # add to dictionary
    # included trailing space for convenience later
    push @{$dict{"$enc "}}, $_;
  }
}

open(PHONE, $phone_file) or die "Unable to open $phone_file: $!\n";

# iterate over list of phone numbers
while (<PHONE>) {
  chomp;
  my $number = $_;
  
  # remove non-digits
  $number =~ tr/0-9//cd;
  
  # begin processing
  process($_, $number, 0);
}

# process()
# recursively process to encode the remainer of the number
#   $realnum : original phone number, including non-digits
#   $number  : phone number, digits only
#   $pos     : current position in $number
#   @stack   : list of encodings found for beginning of string up to $pos
sub process {
  my($realnum, $number, $pos, @stack) = @_;
  
  # if at end of number, success!
  if ($pos == length $number) {
    # output all encodings found
    output($realnum, @stack);
    return;
  }
  
  my $i;
  my $flag;
  my $s;
  
  # iterate over remainder of number
  for ($i = length($number) - $pos; $i > 0; --$i) {
  
    # include trailing space for convenience later  
    $s = substr($number, $pos, $i) . ' ';
    
    # if there is an encoding for this substring
    if ($dict{$s}) {
      # set flag for encoding found
      $flag = 1;
      
      # recurse with $pos incremented and the substring added to @stack
      process($realnum, $number, $pos + $i, @stack, $s);
    }
  }
  
  # if no encodings were found and the previous item was not a plain digit
  # (note space used for convenience - no space means a plain digit)
  if (!$flag and (!@stack or $stack[-1] =~ / /)) {
    # recurse with $pos incremented and the plain digit added to @stack
    process($realnum, $number, $pos+1, @stack, substr($number, $pos, 1));
  }
  
} # process

# output()
#   $number : phone number that was encoding
#   $list   : list of substrings encoded
sub output {
  my($number, @list) = @_;
  
  my @output = '';
  my $s;
  my $o;
  
  # iterate over elements of list
  while (@list) {
    $s = shift @list;
    
    # create all combinations of @output and @{$dict{$s}}
    @output = map {
                    # reassign to $o because inner map needs $_
                    $o = $_;
                    map { "$o $_" }
                        # (note space used for convenience -
                        # no space means a plain digit)
                        $s =~ / / ? @{$dict{$s}} : ($s)
                  }
                  @output;
  }
  
  # output encodings
  foreach (@output) {
    print "$number:$_\n";
  }
  
} # output


__END__

==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe