bm1.pl


   1 #!/usr/local/bin/perl
   2 # initial perl from
   3 # http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-11/1062.html
   4 # but many more from C fragments noted and other CLPM posts as noted
   5 # see also http://en.wikipedia.org/wiki/Hamming_weight
   6 
   7 use strict;
   8 use warnings;
   9 use Benchmark qw( :all);
  10 
  11 # use Text::Table;
  12 
  13 # goto bench;
  14 
  15 #my $tb = Text::Table->new( qw( n bin), \' | ',
  16 #    qw( direct decrement ilya table)
  17 #);
  18 #for ( 1 .. 3 ) {
  19 #    my $x = int rand( 2**32);
  20 #    $tb->add( $x, sprintf( "%32b", $x),
  21 #    direct( $x), decrement( $x), ilya( $x), table( $x));
  22 #}
  23 #print $tb;
  24 #exit;
  25 
  26 # bench:
  27 
  28 cmpthese(
  29     -5,
  30     {
  31         direct       => 'direct( int rand 2**32)',
  32         decrement    => 'decrement( int rand 2**32)',
  33         ilya         => 'ilya( int rand 2**32)',
  34         table        => 'table( int rand 2**32)',
  35         unrolled     => 'unrolled( int rand 2**32)',
  36         table_unroll => 'table_unroll( int rand 2**32)',
  37         katz         => 'katz( int rand 2**32)',
  38         builtin_bc   => 'builtin_bc( int rand 2**32)',
  39         ls1b         => 'ls1b( int rand 2**32)',
  40         nifty_par    => 'nifty_par( int rand 2**32)',
  41         rec_n        => 'rec_n( int rand 2**32)',
  42         sprintftr    => 'sprintftr( int rand 2**32)',
  43         hakmem_169   => 'hakmem_169( int rand 2**32)',
  44 
  45         #    via_bitvec => 'via_bitvec( int rand 2**32)',
  46     }
  47 );
  48 
  49 ###################################################################
  50 
  51 # bit counting
  52 # see also
  53 # http://infolab.stanford.edu/~manku/bitcount/bitcount.html
  54 # moved to > http://gurmeetsingh.wordpress.com/2008/08/05/fast-bit-counting-routines/
  55 # http://www.setbb.com/phpbb/viewtopic.php?mforum=sudoku&p=7629
  56 # http://gurmeetsingh.wordpress.com/2008/08/05/fast-bit-counting-routines/
  57 
  58 sub hakmem_169 {
  59 
  60 # octal 11111111111 = decimal 1227133513 =  hex 0x49249249 = (as time_t) Wed Nov 19 22:25:13 UTC 2008
  61 # This number is sacred to HAKMEM 169, bitcount.
  62 # http://blogs.msdn.com/jeuge/archive/2005/06/08/HAKMEM-Bit-Count.aspx
  63 # http://www.inwap.com/pdp10/hbaker/hakmem/hakmem.html
  64 # http://www.inwap.com/pdp10/hbaker/hakmem/hacks.html#item169
  65 # For 64-bit numbers, we would have to add triples of octal digits and use modulus 1023
  66 ## does that make it loglog N ?
  67     my $u = shift;
  68     my $uCount =
  69       $u - ( ( $u >> 1 ) & 033333333333 ) - ( ( $u >> 2 ) & 011111111111 );
  70     return ( ( $uCount + ( $uCount >> 3 ) ) & 030707070707 ) % 63;
  71 
  72 }
  73 ### would & 63 or 0x3F be faster  and still correct ?
  74 
  75 sub rec_n {
  76 
  77 # http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-11/0642.html
  78 # Recursive approach, terse and elegant IMHO.
  79 # An iterative one is OK as well.
  80     my $n = shift;
  81     return 0 unless $n;
  82     return ( $n & 1 ) + rec_n( $n >> 1 );
  83 }
  84 
  85 sub sprintftr {
  86 
  87 # http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-11/0785.html
  88     qq.@{[map sprintf('%b',$_),@_]}. =~ tr/1//;
  89 }
  90 
  91 sub direct {
  92     my $x     = shift;
  93     my $count = 0;
  94     while ($x) {
  95         $count += $x & 1;
  96         $x >>= 1;
  97     }
  98     $count;
  99 }
 100 
 101 sub decrement {
 102     my $x     = shift;
 103     my $count = 0;
 104     while ($x) {
 105         $count++;
 106         $x &= $x - 1;
 107     }
 108     $count;
 109 }
 110 
 111 sub ilya {
 112 
 113     # claims log N time
 114     my $x     = shift;
 115     my $shift = 1;
 116     for my $mask ( 0x55555555, 0x33333333, 0x0f0f0f0f, 0x00ff00ff, 0x0000ffff )
 117     {
 118         $x = ( $x & $mask ) + ( ( $x >> $shift ) & $mask );
 119         $shift *= 2;
 120     }
 121     $x;
 122 }
 123 
 124 sub unrolled    # ilya unrolled
 125 {
 126 
 127 # http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-11/1067.html
 128 # aka #4 on http://gurmeetsingh.wordpress.com/2008/08/05/fast-bit-counting-routines/
 129     my $n = shift;
 130 
 131     # can use same mask twice if shift $n then mask
 132     # n = (n & MASK_01010101) + ((n >> 1) & MASK_01010101) ;
 133     $n = ( $n & 0x55555555 ) + ( ( $n & 0xaaaaaaaa ) >> 1 );
 134     $n = ( $n & 0x33333333 ) + ( ( $n & 0xcccccccc ) >> 2 );
 135     $n = ( $n & 0x0f0f0f0f ) + ( ( $n & 0xf0f0f0f0 ) >> 4 );
 136     $n = ( $n & 0x00ff00ff ) + ( ( $n & 0xff00ff00 ) >> 8 );
 137     $n = ( $n & 0x0000ffff ) + ( ( $n & 0xffff0000 ) >> 16 );
 138 
 139     $n;
 140 }
 141 
 142 sub nifty_par    # ilya unrolled plus modulus
 143 {
 144 
 145 # #5 on http://gurmeetsingh.wordpress.com/2008/08/05/fast-bit-counting-routines/
 146     my $n = shift;
 147 
 148     # can use same mask twice if shift $n then mask
 149     # n = (n & MASK_01010101) + ((n >> 1) & MASK_01010101) ;
 150     $n = ( $n & 0x55555555 ) + ( ( $n & 0xaaaaaaaa ) >> 1 );
 151     $n = ( $n & 0x33333333 ) + ( ( $n & 0xcccccccc ) >> 2 );
 152     $n = ( $n & 0x0f0f0f0f ) + ( ( $n & 0xf0f0f0f0 ) >> 4 );
 153 
 154     # $n = ($n & 0x00ff00ff) + (($n & 0xff00ff00) >> 8);
 155     # $n = ($n & 0x0000ffff) + (($n & 0xffff0000) >> 16);
 156     return $n % 255;
 157 }
 158 
 159 sub katz {
 160 
 161     # from ftp.port80.se/pub/CPAN/authors/id/Y/YA/YARBER/kat.pl-1.03
 162     my $list = unpack(
 163         'B*', shift    # $data
 164     );
 165     $list =~ tr/0//d;
 166 
 167     # my $len = length($data);
 168     my $total = length($list);
 169 
 170     #my $avg = $len * 4;
 171     #my $dif = $total - $avg;
 172     #print("$len bytes, $total 1-bits ($avg + $dif)\n\n");
 173     return $total;
 174 }
 175 
 176 sub builtin_bc {
 177 
 178 # http://perldoc.perl.org/perlpacktut.html#Doing-Sums
 179 # http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-11/0656.html
 180     my $bitcount = unpack( '%32b*', shift );
 181 
 182 }
 183 
 184 sub ls1b {
 185 
 186 # size2 http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-11/0656.html
 187 # Wegner-Kernighan
 188     my $n = shift;
 189     my $size = $n ? 1 : 0;
 190     $size++ while $n ^= ( ( $n - 1 ) ^ $n ) & $n;
 191     $size;
 192 }
 193 
 194 ###############
 195 # trade space for time ...
 196 # and still is proprotional to wordsize N linear
 197 #
 198 my @table;
 199 
 200 BEGIN {
 201     $table[$_] = direct($_)
 202       for 0 .. 255;    # not the most efficient pre-computation either ...
 203 }
 204 
 205 sub table {
 206     my $x     = shift;
 207     my $count = 0;
 208     while ($x) {
 209         $count += $table[ $x & 255 ];
 210         $x >>= 8;
 211     }
 212     $count;
 213 }
 214 
 215 sub table_unroll {
 216 
 217 # http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-11/1685.html
 218     my $x = shift;
 219     $table[ $x & 0xff ] +
 220       $table[ ( $x >> 8 ) & 0xff ] +
 221       $table[ ( $x >> 16 ) & 0xff ] +
 222       $table[ ( $x >> 24 ) & 0xff ];
 223 }
 224 
 225 ################################
 226 ## module bitvec
 227 __END__
 228   use Bit::Vector;
 229 
 230   my $vec = Bit::Vector->new(Bit::Vector->Word_Bits());
 231 
 232 
 233 
 234   sub via_bitvec {
 235       $vec->Word_Store(0,$_[0]);
 236       $vec->Norm();
 237   }
 238 
 239 
 240