Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Massage the driving directions (in USA)

by parv (Vicar)
on Jun 18, 2006 at 17:30 UTC ( #556128=sourcecode: print w/replies, xml ) Need Help??
Category: text processing
Author/Contact Info parv_@yahoo.com
Description:

This program massages the driving directions (in USA) for plain text printing (preferably in monospace font, w/ a blank line between each non empty line), with these priorities (in no particular order) ...

  • up-case road names, exit numbers, places
  • low-case everything else
  • expand n, w, e, s to north, west, east, south
  • shorten road type (like mailing address), e.g. 'road' to 'rd', 'lane' to 'ln', etc.
  • removes the annoying 'go' from 'go <this much>'

#!perl

#  This program massages the driving directions (in USA) for plain tex
+t
#  printing (preferably in monospace font, w/ a blank line between eac
+h non
#  empty line), with these priorities (in no particular order) ...
#   - up-case road names, exit numbers, places
#   - low-case everything else
#   - expand n, w, e, s to north, west, east, south
#   - shorten road type (like mailing address), e.g. 'road' to 'rd', '
+lane' to
#     'ln', etc.
#   - removes the annoying 'go' from 'go <this much>'

use warnings; use strict;

my ( $geo_pos , $roads ) = ( get_geo_pos() , get_road() );

my @relative_pos = map uc( $_ ) , qw(left middle center right) ;

#  Got a better name for this variable?
my $less_important_than_roads_places =
  qr{ \b
      ( bear | stay | head | continue | follow | go | take | turn
       | entry | ramp | (?: to | fore? )w[oa]rds?
       | on.?to | on | to | for | at | off?  | then | t?here | from
       | an?d?
       | (?: h(?:ou)?r | min(?:ute)? | second | moment )s?
       | ph(?:one)? | fax | e.?mail | home | office | work | cell | mo
+bile
      )
      \b
    }xi;

my $misc_edits =
  {
    'and' => '&'
  , 'hour' => 'hr'
  , 'minutes?' => 'min'
  , 'seconds' => 'second'
  , 'phone' => 'ph'
  , 'fore?w[oa]rd' => 'forward'
  , 'toword' => 'toward'
  } ;

{
  local $^I = '' ;
  while ( <> )
  {
    s{ \s+ the \s+ }/ /xig;

    s{ \b go (?: \s+ for )? \s+ (\d) }/ $1/xige;

    $_ = uc $_;

    s{ (\d) \W* ( mi(?:le)? | ft) \b }/"$1~" . lc $2/xige;

    s{ $less_important_than_roads_places }/lc $1/xige;

    for my $map ( $roads , $geo_pos , $misc_edits )
    {
      while ( my ( $k , $v ) = each %$map )
      {
        s[ \b $k \b ]/$v/xig;
      }
    }

    for my $r ( values %$roads )
    {
      s/\b $r \./$r/xig;
    }

    s/^[ \t]+//g;
    s/[ \t]+$//g;
    s/[ \t]+/ /g;
    print;
  }
}

sub get_geo_pos
{
  my @points =
    qw(
        east west north south
        north-east north-west south-east south-west
        east-north east-south west-north west-south
      ) ;
  my %points ;
  foreach ( @points )
  {
    m{^ ([a-z])[a-z]+ (?: \W+ ( [a-z])[a-z]+ )? $}xi;
    $points{ $2 ? "$1$2" : $1 } = uc $_ ;
  }
  return { %points };
}

sub get_road
{
  my %roads =
    (
      'avenue' => 'ave'
    , 'av' => 'ave'
    , 'circle' => 'crl'
    , 'court' => 'ct'
    , 'crt' => 'ct'
    , 'drive' => 'dr'
    , 'lane' => 'ln'
    , 'pk' => 'pike'
    , 'parkway' => 'pkwy'
    , 'pky' => 'pkwy'
    , 'road' => 'rd'
    , 'route' => 'rt'
    , 'street' => 'st'
    , 'tpk' => 'turnpike'
    , 'turn.?pk' => 'turnpike'
    );

  $_ = uc $_ for values %roads;
  return { %roads };
}
Replies are listed 'Best First'.
Re: Massage the driving directions (in USA)
by liverpole (Monsignor) on Jun 18, 2006 at 19:03 UTC
    That's an interesting use for Perl.

    I tried it, and only have two suggestions -- you may want to reconsider the way the program changes "drive" to "DR", and "s" to "SOUTH", since it adversely affects things like:

    Drive for 12 miles, and turn left on Rodeo Drive. (Becomes "DR for 12 MILES, & turn LEFT on RODEO DR") Take a right just past the Drive-Through Wendy's. (Becomes "take a RIGHT JUST PAST DR-THROUGH WENDY'SOUTH.")

    And there may be other "gotchas" waiting to be discovered.

    But it's neat idea, and one I'm sure you can develop further.


    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://556128]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2020-06-01 23:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you really want to know if there is extraterrestrial life?



    Results (12 votes). Check out past polls.

    Notices?