Re^5: alternatives to if and series of elsif

[gsiems]

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__

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.

[kiat]

Thanks, gsiems!

I did a lazy test prior to your posting above on my while version and, as shown by your automated test, it didn't produce the expected results. The base_points are incremented as long as the condition is true and are returned regardless of the status of the final test, which is the crucial one.

I like your ternary version because it's relatively easy to understand. It also tends to be faster as the points go up.