Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Using Number Ranges in a Dispatch Table

by planetscape (Canon)
on Feb 18, 2012 at 18:35 UTC ( #954778=perlquestion: print w/ replies, xml ) Need Help??
planetscape has asked for the wisdom of the Perl Monks concerning the following question:

Happy Weekend, Esteemed Monks!

I am working on a problem similar to that described here. The solution proposed by xdg looked promising:

use strict; use warnings; sub action_1_to_999 { print "1 to 999\n"; } my %dispatch = ( 0 => sub { print "Zero\n" }, map { $_ => \&action_1_to_999 } ( 1 .. 999 ), 1000 => sub { print "1e3\n" }, ); $dispatch{0}->(); $dispatch{23}->();

I had several distinct values, which I placed first in my dispatch table, and modifying the sample code to include multiple ranges seemed straightforward enough:

map { $_ => \&action_124_to_140 } ( 124 .. 140, 143 .. 146, 148 .. 149, 160 .. 169, 181 .. 189 ),

That worked. But I got a surprise when I added another separate range following the first:

map { $_ => \&action_89930_to_89999 } ( 89930 .. 89999 ),

Data in the range 89930 to 89999 still apparently triggered the action_124_to_140 sub!

I went back and actually ran xdg's code, with the addition of this line at the end:

$dispatch{1000}->();

And to my surprise, it suffers from a similar bug/fault/something:

C:\Users\Nancy\Documents>perl 568142.pl
Zero
1 to 999
1 to 999

(That last line really should be "1e3"...)

My test program:

#!/usr/bin/perl -w use strict; use warnings; sub action_124_to_140 { return 'Range 124 to 140, plus ...'; } sub action_089930_to_089999 { return 'Range 89930 to 89999'; } my $href_dispatch_table = { # Single Numbers: '01' => sub { return 'Geographic Numbers'; }, '02' => sub { return 'Geographic Numbers'; }, '055' => sub { return 'Corporate Numbers'; }, '071' => sub { return 'Mobile Services'; }, # ... and etc. # Ranges: # 124 to 140, 143 to 146, # 148 to 149, 160 to 169, and # 181 to 189 inclusive map { $_ => \&action_124_to_140 } ( 124 .. 140, 143 .. 146, 148 .. 149, 160 .. 169, 181 .. 189 ), # 089930 to 089999 inclusive map { $_ => \&action_89930_to_89999 } ( 89930 .. 89999 ), }; while (<DATA>) { chomp; if ( exists $href_dispatch_table->{$_} ) { print $_, "\t", $href_dispatch_table->{$_}->(); print "\n"; } else { print "\t\t\"$_\" does not exist in the dispatch table!\n"; } } __DATA__ 01 1 56 55 055 124 0124 0140 140 145 89930 89999 89963

And its output:

C:\Users\Nancy\Documents>perl test_Dispatch_Table_for_PM.pl
01      Geographic Numbers
                "1" does not exist in the dispatch table!
                "56" does not exist in the dispatch table!
                "55" does not exist in the dispatch table!
055     Corporate Numbers
124     Range 124 to 140, plus ...
                "0124" does not exist in the dispatch table!
                "0140" does not exist in the dispatch table!
140     Range 124 to 140, plus ...
145     Range 124 to 140, plus ...
89930   Range 124 to 140, plus ...
89999   Range 124 to 140, plus ...
89963   Range 124 to 140, plus ...

(Last three lines really should be "Range 89930 to 89999"...)

Dear Monks, please tell me how I can modify this code to permit multiple number ranges, or if I can get it to work as desired at all, or if I need another approach...

Thanks in advance!

HTH,

planetscape

Comment on Using Number Ranges in a Dispatch Table
Select or Download Code
Re: Using Number Ranges in a Dispatch Table
by afoken (Parson) on Feb 18, 2012 at 18:46 UTC

    The map trap. Run this:

    #!/usr/bin/perl use strict; use warnings; use Data::Dumper; my %oops=( A => 1, map { $_ => 2 } ('B','C'), map { $_ => 3 } ('D','E'), F => 4, ); print Dumper(\%oops);

    Look at the output. Then add ( ) around each map expression:

    #!/usr/bin/perl use strict; use warnings; use Data::Dumper; my %oops=( A => 1, (map { $_ => 2 } ('B','C')), (map { $_ => 3 } ('D','E')), F => 4, ); print Dumper(\%oops);

    Alexander

    --
    Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

      Bless you!

      I thought the technique itself should be sound, and the solution something simple, but I didn't realize it would be this simple!

      Thanks!

      HTH,

      planetscape
        No need to double up on the parentheses
        (map { $_ => 2 } 'B','C'), (map { $_ => 3 } 'D','E'),

      But isn't this always the case when you're dealing with statements that take lists as arguments?

      # Ooops! print join ",", @foo, "\n"; # Ooops! print grep /o/, @foo, "Hello world!\n"; # Ooops! print table{ map { tr(td($_->[0]), td($_->[1])) } @foo, ...

      My rule of thumb is, if one of these statements is followed by anything besides its argument, then parenthesize that statement's entire argument list.

      # De-oopsed. print join(",", @foo), "\n"; print grep(/o/, @foo), "Hello world!\n"; print table{ map({ tr(td($_->[0]), td($_->[1])) } @foo), ...
      -- 
      I hate storms, but calms undermine my spirits.
       -- Bernard Moitessier, "The Long Way"
Re: Using Number Ranges in a Dispatch Table
by tobyink (Abbot) on Feb 19, 2012 at 03:31 UTC
    use strict; { package Dispatch::Table; use overload '&{}' => sub { my $x=shift; sub { $x->lookup($_[0]) } }, '.' => sub { (shift)->lookup(shift) }, '~~' => sub { (shift)->exists(shift) }; sub new { my $class = shift; my @self; while (@_) { my ($test, $action) = (shift, shift); push @self, [$test => $action]; } bless \@self, $class; } sub lookup { my ($self, $value) = @_; foreach my $entry (@$self) { if ($value ~~ $entry->[0]) { return ref $entry->[1] eq 'CODE' ? $entry->[1]->($value) : $entry->[1]; } } return; } sub exists { my ($self, $value) = @_; foreach my $entry (@$self) { if ($value ~~ $entry->[0]) { return ref $entry->[1] eq 'CODE' ? $entry->[1] : sub { $entry->[1] }; } } return; } } sub action_1_to_999 { print "1 to 999\n"; } my $dispatch = Dispatch::Table->new( 0 => sub { print "Zero\n" }, [1..10] => sub { print "Single digit\n"}, 1_000 => sub { print "1e3\n" }, qr/^\d{4}/ => sub { print "Over a thousand\n"}, sub { my $x = shift; $x>0 && $x<1000 } => \&action_1_to_999, ); $dispatch.0; # call dispatch table on value '0' $dispatch.3; # call dispatch table on value '3' $dispatch.23; # guess! # call dispatch table on '999999' but only if the dispatch table # has an entry that covers value '-1'. $dispatch.999999 if $dispatch ~~ -1; # call dispatch table on '1000' but only if the dispatch table # has an entry that covers value '4'. $dispatch.1000 if $dispatch ~~ 4; __END__ Zero Single digit 1 to 999 1e3

      OK, I can go better...

      use 5.010; use strict; use Smart::Dispatch; sub action_1_to_999 { "1 to 999"; } my $dispatch = dispatcher { match 0, dispatch { "Zero" }; match [1..10], dispatch { "Single digit" }; match 1_000, dispatch { "1e3" }; match qr/^\d{4}/, dispatch { "Over a thousand\n"}; match_using { $_ > 0 and $_ < 1000 } dispatch \&action_1_to_999; }; say $dispatch.0; # call dispatch table on value '0' say $dispatch.3; # call dispatch table on value '3' say $dispatch.23; # guess! # call dispatch table on '999999' but only if the dispatch table # has an entry that covers value '-1'. say $dispatch.999999 if $dispatch ~~ -1; # call dispatch table on '1000' but only if the dispatch table # has an entry that covers value '4'. say $dispatch.1000 if $dispatch ~~ 4;
Re: Using Number Ranges in a Dispatch Table
by tobyink (Abbot) on Feb 19, 2012 at 03:49 UTC

    PS: as you're clearly dealing with UK phone numbers, here's an interesting piece of trivia...

    Brighton's STD code is 01273. Back in 1995 nearly all the STD codes in the UK were changed with the insertion of that "1" (e.g. London changed from 071/081 to 0171/0181). So before 1995, Brighton's STD code was 0273.

    Notice what letters 2 and 7 represent on a mobile phone keypad? 27 = BR. Apart from a few larger cities that have been renumbered, nearly all STD codes in the UK have a similar heritage. 01323 is Eastbourne; 32=EA. 01444 is Haywards Heath; 44=HH. 01424 is Hastings; 42=HA. They're all derived from telephone exchange names from back before STD was introduced.

Re: Using Number Ranges in a Dispatch Table
by RichardK (Priest) on Feb 19, 2012 at 12:26 UTC

    I think using given Switch statements gives you much more flexibility, as it uses smart matching and can do lots of clever things. You do have to type a bit more but it's worth it ;)

    So something like this :-

    use v5.14; use warnings; sub ident_number { my ($num) = @_; given ($num) { when ('01') { say 'geographic'; } when (/^\d+$/ && $_ >= 124 && $_ <= 140) { say '124 - 140'; } when ([143 .. 146, 148 .. 149]) { say "$_ other stuff"; } when ([181 ..189]) { say '181 -- 189'; } default { say "$_ not found"; } } } my @tests = qw/ 01 02 125 127 186 500 143 149 189/; for (@tests) { ident_number($_); }

      My initial attempt was based on given but I switched to using a list of smart matches and subroutines because given has a drawback compared to dispatch tables...

      With dispatch tables you can check whether a particular value can dispatch, without actually doing the dispatching yet. If your dispatch table is a hash, then it's just defined($dispatch{$value}).

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://954778]
Approved by Perlbotics
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (10)
As of 2014-11-29 01:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (202 votes), past polls