in reply to Re: alternatives to if and series of elsif
in thread alternatives to if and series of elsif

Thanks, davidrw!

Like your foreach method.

Btw, if the sub is called a lot, would it be faster to have the values hard-coded into @comparisons rather than have them generated using map?

Added: I think you mistyped (i.e. missing ->): 

if $points > $cmp[0] && $quota < $cmp[1]

Should be:

if $points > $cmp->[0] && $quota < $cmp->[1]

[download]

Replies are listed 'Best First'.
Re^3: alternatives to if and series of elsif
by gsiems (Deacon) on Jul 02, 2005 at 03:40 UTC
    FWIW, performing a quick benchmark indicates that using a hard-coded @comparisons (davidrw's initial suggestion) is significantly faster: 
    #!/usr/bin/perl -w
use strict;
use Benchmark qw(cmpthese);

my ($points, $quota) = (1000, 20);

cmpthese(
   -1,
   {
      'op_orig'   => sub { return op_orig($points, $quota);},
      'op_cmp2'   => sub { return op_cmp2($points, $quota);},
      'davidrw_1' => sub { return davidrw_1($points, $quota);},
      'davidrw_2' => sub { return davidrw_2($points, $quota);},
      'ternary'   => sub { return ternary_cmp($points, $quota);},
   }
   );

sub op_orig {
   # OP, original compare
   my ($points, $quota) = @_;
   if ($points > 18000 && $quota < 24) {
      return 24;
   } elsif ($points > 16000 && $quota < 23) {
      return 23;
   } elsif ($points > 14000 && $quota < 22) {
      return 22;
   } elsif ($points > 12000 && $quota < 21) {
      return 21;
   } elsif ($points > 10000 && $quota < 20) {
      return 20;
   } elsif ($points > 8000 && $quota < 19) {
      return 19;
   } elsif ($points > 6000 && $quota < 18) {
      return 18;
   } elsif ($points > 4000 && $quota < 17) {    #19
      return 17;
   } elsif ($points > 2000 && $quota < 16) {    #17
      return 16;
   }
   return 15;
}

sub op_cmp2 {
   # OP, compare2
   my ($points, $quota) = @_;
   my $base_quota = 15;
   while($points > 2000 && $quota > $base_quota) {
      $points -= 2000;
      $base_quota += 1;
   }
   return $base_quota;
}

sub davidrw_1 {
   # davidrw suggestion 1
   my ($points, $quota) = @_;
   my @comparisons = (
      # points, quota
      [18000, 24],
      [16000, 23],
      [14000, 22],
      [12000, 21],
      [10000, 20],
      [8000,  19],
      [6000,  18],
      [4000,  17],
      [2000,  16],
      );
   foreach my $cmp (@comparisons) {
      return $cmp->[1] if $points > $cmp->[0] && $quota < $cmp->[1];
   }
   return 15;
}

sub davidrw_2 {
   # davidrw suggestion 2
   my ($points, $quota) = @_;
   my @comparisons = map { [($_ - 15) * 2000, $_] } 24 .. 16;
   foreach my $cmp (@comparisons) {
      return $cmp->[1] if $points > $cmp->[0] && $quota < $cmp->[1];
   }
   return 15;
}

sub ternary_cmp {
   # Just for the fun of it
   my ($points, $quota) = @_;
   return ($points > 18000 && $quota < 24) ? 24
        : ($points > 16000 && $quota < 23) ? 23
        : ($points > 14000 && $quota < 22) ? 22
        : ($points > 12000 && $quota < 21) ? 21
        : ($points > 10000 && $quota < 20) ? 20
        : ($points >  8000 && $quota < 19) ? 19
        : ($points >  6000 && $quota < 18) ? 18
        : ($points >  4000 && $quota < 17) ? 17
        : ($points >  2000 && $quota < 16) ? 16
        : 15;
}

__END__

    [download]
                  Rate davidrw_1   op_orig   ternary davidrw_2   op_cmp2
davidrw_1  22411/s        --      -86%      -86%      -87%      -90%
op_orig   162293/s      624%        --       -1%       -4%      -29%
ternary   163840/s      631%        1%        --       -3%      -28%
davidrw_2 169239/s      655%        4%        3%        --      -26%
op_cmp2   227555/s      915%       40%       39%       34%        --

    Update: Added kutsu's suggestion to the mix: 

                  Rate     kutsu davidrw_1   op_orig   ternary davidrw_2   op_cmp2
kutsu      15170/s        --      -31%      -90%      -91%      -91%      -93%
davidrw_1  21976/s       45%        --      -86%      -86%      -87%      -90%
op_orig   159288/s      950%      625%        --       -1%       -9%      -31%
ternary   160777/s      960%      632%        1%        --       -8%      -30%
davidrw_2 174121/s     1048%      692%        9%        8%        --      -24%
op_cmp2   229681/s     1414%      945%       44%       43%       32%        --
[reply]
[d/l]
      Very nice, thanks!

      Me need to go figure what what 15170/s means...

[reply]
        My bad... I think I misled you a bit. To quote the Benchmark documentation for cmpthese: "This chart is sorted from slowest to fastest, ..." so the higher the number, the faster the code. I don't think the actual number means much of anything, it's the percent difference between the different subs being compared that's important.
[reply]
      I ran your benchmark code above, changing the points from 1000 to 10 000. I got the following results:

                    Rate davidrw_2 davidrw_1   op_cmp2   op_orig   ternary
davidrw_2  48968/s        --      -21%      -87%      -91%      -91%
davidrw_1  62049/s       27%        --      -83%      -89%      -89%
op_cmp2   363917/s      643%      487%        --      -35%      -36%
op_orig   559112/s     1042%      801%       54%        --       -2%
ternary   570934/s     1066%      820%       57%        2%        --

      [download]
      Note that I changed the map code to: 
         my @comparisons = map { [($_ - 15) * 2000, $_] } 16 .. 24;

      [download]
      That is, 16 .. 24 instead of 24 .. 16.
[reply]
[d/l]
[select]
        I got to wondering if these alternatives were functionally the same as the original... So I rigged up the following test (I think it's a valid enough test). To the extent that I transcribed the various functions correctly and that my testing is valid you may want to be careful which method you implement. 
        #!/usr/bin/perl -w
use strict;

my %test_data;
my %test_result;
my $test_size = 25;

# Generate some random test data, run it through the 
# original compare sub, print and store the result:
print "Test data:\n";
print "pts    qt  result\n";
print "-----  --  ------\n";
for (1 .. $test_size) {
   my $points = int rand(18000);
   my $quota  = (int rand(8) + 16);
   $test_data{$_}{points} = $points;
   $test_data{$_}{quota}  = $quota;
   $test_result{$_} = op_orig($points, $quota);
   printf ("%5d  %2d  %2d\n", $points, $quota, $test_result{$_});
}
print "\n\n";

# Test each of the alternative compare subs to see if they return the 
# same values as the original:
for (qw(op_cmp2 davidrw_1 davidrw_2 davidrw_2_5 ternary_cmp kutsu)) {
   test_sub ($_, \&$_);
}

sub test_sub {
   my ($name, $func) = @_;

   for (1 .. $test_size) {
      my $points = $test_data{$_}{points};
      my $quota = $test_data{$_}{quota};
      my $return = $func->($points, $quota);

      unless ($return) {
         print "$name failed on $points, $quota: no value returned.\n"
+;
         return;
      }
      if ($return != $test_result{$_}) {
         print "$name failed on $points, $quota: returned $return.\n";
         return;
      }
   }
   print "$name looks ok\n"  
}

sub op_orig {
   # OP, original code
   my ($points, $quota) = @_;
   if ($points > 18000 && $quota < 24) {
      return 24;
   } elsif ($points > 16000 && $quota < 23) {
      return 23;
   } elsif ($points > 14000 && $quota < 22) {
      return 22;
   } elsif ($points > 12000 && $quota < 21) {
      return 21;
   } elsif ($points > 10000 && $quota < 20) {
      return 20;
   } elsif ($points > 8000 && $quota < 19) {
      return 19;
   } elsif ($points > 6000 && $quota < 18) {
      return 18;
   } elsif ($points > 4000 && $quota < 17) {    #19
      return 17;
   } elsif ($points > 2000 && $quota < 16) {    #17
      return 16;
   }
   return 15;
}

sub op_cmp2 {
   # OP, op_cmp2
   my ($points, $quota) = @_;
   my $base_quota = 15;
   while($points > 2000 && $quota > $base_quota) {
      $points -= 2000;
      $base_quota += 1;
   }
   return $base_quota;
}

sub davidrw_1 {
   # davidrw suggestion 1
   my ($points, $quota) = @_;
   my @comparisons = (
      # points, quota
      [18000, 24],
      [16000, 23],
      [14000, 22],
      [12000, 21],
      [10000, 20],
      [8000,  19],
      [6000,  18],
      [4000,  17],
      [2000,  16],
      );
   foreach my $cmp (@comparisons) {
      return $cmp->[1] if $points > $cmp->[0] && $quota < $cmp->[1];
   }
   return 15;
}

sub davidrw_2 {
   # davidrw suggestion 2
   my ($points, $quota) = @_;
   my @comparisons = map { [($_ - 15) * 2000, $_] } 24 .. 16;
   foreach my $cmp (@comparisons) {
      return $cmp->[1] if $points > $cmp->[0] && $quota < $cmp->[1];
   }
   return 15;
}

sub davidrw_2_5 {
   # davidrw suggestion 2 as modified by kiat 
   my ($points, $quota) = @_;
   my @comparisons = map { [($_ - 15) * 2000, $_] } 16 .. 24;
   foreach my $cmp (@comparisons) {
      return $cmp->[1] if $points > $cmp->[0] && $quota < $cmp->[1];
   }
   return 15;
}

sub ternary_cmp {
   # Just for the fun of it
   my ($points, $quota) = @_;
   return ($points > 18000 && $quota < 24) ? 24
        : ($points > 16000 && $quota < 23) ? 23
        : ($points > 14000 && $quota < 22) ? 22
        : ($points > 12000 && $quota < 21) ? 21
        : ($points > 10000 && $quota < 20) ? 20
        : ($points >  8000 && $quota < 19) ? 19
        : ($points >  6000 && $quota < 18) ? 18
        : ($points >  4000 && $quota < 17) ? 17
        : ($points >  2000 && $quota < 16) ? 16
        : 15;
}

sub kutsu {
   my ($points, $quota) = @_;
   my %compare = (
      18000 => 24,
      16000 => 23,
      14000 => 22,
      12000 => 21,
      10000 => 20,
       8000 => 19,
       6000 => 18,
       4000 => 17,
       2000 => 16,
       );
   for my $key (sort {$b <=> $a} keys %compare)
   {
     if ($points > $key and $quota < $compare{$key})
     {
       return $compare{key};
     }
   }
   return 15;
}


__END__

        [download]
        Test data:
pts    qt  result
-----  --  ------
 6906  23  15
12199  22  15
17402  17  23
 3470  19  15
16603  19  23
17962  23  15
15762  23  15
 6115  23  15
16711  16  23
 1936  21  15
  870  21  15
 1338  23  15
10537  22  15
14295  18  22
11041  19  20
15167  21  22
16712  17  23
10767  18  20
14383  22  15
  485  20  15
 9298  18  19
 7096  19  15
10030  17  20
11104  20  15
12730  22  15


op_cmp2 failed on 6906, 23: returned 18.
davidrw_1 looks ok
davidrw_2 failed on 17402, 17: returned 15.
davidrw_2_5 failed on 17402, 17: returned 18.
ternary_cmp looks ok
kutsu failed on 17402, 17: no value returned.
[reply]
[d/l]

In Section Seekers of Perl Wisdom