count of 1s in a binary number

[Fred]

if there is not a function that takes a scalar or array and count a
given charcter. I am trying to come up with a code

my $bit1 = 011001010;
my @bit2 = qw /01 00 11 01 00/;
print size ($bit1) "\n";
print size (@bit2) "\n";

I need a function which works on both data types

sub size {
my $tmp = shift;
my $i = 0;
foreach my $j ( @tmp ) {
if ( $j == 1 ) { $i++ };
}
return $i;
}

thanks

[Sam Holden]

On Fri, 07 Nov 2003 17:29:16 +1100, Fred <fJo...@yahoo.com> wrote:
> if there is not a function that takes a scalar or array and count a
> given charcter. I am trying to come up with a code

perldoc -q count

How can I count the number of occurrences of a substring within a string?

The idea is to readand FAQ before asking questions.

--
Sam Holden

[Fred]

fixes some bugs, but the main issue is how to get the sub to deal with
both data types and give the expected results which is the count of "1"
in the string or array with out writeing 2 subs

my $bit1 = 011001010;
my @bit2 = qw /01 00 11 01 00/;

print size_of ($bit1), "\n";
print size_of (@bit2), "\n";

sub size_of {
my ($tmp) = shift;
my $i = 0;
foreach my $j ($tmp) {

[Tassilo v. Parseval]

Also sprach Fred:

> if there is not a function that takes a scalar or array and count a
> given charcter. I am trying to come up with a code
>
>
> my $bit1 = 011001010;
> my @bit2 = qw /01 00 11 01 00/;
> print size ($bit1) "\n";
> print size (@bit2) "\n";
>
> I need a function which works on both data types

No need for a for-loop here:

sub size {
return "@_" =~ tr/1//;
}

> sub size {
> my $tmp = shift;
> my $i = 0;
> foreach my $j ( @tmp ) {
> if ( $j == 1 ) { $i++ };
> }
> return $i;
> }

Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval

[Fred]

if there is not a function that takes a scalar or array and count a
given charcter. I am trying to come up with a code

the main issue is how to get the sub to deal with both data types and
give the expected results which is the count of "1" in the string or
array with out writeing 2 subs

my $bit1 = "011001010";

my @bit2 = qw /01 00 11 01 00/;

print size_of($bit1), "\n";
print size_of(@bit2), "\n";

sub size_of {

my $tmp = shift;
my $i = 0;

foreach my $j (split //, $tmp) {

if ( $j == 1 ) { $i++ };
}
return $i;
}

thanks

[Fred]

if there is not a function that takes a scalar or array and count a
given charcter. I am trying to come up with a code

[Fred]

print size_of($bit1), "\n";
print size_of(@bit2), "\n";

sub size_of {

my $tmp = shift;
my $i = 0;

foreach my $j (split //, $tmp) {

if ( $j == 1 ) { $i++ };
}
return $i;
}

I am still unble to modify the code to handle the array and scalar and
give the count of 1s in either.

thanks for direction

[Jeff 'japhy' Pinyan]

On 7 Nov 2003, Tassilo v. Parseval wrote:

>No need for a for-loop here:
>
> sub size {
> return "@_" =~ tr/1//;
> }

Pedantic mode on:

sub size {
join("", @_) =~ tr/1//;
}

or

sub size {
local $" = "";
"@_" =~ tr/1//;
}

--
Jeff Pinyan RPI Acacia Brother #734 2003 Rush Chairman
"And I vos head of Gestapo for ten | Michael Palin (as Heinrich Bimmler)
years. Ah! Five years! Nein! No! | in: The North Minehead Bye-Election
Oh. Was NOT head of Gestapo AT ALL!" | (Monty Python's Flying Circus)

[Tad McClellan]

Fred <fJo...@yahoo.com> wrote:
> Fred wrote:
>> if there is not a function that takes a scalar or array and count a
>> given charcter.

[ Snip code corrected below.
Please *trim* the unnecessary text in your followups.
Please start doing this very soon.
]

> my $bit1 = "011001010";
> my @bit2 = qw /01 00 11 01 00/;
> print size_of($bit1), "\n";
> print size_of(@bit2), "\n";
>
> sub size_of {
> my $tmp = shift;

That's a pretty useless choice of variable name...

my $bits = join '', @_;

> my $i = 0;
> foreach my $j (split //, $tmp) {
> if ( $j == 1 ) { $i++ };
> }
> return $i;
> }
>
> I am still unble to modify the code to handle the array and scalar and
> give the count of 1s in either.

I'd do it without all of those temporary variables:

sub size_of {
return scalar grep $_ eq '1', split //, join '', @_;
}

--
Tad McClellan SGML consulting
ta...@augustmail.com Perl programming
Fort Worth, Texas

[Michele Dondi]

On Fri, 07 Nov 2003 18:36:24 +1100, Fred <fJo...@yahoo.com> wrote:

>the main issue is how to get the sub to deal with both data types and
>give the expected results which is the count of "1" in the string or
>array with out writeing 2 subs
>
>my $bit1 = "011001010";
>my @bit2 = qw /01 00 11 01 00/;

I know that this is not what you're asking, but is there any good
reason you use strings of chars v48.49 to represent your bit fields
instead of storing them into actual numbers? I'm not saying that there
is not, just asking!

OTOH Perl *does* support your choice by means of logical operators on
bitstrings, but unless you tell us what you *really* want to do, e.g.
reading huge amounts of binary data from file vs doing just a few
experiments on your own, one can't say what the best approach could
be.

If you choose to use numbers instead of bitstrings a less
Perl-specific way to count '1's is could be:

sub size1 {
# Recursive approach, terse and elegant IMHO.
# An iterative one is OK as well.
my $n=shift;
return 0 unless $n;
return ($n&1) + size1($n>>1);
}

sub size_many {
return 0 unless @_;
my $t;
$t+=size1($_) for @_;
$t;
}

for just one number and for a list respectively.

But then I see you do *not* want to write two subs; personally I can't
see why: subs/functions/etc in *any* language are designed precisely
to factorize code. Anyway notice that this can be done, *even* with a
recursive approach quite similar to that of size1():

sub size_many2 {
return 0 unless @_;
my $t;
$t+=$_&1 for @_;
$t+size_many2(grep $_, map $_>>1, @_);
}

Said this, it is worth noticing that also in this case you can
painlessly use the approach suggested by other posters to do the
actual calculation:

sub size {
qq.@{[map sprintf('%b',$_),@_]}. =~ tr/1//;
}

[I use qq.. rather than "" because of syntax highlighting reasons]

HTH,
Michele
--
# This prints: Just another Perl hacker,
seek DATA,15,0 and print q... <DATA>;
__END__

[Anno Siegel]

Michele Dondi <bik....@tiscalinet.it> wrote in comp.lang.perl.misc:

> On Fri, 07 Nov 2003 18:36:24 +1100, Fred <fJo...@yahoo.com> wrote:
>
> >the main issue is how to get the sub to deal with both data types and
> >give the expected results which is the count of "1" in the string or
> >array with out writeing 2 subs

[snip]

> If you choose to use numbers instead of bitstrings a less
> Perl-specific way to count '1's is could be:
>
> sub size1 {
> # Recursive approach, terse and elegant IMHO.
> # An iterative one is OK as well.
> my $n=shift;
> return 0 unless $n;
> return ($n&1) + size1($n>>1);
> }

That counts the bits of an n-bit number in n steps. There is an old trick
in the dying art of bit-fiddling that allows to count them as many steps
as there are one-bits. That is a significant advantage if the numbers
involved are small (or sparse, bit-wise).

The trick is to isolate the least significant one-bit in a number
in one step. This is essentially done by subtracting 1 from the number.
Beginning from the least significant bit, this builds a bridge of
one-bits until a one-bit is met in the original bit pattern. That one-bit
is set to zero, and the rest of the pattern is unchanged.

Comparing the bit patterns of the original and the decremented number from
the least significant side, we see that all bits are different up to,
and including, the first one-bit in the original number, and all bits are
the same in both from there onwards. So, xor-ing both together, we arrive
at a mask that has one-bits up to, and including, the first one-bit in the
original, and zero-bits elsewhere. The original number has exactly one
one-bit in the area of this mask: the least significant one-bit. So
and-ing together the mask and the original number we arrive at the desired
isolated one-bit. Another xor-operation sets this bit in the original to
zero, and we are ready to repeat the process.

While this certainly was lengthy to describe, in Perl terms the isolated
lowest one-bit of "$n" is "(($n - 1) ^ $n) & $n". In particular, there
is no loop involved, the operation takes the same time whether there
are few or many initial zero-bits to bridge.

Putting it together:

sub size2 {
my $n = shift;
my $size = $n ? 1 : 0;
$size++ while $n ^= (($n - 1) ^ $n) & $n;
$size;
}

This is merely an algorithmic annotation which has nothing to do with
Perl. Originally it was, of course, done in an assembler or another.
It's a cute little trick, and a pity there's no more use for it. There
is nothing similar for the MSB, by the way.

To bring back some Perl content, the standard way of bit counting is
probably through pack and unpack. Unpack does checksums, and the bit-count
can be seen as a checksum of a string of one bit data. Since we are only
interested in the bit count, we don't have to worry about endian-ness --
any integer format can be used to pack the bit string. So,

sub size3 {
my $x = shift;
unpack '%32b*', pack 'I', $x;
}

is more compact, and, presumably, faster, than the others. No more
use for the bit-counting trick in Perl either.

Anno

[Anno Siegel]

Michele Dondi <bik....@tiscalinet.it> wrote in comp.lang.perl.misc:

> On Fri, 07 Nov 2003 18:36:24 +1100, Fred <fJo...@yahoo.com> wrote:
>
> >the main issue is how to get the sub to deal with both data types and
> >give the expected results which is the count of "1" in the string or
> >array with out writeing 2 subs

[snip]

> If you choose to use numbers instead of bitstrings a less
> Perl-specific way to count '1's is could be:
>
> sub size1 {
> # Recursive approach, terse and elegant IMHO.
> # An iterative one is OK as well.
> my $n=shift;
> return 0 unless $n;
> return ($n&1) + size1($n>>1);
> }

That counts the bits of an n-bit number in n steps. There is an old trick
in the dying art of bit-fiddling that allows to count them in as many steps

[Michele Dondi]

On 8 Nov 2003 17:26:21 GMT, anno...@lublin.zrz.tu-berlin.de (Anno
Siegel) wrote:

>That counts the bits of an n-bit number in n steps. There is an old trick
>in the dying art of bit-fiddling that allows to count them in as many steps
>as there are one-bits. That is a significant advantage if the numbers
>involved are small (or sparse, bit-wise).

[...]

>While this certainly was lengthy to describe, in Perl terms the isolated
>lowest one-bit of "$n" is "(($n - 1) ^ $n) & $n". In particular, there

or equivalently "$n & ~($n-1)".

>This is merely an algorithmic annotation which has nothing to do with
>Perl. Originally it was, of course, done in an assembler or another.

Well, since I mentioned the "obvious" recursive version as an actual
example (but no more than that!), I think that your piece of code was
worth posting here anyway!

And thanks for the supplied information. I appreciated them very much,
for one.

>It's a cute little trick, and a pity there's no more use for it. There
>is nothing similar for the MSB, by the way.

This seems reasonable. But before saying something this definitive...
I'd check Prof. Knuth! BTW: are you absolutely sure there really isn't
anything similar for the MSB? Just for curiosity...

>To bring back some Perl content, the standard way of bit counting is
>probably through pack and unpack. Unpack does checksums, and the bit-count
>can be seen as a checksum of a string of one bit data. Since we are only
>interested in the bit count, we don't have to worry about endian-ness --
>any integer format can be used to pack the bit string. So,
>
> sub size3 {
> my $x = shift;
> unpack '%32b*', pack 'I', $x;
> }

Cool! Unfortunately I've not yet fully grasped the full power of
pack() and its friend unpack(). This is one of those times when
reading a NG reveals to be fruitful, I hope the OP will benefit from
your post too...

>is more compact, and, presumably, faster, than the others. No more

^^^^^^^^^^

#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw/:all/;

my $max= ~0;

my $res=timethese (100000, {
'size_rec' => "size_rec(int rand $max)",
'size_tr' => "size_tr(int rand $max)",
'size_trick' => "size_trick(int rand $max)",
'size_pack' => "size_pack(int rand $max)",
});

cmpthese($res);

sub size_rec {

my $n=shift;
return 0 unless $n;

return ($n&1) + size_rec($n>>1);
}

sub size_tr {

qq.@{[map sprintf('%b',$_),@_]}. =~ tr/1//;
}

sub size_trick {

my $n = shift;
my $size = $n ? 1 : 0;

$size++ while $n ^= $n & ~($n-1);
$size;
}


sub size_pack {

my $x = shift;
unpack '%32b*', pack 'I', $x;
}

__END__

Benchmark: timing 100000 iterations of size_pack, size_rec, size_tr,
size_trick...
size_pack: 0 wallclock secs ( 0.44 usr + 0.00 sys = 0.44 CPU) @
227272.73/s (n=100000)
size_rec: 5 wallclock secs ( 4.18 usr + 0.00 sys = 4.18 CPU) @
23923.44/s (n=100000)
size_tr: 0 wallclock secs ( 0.65 usr + 0.00 sys = 0.65 CPU) @
153846.15/s (n=100000)
size_trick: 0 wallclock secs ( 1.32 usr + 0.00 sys = 1.32 CPU) @
75757.58/s (n=100000)
Rate size_rec size_trick size_tr size_pack
size_rec 23923/s -- -68% -84% -89%
size_trick 75758/s 217% -- -51% -67%
size_tr 153846/s 543% 103% -- -32%
size_pack 227273/s 850% 200% 48% --

[Win98]

Benchmark: timing 1000000 iterations of size_pack, size_rec,
size_tr, size_trick...
size_pack: 3 wallclock secs ( 2.38 usr + 0.00 sys = 2.38 CPU) @
420168.07/s (n=1000000)
size_rec: 37 wallclock secs (37.67 usr + 0.00 sys = 37.67 CPU) @
26546.32/s (n=1000000)
size_tr: 5 wallclock secs ( 5.00 usr + 0.00 sys = 5.00 CPU) @
200000.00/s (n=1000000)
size_trick: 9 wallclock secs ( 8.53 usr + 0.00 sys = 8.53 CPU) @
117233.29/s (n=1000000)
Rate size_rec size_trick size_tr size_pack
size_rec 26546/s -- -77% -87% -94%
size_trick 117233/s 342% -- -41% -72%
size_tr 200000/s 653% 71% -- -52%
size_pack 420168/s 1483% 258% 110% --

[Linux, 10x iterations]

[Anno Siegel]

Michele Dondi <bik....@tiscalinet.it> wrote in comp.lang.perl.misc:

> On 8 Nov 2003 17:26:21 GMT, anno...@lublin.zrz.tu-berlin.de (Anno
> Siegel) wrote:

[...]

> >While this certainly was lengthy to describe, in Perl terms the isolated
> >lowest one-bit of "$n" is "(($n - 1) ^ $n) & $n". In particular, there
>
> or equivalently "$n & ~($n-1)".

Oh, right. I guess I got into the habit of avoiding negation when
working with bit vectors (strings). There it tends to create spurious
one-bits from the unused bits in the last byte. Since we have numbers,
that is no concern here.

> >It's a cute little trick, and a pity there's no more use for it. There
> >is nothing similar for the MSB, by the way.
>
> This seems reasonable. But before saying something this definitive...
> I'd check Prof. Knuth! BTW: are you absolutely sure there really isn't
> anything similar for the MSB? Just for curiosity...

Well, it was common wisdom that came with the trick. Since it relies
on carry propagation, and carry propagation works only one way, a
similar way to isolate the MSB can't be all that similar.

Anno

[Steffen Beyer]

"Anno Siegel" <anno...@lublin.zrz.tu-berlin.de> wrote in message news:boj8vt$iui$1...@mamenchi.zrz.TU-Berlin.DE...

> Putting it together:
>
> sub size2 {
> my $n = shift;
> my $size = $n ? 1 : 0;
> $size++ while $n ^= (($n - 1) ^ $n) & $n;
> $size;
> }

Note that the "XOR" operation is superfluous.

This also works (C code):

int c = 0xDEADBEEF; /* or whatever */
int count = 0;
while (c)
{
c &= c - 1;
count++;
}

Should work similarly in Perl.

BTW, that's exactly what the module "Bit::Vector" uses internally.

So here is another solution (TIMTOWTDI):

#!perl -w

use strict;
use Bit::Vector;

my $bit1 = "011001010";
my @bit2 = qw /01 00 11 01 00/;

print size_of($bit1), "\n";
print size_of(@bit2), "\n";

sub size_of
{
my($vec) = Bit::Vector->new(32);
$vec->from_Bin(join('', @_));
return $vec->Norm();
}

Hope this helps!

Cheers,
Steffen

[Steffen Beyer]

Here's another benchmark of the various solutions,
with a slightly improved size_trick and a new size_bitvec,
performed under Windows 2000 with a native build of
Perl 5.8.0:

C:\>perl bench.pl
Benchmark: timing 500000 iterations of size_bitvec, size_pack, size_rec, size_tr, size_trick...
size_bitvec: 2 wallclock secs ( 1.80 usr + 0.00 sys = 1.80 CPU) @ 278241.51/s (n=500000)
size_pack: 0 wallclock secs ( 1.41 usr + 0.00 sys = 1.41 CPU) @ 355366.03/s (n=500000)
size_rec: 33 wallclock secs (34.02 usr + 0.00 sys = 34.02 CPU) @ 14699.40/s (n=500000)
size_tr: 5 wallclock secs ( 4.61 usr + 0.00 sys = 4.61 CPU) @ 108483.40/s (n=500000)
size_trick: 8 wallclock secs ( 8.69 usr + 0.00 sys = 8.69 CPU) @ 57557.27/s (n=500000)
Rate size_rec size_trick size_tr size_bitvec size_pack
size_rec 14699/s -- -74% -86% -95% -96%
size_trick 57557/s 292% -- -47% -79% -84%
size_tr 108483/s 638% 88% -- -61% -69%
size_bitvec 278242/s 1793% 383% 156% -- -22%
size_pack 355366/s 2318% 517% 228% 28% --

And here's the program:

#!perl -w

use strict;
use warnings;
use Bit::Vector;
use Benchmark qw/:all/;

my $max= ~0;

my $vec = Bit::Vector->new(Bit::Vector->Word_Bits());

my $res=timethese (500000, {

'size_rec' => "size_rec(int rand $max)",
'size_tr' => "size_tr(int rand $max)",
'size_trick' => "size_trick(int rand $max)",
'size_pack' => "size_pack(int rand $max)",

'size_bitvec' => "size_bitvec(int rand $max)",
});

cmpthese($res);

sub size_rec {

my $n=shift;
return 0 unless $n;

return ($n&1) + size_rec($n>>1);
}

sub size_tr {

qq.@{[map sprintf('%b',$_),@_]}. =~ tr/1//;
}

sub size_trick {
my $n = shift;
my $size = 0;
$size++ while $n &= $n-1;
$size;
}

sub size_pack {

my $x = shift;
unpack '%32b*', pack 'I', $x;
}

sub size_bitvec {
$vec->Word_Store(0,$_[0]);
$vec->Norm();
}

__END__

[Anno Siegel]

Steffen Beyer <steffe...@de.bosch.com> wrote in comp.lang.perl.misc:

> "Anno Siegel" <anno...@lublin.zrz.tu-berlin.de> wrote in message
> news:boj8vt$iui$1...@mamenchi.zrz.TU-Berlin.DE...
>
> > Putting it together:
> >
> > sub size2 {
> > my $n = shift;
> > my $size = $n ? 1 : 0;
> > $size++ while $n ^= (($n - 1) ^ $n) & $n;
> > $size;
> > }
>
> Note that the "XOR" operation is superfluous.
>
> This also works (C code):
>
> int c = 0xDEADBEEF; /* or whatever */
> int count = 0;
> while (c)
> {
> c &= c - 1;

Oh, right. Its that simple.

> count++;
> }
>
> Should work similarly in Perl.
>
> BTW, that's exactly what the module "Bit::Vector" uses internally.

Have you considered a lookup-table? A byte lookup does eight bits in one
addition (and the table lookup). If half the bits are set on average,
a byte takes four counting steps in your loop.

Of course, a table is a boring piece of furniture, comparatively...

A little elaboration on the trick gives the number of the LSB:

sub low_bit {
my $x = shift;
int( 0.5 + log( $x & ~( $x - 1))/log( 2));
}

That's of little use in assembler or C, but in Perl it's fine.

Anno

[Anno Siegel]

Steffen Beyer <steffe...@de.bosch.com> wrote in comp.lang.perl.misc:

> "Anno Siegel" <anno...@lublin.zrz.tu-berlin.de> wrote in message
> news:boj8vt$iui$1...@mamenchi.zrz.TU-Berlin.DE...
>
> > Putting it together:
> >
> > sub size2 {
> > my $n = shift;
> > my $size = $n ? 1 : 0;
> > $size++ while $n ^= (($n - 1) ^ $n) & $n;
> > $size;
> > }
>
> Note that the "XOR" operation is superfluous.
>
> This also works (C code):
>
> int c = 0xDEADBEEF; /* or whatever */
> int count = 0;
> while (c)
> {
> c &= c - 1;

Oh, right. It's that simple.

> count++;
> }
>
> Should work similarly in Perl.
>
> BTW, that's exactly what the module "Bit::Vector" uses internally.

Have you considered a lookup-table? A byte lookup does eight bits in one

[Ilya Zakharevich]

[A complimentary Cc of this posting was sent to
Anno Siegel
<anno...@lublin.zrz.tu-berlin.de>], who wrote in article <boj8vt$iui$1...@mamenchi.zrz.TU-Berlin.DE>:

> > sub size1 {
> > # Recursive approach, terse and elegant IMHO.
> > # An iterative one is OK as well.
> > my $n=shift;
> > return 0 unless $n;
> > return ($n&1) + size1($n>>1);
> > }

> That counts the bits of an n-bit number in n steps. There is an old trick
> in the dying art of bit-fiddling that allows to count them in as many steps
> as there are one-bits. That is a significant advantage if the numbers
> involved are small (or sparse, bit-wise).

Should be quite sparse to beat something like this:

sub count_bits ($) {
my $x = shift;
my $shift = 1;
for my $mask (0x55555555, 0x33333333, 0x0f0f0f0f, 0x00ff00ff, 0x0000ffff) {
$x = ($x & $mask) + (($x >> $shift) & $mask);
$shift *= 2;
}
$x;
}

print count_bits 0b111110010111000111101010001001;

(especially if one unwinds the loop, so there is no need to maintain
$shift). If it were C on a PC, I would also note that this
OOO-executes better...

Hope this helps,
Ilya

[Anno Siegel]

Ilya Zakharevich <nospam...@ilyaz.org> wrote in comp.lang.perl.misc:

> [A complimentary Cc of this posting was sent to
> Anno Siegel
> <anno...@lublin.zrz.tu-berlin.de>], who wrote in article
> <boj8vt$iui$1...@mamenchi.zrz.TU-Berlin.DE>:
> > > sub size1 {
> > > # Recursive approach, terse and elegant IMHO.
> > > # An iterative one is OK as well.
> > > my $n=shift;
> > > return 0 unless $n;
> > > return ($n&1) + size1($n>>1);
> > > }
>
> > That counts the bits of an n-bit number in n steps. There is an old trick
> > in the dying art of bit-fiddling that allows to count them in as many steps
> > as there are one-bits. That is a significant advantage if the numbers
> > involved are small (or sparse, bit-wise).
>
> Should be quite sparse to beat something like this:
>
> sub count_bits ($) {
> my $x = shift;
> my $shift = 1;
> for my $mask (0x55555555, 0x33333333, 0x0f0f0f0f, 0x00ff00ff, 0x0000ffff) {
> $x = ($x & $mask) + (($x >> $shift) & $mask);
> $shift *= 2;
> }
> $x;
> }
>
> print count_bits 0b111110010111000111101010001001;

Yikes, what's that? Wait... it's considering $x as a series of $shift-bit
($shift = 1, 2, 4,..) numbers and makes room for overflow using the mask
and doing every addition in two steps. I hadn't seen this before, thanks
for bringing it up.

I'll do some benchmarks when I get a minute. I'm curious how it compares
with a lookup table.

Anno

[Alan J. Flavell]

On Wed, 12 Nov 2003, Ilya Zakharevich wrote:

> sub count_bits ($) {
> my $x = shift;
> my $shift = 1;
> for my $mask (0x55555555, 0x33333333, 0x0f0f0f0f, 0x00ff00ff, 0x0000ffff) {
> $x = ($x & $mask) + (($x >> $shift) & $mask);
> $shift *= 2;
> }
> $x;
> }

Ah, nostalgia. I programmed something very close that in IBM
assembler many years back, in connection with a bubble-chamber film
scanning program.

thanks!

[Anno Siegel]

Anno Siegel <anno...@lublin.zrz.tu-berlin.de> wrote in comp.lang.perl.misc:

Okay, here are the promised benchmarks.

Rate direct decrement ilya table
direct 18877/s -- -50% -65% -77%
decrement 37451/s 98% -- -30% -54%
ilya 53439/s 183% 43% -- -34%
table 80850/s 328% 116% 51% --

The four routines all count the bits in a 32 bit integer.

direct - uses a plain shift-and-count approach
decrement - picks the MSB through the $x & ($x - 1) technique
ilya - the method Ilya presented (and Alan recognized)
table - uses a one-byte lookup table

Complete code below.

So Ilya's code is indeed fastest among those that actually do the counting,
but a lookup table beats them all.

Anno

-------------------------------------------------------------------
#!/usr/local/bin/perl
use strict; use warnings;
use Benchmark qw( :all);
use Text::Table;

goto bench;

my $tb = Text::Table->new( qw( n bin), \' | ',
qw( direct decrement ilya table)
);
for ( 1 .. 3 ) {
my $x = int rand( 2**32);
$tb->add( $x, sprintf( "%32b", $x),
direct( $x), decrement( $x), ilya( $x), table( $x));
}
print $tb;
exit;

bench:

cmpthese( -5, {
direct => 'direct( int rand 2**32)',
decrement => 'decrement( int rand 2**32)',
ilya => 'ilya( int rand 2**32)',
table => 'table( int rand 2**32)',
});

###################################################################

# bit counting

sub direct {
my $x = shift;
my $count = 0;
while ( $x ) {
$count += $x & 1;
$x >>= 1;
}
$count;
}

sub decrement {
my $x = shift;
my $count = 0;
while ( $x ) {
$count++;
$x &= $x - 1;
}
$count;
}

sub ilya {

my $x = shift;
my $shift = 1;
for my $mask (0x55555555, 0x33333333, 0x0f0f0f0f, 0x00ff00ff, 0x0000ffff) {
$x = ($x & $mask) + (($x >> $shift) & $mask);
$shift *= 2;
}
$x;
}

my @table;
BEGIN {
$table[ $_] = direct( $_) for 0 .. 255;
}

sub table {
my $x = shift;
my $count = 0;
while ( $x ) {
$count += $table[ $x & 255];
$x >>= 8;
}
$count;
}

[Sam Huffman]

anno...@lublin.zrz.tu-berlin.de (Anno Siegel) writes:

> Okay, here are the promised benchmarks.
>
> Rate direct decrement ilya table
> direct 18877/s -- -50% -65% -77%
> decrement 37451/s 98% -- -30% -54%
> ilya 53439/s 183% 43% -- -34%
> table 80850/s 328% 116% 51% --

An unrolled version of ilya is even better. I found this c code snippet
somewhere (long since forgotten the source), and have used it extensively;
converted to perl:

sub unrolled
{
my $n = shift;

$n = ($n & 0x55555555) + (($n & 0xaaaaaaaa) >> 1);
$n = ($n & 0x33333333) + (($n & 0xcccccccc) >> 2);
$n = ($n & 0x0f0f0f0f) + (($n & 0xf0f0f0f0) >> 4);
$n = ($n & 0x00ff00ff) + (($n & 0xff00ff00) >> 8);
$n = ($n & 0x0000ffff) + (($n & 0xffff0000) >> 16);

$n;
}

On my machine, with 5.8.0, this beats the table by 16%:
Rate direct decrement ilya table unrolled
direct 55042/s -- -47% -56% -76% -79%
decrement 104462/s 90% -- -16% -54% -60%
ilya 125005/s 127% 20% -- -45% -52%
table 226603/s 312% 117% 81% -- -14%
unrolled 261986/s 376% 151% 110% 16% --

Sam

[Anno Siegel]

Sam Huffman <shuf...@ichips.intel.com> wrote in comp.lang.perl.misc:

> anno...@lublin.zrz.tu-berlin.de (Anno Siegel) writes:
>
> > Okay, here are the promised benchmarks.
> >
> > Rate direct decrement ilya table
> > direct 18877/s -- -50% -65% -77%
> > decrement 37451/s 98% -- -30% -54%
> > ilya 53439/s 183% 43% -- -34%
> > table 80850/s 328% 116% 51% --
>
> An unrolled version of ilya is even better. I found this c code snippet
> somewhere (long since forgotten the source), and have used it extensively;
> converted to perl:
>
> sub unrolled
> {
> my $n = shift;
>
> $n = ($n & 0x55555555) + (($n & 0xaaaaaaaa) >> 1);
> $n = ($n & 0x33333333) + (($n & 0xcccccccc) >> 2);
> $n = ($n & 0x0f0f0f0f) + (($n & 0xf0f0f0f0) >> 4);
> $n = ($n & 0x00ff00ff) + (($n & 0xff00ff00) >> 8);
> $n = ($n & 0x0000ffff) + (($n & 0xffff0000) >> 16);
>
> $n;
> }
>
> On my machine, with 5.8.0, this beats the table by 16%:

24% on mine:

Rate direct decrement ilya table unrolled

direct 18836/s -- -49% -65% -76% -81%
decrement 37216/s 98% -- -30% -53% -62%
ilya 53235/s 183% 43% -- -33% -46%
table 78938/s 319% 112% 48% -- -19%
unrolled 97699/s 419% 163% 84% 24% --

I am pleased to see the clever algorithm beat the brute force approach
of lookup. And it's indeed a log( w) algorithm, where w is the word
size, unlike all others which are linear in w.

Speed is bought by portability here -- the fast algorithm needs maintenance
for a switch of word size (not only the unrolled one), while the others
work for any word size.

Anno

PS: If you're tired of answering this, just ignore me, but... any relation?

[Sara]

Fred <fJo...@yahoo.com> wrote in message news:<3FAB3BBC...@yahoo.com>...

Hmm I'm not entirely sure I understand your program requirements, but
here is a little trial. The sub "ones" returns the number of 1's in
either a binary scalar, or an array of binary scalars. And as I like
all of my subs(), no LOOPS :)

#!/usr/bin/perl -wd

$_ = '101010111010101';
my @b = qw(01 10 11 01 01 00);

my $r = ones($_);
print "scalar: $r\n";;

$r = ones(\@b);
print "array: $r\n";;

exit 0;

sub ones
{local $_ = $_[0];
$_ = join '', @$_ if ref $_;
s/(.)/$1+/g;
s/\+$//;
return eval;
}

[tux@tux ~]$ ./ones.pl

Loading DB routines from perl5db.pl version 1.19
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

main::(./ones.pl:3): $_ = '101010111010101';
DB<1> c
scalar: 9
array: 6
Debugged program terminated. Use q to quit or R to restart,

-Gx

[Ilya Zakharevich]

[A complimentary Cc of this posting was sent to
Anno Siegel

<anno...@lublin.zrz.tu-berlin.de>], who wrote in article <botdgl$6eg$1...@mamenchi.zrz.TU-Berlin.DE>:

> > sub count_bits ($) {
> > my $x = shift;
> > my $shift = 1;
> > for my $mask (0x55555555, 0x33333333, 0x0f0f0f0f, 0x00ff00ff, 0x0000ffff) {
> > $x = ($x & $mask) + (($x >> $shift) & $mask);
> > $shift *= 2;
> > }
> > $x;
> > }

> Yikes, what's that? Wait... it's considering $x as a series of $shift-bit

> ($shift = 1, 2, 4,..) numbers and makes room for overflow using the mask
> and doing every addition in two steps.

Thanks for wording it out. *This* way it is much clearer that when
the loop is unrolled, one can speed up it circa other 20%: the
overflow may happen only when $shift is 1, 2, 8. So one needs masking
on these steps only: some bits of the ($shift-bits) numbers would be
"dirty", so one needs 1 extra masking at the end.

> I hadn't seen this before, thanks for bringing it up.

I think I discussed it on one of Perl lists circa mid-90s. [Of
course, even then it was possible to find prior art; today, with
google, you get many hits on these numbers...]

Hope this helps,
Ilya

[Sam Huffman]

anno...@lublin.zrz.tu-berlin.de (Anno Siegel) writes:

> Sam Huffman <shuf...@ichips.intel.com> wrote in comp.lang.perl.misc:
> >
>

> PS: If you're tired of answering this, just ignore me, but... any relation?

No :)

Sam

[Sara]

Fred <fJo...@yahoo.com> wrote in message news:<3FAB4BB6...@yahoo.com>...

I tightened up my code a bit this seems to work.... Benchmark would
probably be pretty good compared to looping solutions (assuming I
understand yuor requirements)...

Have fun!

G

#!/usr/bin/perl -wd

$_ = '101010111010101';
my @b = qw(01 10 11 01 01 00);

my $r = ones($_);
print "scalar: $r\n";;

$r = ones(\@b);
print "array: $r\n";;

exit 0;

sub ones
{my $b = $_[0];
$b = join '', @$b if ref $b;
$b =~ s/(.)(?=.)/$1+/g;
return eval $b;
}

[Steffen Beyer]

"Ilya Zakharevich" <nospam...@ilyaz.org> wrote in message news:bou912$18o8$1...@agate.berkeley.edu...

> > > sub count_bits ($) {
> > > my $x = shift;
> > > my $shift = 1;
> > > for my $mask (0x55555555, 0x33333333, 0x0f0f0f0f, 0x00ff00ff, 0x0000ffff) {
> > > $x = ($x & $mask) + (($x >> $shift) & $mask);
> > > $shift *= 2;
> > > }
> > > $x;
> > > }

> > I hadn't seen this before, thanks for bringing it up.

> I think I discussed it on one of Perl lists circa mid-90s. [Of
> course, even then it was possible to find prior art; today, with
> google, you get many hits on these numbers...]

I've seen it on www.snippets.org back when I implemented this in my
Bit::Vector module.

Note that the different algorithms may score differently in C due to
differences in overhead between C and Perl.

Best regards,
Steffen Beyer

[Michele Dondi]

On 12 Nov 2003 17:13:07 GMT, anno...@lublin.zrz.tu-berlin.de (Anno
Siegel) wrote:

>> I'll do some benchmarks when I get a minute. I'm curious how it compares
>> with a lookup table.
>
>Okay, here are the promised benchmarks.

BTW: the thread from which this one originated and this one are
jointly one of the best discussions I've read (and took part to)
recently here on clpm. It may constitute the basis of a case study for
an exposition or something similar...

[Roy Johnson]

But if you unroll the table sub, it retakes the lead. At least on my box.

sub table {
my $x = shift;

$table[ $x & 0xff ] + $table [ ($x >> 8) & 0xff ] +
$table [ ($x >> 16) & 0xff ] + $table [ ($x >> 24) & 0xff ];
}

[Anno Siegel]

Roy Johnson <rjoh...@shell.com> wrote in comp.lang.perl.misc:

Ah, but table is linear, shift/mask/add is logarithmic. Just wait for
the new 1024 bit machines...

Anno

[Anno Siegel]

Michele Dondi <bik....@tiscalinet.it> wrote in comp.lang.perl.misc:

> On 12 Nov 2003 17:13:07 GMT, anno...@lublin.zrz.tu-berlin.de (Anno
> Siegel) wrote:
>
> >> I'll do some benchmarks when I get a minute. I'm curious how it compares
> >> with a lookup table.
> >
> >Okay, here are the promised benchmarks.
>
> BTW: the thread from which this one originated and this one are
> jointly one of the best discussions I've read (and took part to)
> recently here on clpm. It may constitute the basis of a case study for
> an exposition or something similar...

Not an attempt to revive this thread (it *was* a good one), I just want
to mention that I have code that compiles, in either Perl or C, the
mask/shift/add-method (thread-insiders know what I mean) according to
the current word length. By itself it doesn't quite make a CPAN module,
but if anyone wants to make use of it, it's at

http://www.tu-berlin.de/zrz/mitarbeiter/anno4000/clpm/bench.bitcount

It's in the form of a benchmark, but the relevant code is easily extracted.

Anno

[Ilya Zakharevich]

[A complimentary Cc of this posting was sent to
Anno Siegel

<anno...@lublin.zrz.tu-berlin.de>], who wrote in article <bpnmtk$fja$1...@mamenchi.zrz.TU-Berlin.DE>:

> Not an attempt to revive this thread (it *was* a good one)

Ok, so let *me* attempt to revive it. ;-)

> I just want
> to mention that I have code that compiles, in either Perl or C, the
> mask/shift/add-method (thread-insiders know what I mean) according to
> the current word length. By itself it doesn't quite make a CPAN module,
> but if anyone wants to make use of it, it's at
>
> http://www.tu-berlin.de/zrz/mitarbeiter/anno4000/clpm/bench.bitcount

I do not see the *other* optimization I (kinda ;-) mentioned used:

"MASKING" is required only on steps when "the step number" is a
power of 2 (so only with 1-bit, 2-bit, 4-bit, 16-bit, 256-bit etc
"nibbles").

Hope this helps,
Ilya

[Anno Siegel]

Ilya Zakharevich <nospam...@ilyaz.org> wrote in comp.lang.perl.misc:

I think I see what you mean, overflow cannot occur on some steps, so
we don't care if spurious additions happen on the side as long as we
mask off the results eventually.

I don't quite see how you arrive at the particular step numbers that
require masking, and applied blindly to my code-generator they appear
to give the wrong result. That's very preliminary, I'll pursue it
further... or maybe not :)

Anno

[Michele Dondi]

On Sat, 22 Nov 2003 23:18:58 +0000 (UTC), Ilya Zakharevich
<nospam...@ilyaz.org> wrote:

>> Not an attempt to revive this thread (it *was* a good one)
>
>Ok, so let *me* attempt to revive it. ;-)

[snip]

>I do not see the *other* optimization I (kinda ;-) mentioned used:

Also, as another attempt to (*sort of*) reviving it, why don't you
include also less performant solutions that may be useful when
conjuring up a quick hack, such as those based upon tr/// et similia?
This would be, as I hinted in my previous post, mostly for educational
purposes...

[Anno Siegel]

Anno Siegel <anno...@lublin.zrz.tu-berlin.de> wrote in comp.lang.perl.misc:

[following up to myself some more]

Okay, I wasn't using the right final mask, I'm getting correct results
now.

I still don't agree which steps need masking and which don't.
http://www.hackersdelight.org/HDcode/newCode/pop_arrayHS.cc (only the
first code example relevant) doesn't show masking for the 16-bit step.
It shows further possible optimizations in masking only one of the
summands in some cases.

I can't come up with a useful rule for when masking is needed. The rule
seems to be more involved than "step-numbers that are powers of two". Step
0 never fit in there anyway.

Anno

[Alan J. Flavell]

On Mon, 24 Nov 2003, Anno Siegel wrote:

> I can't come up with a useful rule for when masking is needed. The rule
> seems to be more involved than "step-numbers that are powers of two".

Yup, that's how I remembered it from way back. I worked it out for
our 32-bit case (the unrolled loop fitted in the IBM mainframe's
execution cache anyway), but I didn't work out a general rule for when
it would be necessary in the general case.

(In any case the code is long lost - the punched cards tossed, and the
mag tapes used as bird scares and garden twine...).

cheers

[David Combs]

In article <boj8vt$iui$1...@mamenchi.zrz.TU-Berlin.DE>,

Anno Siegel <anno...@lublin.zrz.tu-berlin.de> wrote:
>Michele Dondi <bik....@tiscalinet.it> wrote in comp.lang.perl.misc:

>> On Fri, 07 Nov 2003 18:36:24 +1100, Fred <fJo...@yahoo.com> wrote:
>>
>> >the main issue is how to get the sub to deal with both data types and
>> >give the expected results which is the count of "1" in the string or
>> >array with out writeing 2 subs
>
>[snip]
>
>> If you choose to use numbers instead of bitstrings a less
>> Perl-specific way to count '1's is could be:

>>
>> sub size1 {
>> # Recursive approach, terse and elegant IMHO.
>> # An iterative one is OK as well.
>> my $n=shift;
>> return 0 unless $n;
>> return ($n&1) + size1($n>>1);
>> }
>
>That counts the bits of an n-bit number in n steps. There is an old trick
>in the dying art of bit-fiddling that allows to count them in as many steps
>as there are one-bits. That is a significant advantage if the numbers
>involved are small (or sparse, bit-wise).
>

>The trick is to isolate the least significant one-bit in a number
>in one step. This is essentially done by subtracting 1 from the number.
>Beginning from the least significant bit, this builds a bridge of
<SNIP>

Where'd you find that, HAKMEM maybe?

David

[Anno Siegel]

David Combs <dkc...@panix.com> wrote in comp.lang.perl.misc:

No, I came across it in an obscure 6502 users-group monthly (xeroxed
format, title long forgotten).

Anno