Re: alternatives to if and series of elsif
by davidrw (Prior) on Jul 01, 2005 at 15:47 UTC
|
Something along these lines maybe, since the check is always identical ...
sub compare {
my ($points, $quota) = @_;
my @comparisons = (
# points, quota
[ 18000, 24 ],
[ 16000, 23 ],
[ 14000, 22 ],
...
);
foreach my $cmp ( @comparisons ){
return $cmp->[1] if $points > $cmp->[0] && $quota < $cmp->[1];
}
return 15;
}
Ah, now i see that there's a pattern... youre compare2 is close.. i think if you make it $points -= 2000; it will work.
Update: since patterned, can generate @comparisons like this:
my @comparisons = reverse map { [ ($_-15)*2000, $_ ] } 16 .. 24;
Update: fixed typo of $cmp[0] needing to be $cmp->[0]
Update: thanks to ihb for pointing out the need for the reverse of 16 .. 24 instead of just 24 .. 16 which is an empty list. | [reply] [d/l] [select] |
|
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]
| [reply] [d/l] |
|
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__
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] |
|
|
|
|
|
|
|
| [reply] [d/l] [select] |
Re: alternatives to if and series of elsif
by kutsu (Priest) on Jul 01, 2005 at 16:47 UTC
|
I prefer davidrw's map method, for this comparision, but in case anyone stumbles upon this and wants an alternative - you can use a hash instead:
my ($points, $quota) = @_;
my %compare = (
18000 => 24,
16000 => 23,
14000 => 22,
... );
for my $key (sort {$b <=> $a} keys %compare)
{
if ($points > $key and $quota < $compare{$key})
{
return $compare{key};
}
}
return 15;
Check out QM's reply for a better example
Update: it doesn't work for 16626 => 21, because it assumes the keys increment in conjuction with the values, which 16626 => 21 breaks. Added link.
"Cogito cogito ergo cogito sum - I think that I think, therefore I think that I am." Ambrose Bierce
| [reply] [d/l] |
|
Why would you use a hash, and then do a linear search through the keys?
-QM
--
Quantum Mechanics: The dreams stuff is made of
| [reply] |
|
You wouldn't :), I just used davido's as an example and, this looking suspiciously like homework my brother just got, left the exercise of creating a predefined hash to the OP (which would look much like your post anyway). I don't think kiat was asking for an answer to homework now, but didn't have time over the weekend to update. (and now that your post covers it I'll just leave it at a link to that.
"Cogito cogito ergo cogito sum - I think that I think, therefore I think that I am." Ambrose Bierce
| [reply] |
|
Re: alternatives to if and series of elsif
by Xaositect (Friar) on Jul 01, 2005 at 17:09 UTC
|
This may not be relevant to your specific example since you're making two comparisons for each conditional, but there is a perl switch statement on CPAN. More than one actually.
Xaositect - Whitepages.com
| [reply] |
|
And as has been discussed quite often here in the Monastery, actually using Switch.pm is a rather bad idea, as it attempts to parse Perl code and tends to fail in all sorts of unexpected and nasty ways. Switch::Perlish looks nice, but has to jump through a lot of loops in order to emulate switch as we know it from ie C, resulting in what looks like a negligible, if none at all, gain over a regular if/elseif/else construction. From personal experience I'd say either go for the fullblown if/elseif/else construction or, like in this case, use map or a hash.
| [reply] |
Re: alternatives to if and series of elsif
by Eimi Metamorphoumai (Deacon) on Jul 01, 2005 at 17:16 UTC
|
According to my tests, this seems to produce the same results. Some of the conditions may be a bit weird, but it matches the results provided (if the quota provided isn't greater than 24, we can probably simplify it).
use List::Util 'min';
sub compare {
my ($points, $quota) = @_;
my ($newquota) = int($points/2000) + 15;
if ($newquota > $quota && $quota <= 24){
return min(24, $newquota);
}
return 15;
}
| [reply] [d/l] |
|
| [reply] [d/l] |
Re: alternatives to if and series of elsif
by tlm (Prior) on Jul 02, 2005 at 04:43 UTC
|
use POSIX 'ceil';
use List::Util qw( min max );
my $Base = 15;
my $Max = 24;
my $Incr = 2000;
sub compare {
my ( $points, $quota ) = @_;
my $new = max( min( $Max, ( ceil( $points/$Incr ) - 1 ) + $Base ), $
+Base );
return $new > $quota ? $new : $Base;
}
Update: Fixed bug in response to kiat's comment. (In my original version, the min was applied, incorrectly, at the test in the return statement not in the earlier assignment. This produced results that differed from those of kiat's original compare for $points > 2000.) Also, my original tested only for non-zero $points whereas it should have tested for positive $points. But this amounts to including a max in the definition of $new, which simplifies the last test further. I fixed that too.
| [reply] [d/l] |
|
if ($points > 18000 && $quota < 24) {
return 24;
}
| [reply] [d/l] [select] |
|
$points > 2000*X && $quota < 15+X
for some integer 0 < X < 10. One can eliminate the redundancy between these two tests. Algebraically, the above is equivalent to
$points/2000 > X && X > $quota-15
...which can be further reduced to
$points/2000 + 15 > $quota
...except that there are edge cases (basically, X must be an integer strictly between 0 and 10) which make the algorithm a bit more complex.
| [reply] [d/l] [select] |
|
Re: alternatives to if and series of elsif
by BrowserUk (Patriarch) on Jul 02, 2005 at 06:54 UTC
|
Maybe not elegant, but it's short and quick.
use constant STICK => pack 'C*', 15, map( ($_) x 2, 15 .. 23 ), (24) x
+ 100;
sub stick{
my $q = ord substr STICK, $_[0] / 1000;
return $q < $_[1] ? $_[1] : $q;
}
Update: And this one's quicker still
use constant STICK2 => [ 15, map( ($_) x 2, 15 .. 23 ), (24) x 100 ];
sub stick2{
my $q = STICK2->[ $_[0] / 1000 ];
return $q < $_[1] ? $_[1] : $q;
}
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.
| [reply] [d/l] [select] |
|
print "compare: ", compare (10127, 20), "\n";
print "stick: ", stick (10127, 20), "\n";
print "stick2: ", stick2 (10127, 20), "\n";
...
Prints out:
compare: 15
stick: 20
stick2: 20
| [reply] [d/l] |
|
Your right, but I concluded (as I assume other responders did) that it was a bug in the original implementation. One that possibly doesn't show up because the situation doesn't arise in use.
My interpretation of the intent of the original algorithm, is that if a user has acquired a given number of points, and their quota has not yet been incremented to the appropriate level, then it is increased to that level.
My view was that the quota may represent something like "life force" or "energy" or "armour" in a game scenario, which gets increased in stages as the user accumulates points. This is an assumption, but one that seems to fit the facts as presented.
The thing I noticed with the original implementation is that if a user accumlated more points, but didn't accumulate any additional quota (through other mechanisms) between reassessments, then they are penalised (all the way back to the base level), until their points tally took them high enough to be awarded the next level of quota. At which point they regain both the penalised quota, plus the new increase. Vis:
#! perl -slw
use strict;
sub 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;
}
my $userQuota = 0;
for my $userPoints ( map{ $_ * 1000 } 0 .. 19 ) {
printf "Before: %5d : %5d", $userPoints, $userQuota;
$userQuota = compare( $userPoints, $userQuota );
printf " After: %5d : %5d\n", $userPoints, $userQuota;
}
__END__
P:\test>471983
Before: 0 : 0 After: 0 : 15
Before: 1000 : 15 After: 1000 : 15
Before: 2000 : 15 After: 2000 : 15
Before: 3000 : 15 After: 3000 : 16
Before: 4000 : 16 After: 4000 : 15
Before: 5000 : 15 After: 5000 : 17
Before: 6000 : 17 After: 6000 : 15
Before: 7000 : 15 After: 7000 : 18
Before: 8000 : 18 After: 8000 : 15
Before: 9000 : 15 After: 9000 : 19
Before: 10000 : 19 After: 10000 : 15
Before: 11000 : 15 After: 11000 : 20
Before: 12000 : 20 After: 12000 : 15
Before: 13000 : 15 After: 13000 : 21
Before: 14000 : 21 After: 14000 : 15
Before: 15000 : 15 After: 15000 : 22
Before: 16000 : 22 After: 16000 : 15
Before: 17000 : 15 After: 17000 : 23
Before: 18000 : 23 After: 18000 : 15
Before: 19000 : 15 After: 19000 : 24
This doesn't fit with any pattern I could relate to, so I assumed it was a bug (that doesn't show up in use), with the original implementation.
However, you are correct that my implementations don't correctly comply with even my interpretation of the OPs requirements in as much as I have a fencepost error. The following two replacements correct that deficiency:
use constant STICK => pack 'C*', 15, map( ($_) x 2, 15 .. 23 ), (24) x
+ 100;
sub stick{
my $q = ord substr STICK, 1+ $_[0] / 1000;
return $q < $_[1] ? $_[1] : $q;
}
use constant STICK2 => [ 15, map( ($_) x 2, 15 .. 23 ), (24) x 100 ];
sub stick2{
my $q = STICK2->[ 1 + $_[0] / 1000 ];
return $q < $_[1] ? $_[1] : $q;
}
I guess only kiat will be able to tell us if my assumption was a pragmatic one.
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.
| [reply] [d/l] [select] |
|
|
Re: alternatives to if and series of elsif
by QM (Parson) on Jul 05, 2005 at 19:57 UTC
|
Coming late to the game, I used a predefined hash lookup:
{ # closure for qm
# build lookup hash
my $point_step = 2000;
my $point_max = 18000;
my $quota_offset = 15;
my %quota;
foreach my $p ( 1..$point_max/$point_step )
{
$quota{$p} = $p + $quota_offset;
}
sub qm
{
my ($points, $quota) = @_;
# $points-1 handles "less than but not equal"
$points = int(($points-1)/$point_step);
if ( exists( $quota{$points} )
and ( $quota < $quota{$points} ) )
{
return $quota{$points};
}
else
{
return 15;
}
} # sub qm
} # closure qm
I also ran this through the test script, and it checked out OK.
I used this version of stick2, which tested OK as well:
use constant STICK2 => [ 15, map( ($_) x 2, 15..23 ), (24) x 100 ];
sub stick2{
my $q = STICK2->[ 1 + $_[0] / 1000 ];
# changed to "<=", and "15"
return $q <= $_[1] ? 15 : $q;
} # sub stick2
Update: I added kutsu's to the mix, and fixed davidrw's davidrw_2 entry.
Here are the results:
Rate kutsu davidrw_2 davidrw_1 ternary op_orig qm op_c
+mp2 stick2
kutsu 37118/s -- -19% -33% -92% -92% -94% -
+94% -95%
davidrw_2 45997/s 24% -- -18% -90% -90% -92% -
+93% -94%
davidrw_1 55762/s 50% 21% -- -88% -88% -90% -
+91% -93%
ternary 463776/s 1149% 908% 732% -- -1% -19% -
+29% -41%
op_orig 469008/s 1164% 920% 741% 1% -- -18% -
+28% -41%
qm 571464/s 1440% 1142% 925% 23% 22% -- -
+12% -28%
op_cmp2 650147/s 1652% 1313% 1066% 40% 39% 14%
+ -- -18%
stick2 788323/s 2024% 1614% 1314% 70% 68% 38%
+21% --
While qm isn't quite as fast as op_cmp2, it will scale better for more breakpoints.
If the OP can maintain stick2, I'd go with that. However, it might be unmaintainable by Common Folk.
-QM
--
Quantum Mechanics: The dreams stuff is made of
| [reply] [d/l] [select] |