Dirk Bremer wrote:
> Here is a quicker version of the zero-suppression routine that will also float a
>leading sign character:
>
> sub ZeroSuppress2($)
> {
> my $self = shift;
>
> # Return if the argument is less than two digits.
> return($self) if (length($self) < 2);
>
> # Search for a embedded decimal point.
> my $decimal = rindex($self,'.');
>
> # If the decimal point exists, substract one from its position
> # to define the end point of the zero-suppression, else determine
> # the entire length of the string and subtract one to define the
> # end point of the zero-suppression.
> if ($decimal > 0) {$decimal-- ;}
> else {$decimal = length($self) - 1;}
>
> # Iterate through the list suppressing leading zeroes.
> my $i;
> my $c;
> for ($i = 0; $i < $decimal; $i++)
> {
> $c = substr($self,$i,1);
> # Skip to the next character if the current character is a
> # plus-sign, minus-sign, or space.
> next if ($c eq ' ' or
> $c eq '+' or
> $c eq '-');
>
> # Terminate the loop if the current character is s digit.
> last if ($c > 0);
>
> # Replace the zero in the current character with a space.
> substr($self,$i,1) = ' ';
> }
>
> $c = substr($self,0,1);
> # Check for a leading sign-character.
> if ($c eq '+' or $c eq '-')
> {
> # If the list has more two elements, move the sign-character
> # from the leftmost position to the position of the rightmost
> # space character.
> if ($i > 1) {substr($self,$i - 1,1) = $c; substr($self,0,1) = ' ';}
> }
>
> return($self);
> }
>
> After running some more benchmarks, this routine is several orders of magnitude
>faster than sprinf or a regex.
I modified your routine a bit to handle replacing 0's with blanks or
just removing the leading 0's. My benchmark show the RE to be faster
unless I made a mistake somewhere.
sub ZeroSuppress2 ($;$) {
my $self = shift;
my $replace = shift || 0;
# Return if the argument is less than two digits.
return $self if length ($self) < 2;
# Search for a embedded decimal point.
# If the decimal point exists, substract one from its position
# to define the end point of the zero-suppression, else determine
# the entire length of the string and subtract one to define the
# end point of the zero-suppression.
my $decimal = rindex ($self, '.') - 1;
$decimal = length ($self) - 1 if $decimal < 0;
# Iterate through the list suppressing leading zeroes.
my ($c, $i);
for ($i = 0; $i < $decimal; $i++) {
$c = substr ($self, $i, 1);
# Skip to the next character if the current character is a
# plus-sign, minus-sign, or space.
next if $c eq ' ' or $c eq '+' or $c eq '-';
# Terminate the loop if the current character is s digit.
last if ($c gt '0');
# Replace the zero in the current character with a space.
if ($replace) {
substr ($self, $i, 1) = ' ';
} else {
$self = substr ($self, 0, $i) . substr ($self, $i+1);
$i--; $decimal--;
}
}
$c = substr ($self, 0, 1);
# Check for a leading sign-character.
if ($replace and $c eq '+' or $c eq '-') {
# If the list has more two elements, move the sign-character
# from the leftmost position to the position of the rightmost
# space character.
if ($i > 1) {
substr ($self, $i - 1, 1) = $c;
substr ($self, 0, 1) = ' ';
}
}
return $self;
}
sub ZeroSuppress3 ($;$) {
local $_ = shift;
my $replace = shift || 0;
if ($replace) {
1 while s/(?<!\.)\b0(?=\d)/ /;
s/([-+])(\s+)/$2$1/;
} else {
s/(?<!\.)\b0+(?=\d)//;
}
return $_;
}
use Benchmark;
my $num = '000001.001';
timethese (400_000, {
'ZS2' => "ZeroSuppress2 ($num, 0)",
'ZS3' => "ZeroSuppress3 ($num, 0)",
'ZS2r' => "ZeroSuppress2 ($num, 1)", # replace 0's with blanks
'ZS3r' => "ZeroSuppress3 ($num, 1)",
});
my $num = '000001.001';
Benchmark: timing 400000 iterations of ZS2, ZS2r, ZS3, ZS3r...
ZS2: 7 wallclock secs ( 6.59 usr + 0.00 sys = 6.59 CPU) @ 60698.03/s
(n=400000)
ZS2r: 6 wallclock secs ( 6.81 usr + 0.00 sys = 6.81 CPU) @ 58737.15/s
(n=400000)
ZS3: 4 wallclock secs ( 3.84 usr + 0.00 sys = 3.84 CPU) @ 104166.67/s
(n=400000)
ZS3r: 5 wallclock secs ( 5.66 usr + 0.00 sys = 5.66 CPU) @ 70671.38/s
(n=400000)
my $num = '+000001.001';
Benchmark: timing 400000 iterations of ZS2, ZS2r, ZS3, ZS3r...
ZS2: 9 wallclock secs ( 8.62 usr + 0.00 sys = 8.62 CPU) @ 46403.71/s
(n=400000)
ZS2r: 13 wallclock secs (12.14 usr + 0.00 sys = 12.14 CPU) @ 32948.93/s
(n=400000)
ZS3: 2 wallclock secs ( 2.64 usr + 0.00 sys = 2.64 CPU) @ 151515.15/s
(n=400000)
ZS3r: 3 wallclock secs ( 3.35 usr + 0.00 sys = 3.35 CPU) @ 119402.99/s
(n=400000)
--
,-/- __ _ _ $Bill Luebkert ICQ=14439852
(_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
/ ) /--< o // // http://dbecoll.tripod.com/ (Free site for Perl)
-/-' /___/_<_</_</_ Castle of Medieval Myth & Magic http://www.todbe.com/
_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
