Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
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: (5)
As of 2020-10-21 02:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (212 votes). Check out past polls.

    Notices?