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