#!/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__