1# Id: SparseMap.pm,v 1.1 2003/06/04 00:27:53 marka Exp
2#
3# Copyright (c) 2001 Japan Network Information Center.  All rights reserved.
4#
5# By using this file, you agree to the terms and conditions set forth bellow.
6#
7# 			LICENSE TERMS AND CONDITIONS
8#
9# The following License Terms and Conditions apply, unless a different
10# license is obtained from Japan Network Information Center ("JPNIC"),
11# a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda,
12# Chiyoda-ku, Tokyo 101-0047, Japan.
13#
14# 1. Use, Modification and Redistribution (including distribution of any
15#    modified or derived work) in source and/or binary forms is permitted
16#    under this License Terms and Conditions.
17#
18# 2. Redistribution of source code must retain the copyright notices as they
19#    appear in each source code file, this License Terms and Conditions.
20#
21# 3. Redistribution in binary form must reproduce the Copyright Notice,
22#    this License Terms and Conditions, in the documentation and/or other
23#    materials provided with the distribution.  For the purposes of binary
24#    distribution the "Copyright Notice" refers to the following language:
25#    "Copyright (c) 2000-2002 Japan Network Information Center.  All rights reserved."
26#
27# 4. The name of JPNIC may not be used to endorse or promote products
28#    derived from this Software without specific prior written approval of
29#    JPNIC.
30#
31# 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC
32#    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
33#    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
34#    PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL JPNIC BE LIABLE
35#    FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
36#    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
37#    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
38#    BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
39#    WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
40#    OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
41#    ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
42#
43
44package SparseMap;
45
46use strict;
47use Carp;
48
49my $debug = 0;
50
51sub new {
52    # common options are:
53    #   BITS => [8, 7, 6],	# 3-level map, 2nd level bits=7, 3rd = 6.
54    #   MAX  => 0x110000	# actually, max + 1.
55    my $class = shift;
56    my $self = {@_};
57
58    croak "BITS unspecified" unless exists $self->{BITS};
59    croak "BITS is not an array reference"
60	unless ref($self->{BITS}) eq 'ARRAY';
61    croak "MAX unspecified" unless exists $self->{MAX};
62
63    $self->{MAXLV} = @{$self->{BITS}} - 1;
64    $self->{FIXED} = 0;
65
66    my $lv0size = (indices($self, $self->{MAX} - 1))[0] + 1;
67
68    my @map = (undef) x $lv0size;
69    $self->{MAP} = \@map;
70
71    bless $self, $class;
72}
73
74sub add1 {
75    my ($self, $n, $val) = @_;
76
77    croak "Already fixed" if $self->{FIXED};
78    carp("data ($n) out of range"), return if $n >= $self->{MAX};
79
80    my @index = $self->indices($n);
81    my $r = $self->{MAP};
82    my $maxlv = $self->{MAXLV};
83    my $idx;
84    my $lv;
85
86    for ($lv = 0; $lv < $maxlv - 1; $lv++) {
87	$idx = $index[$lv];
88	$r->[$idx] = $self->create_imap($lv + 1, undef)
89	    unless defined $r->[$idx];
90	$r = $r->[$idx];
91    }
92    $idx = $index[$lv];
93    $r->[$idx] = $self->create_dmap() unless defined $r->[$idx];
94    $self->add_to_dmap($r->[$idx], $index[$maxlv], $val);
95}
96
97sub fix {
98    my $self = shift;
99    my $map = $self->{MAP};
100    my $maxlv = $self->{MAXLV};
101    my @tmp;
102    my @zero;
103
104    carp "Already fixed" if $self->{FIXED};
105    $self->collapse_tree();
106    $self->fill_default();
107    $self->{FIXED} = 1;
108}
109
110sub indices {
111    my $self = shift;
112    my $v = shift;
113    my @bits = @{$self->{BITS}};
114    my @idx;
115
116    print "indices($v,", join(',', @bits), ") = " if $debug;
117    for (my $i = @bits - 1; $i >= 0; $i--) {
118	my $bit = $bits[$i];
119	unshift @idx, $v & ((1 << $bit) - 1);
120	$v = $v >> $bit;
121    }
122    print "(", join(',', @idx), ")\n" if $debug;
123    @idx;
124}
125
126sub get {
127    my $self = shift;
128    my $v = shift;
129    my $map = $self->{MAP};
130    my @index = $self->indices($v);
131
132    croak "Not yet fixed" unless $self->{FIXED};
133
134    my $lastidx = pop @index;
135    foreach my $idx (@index) {
136	return $map->{DEFAULT} unless defined $map->[$idx];
137	$map = $map->[$idx];
138    }
139    $map->[$lastidx];
140}
141
142sub indirectmap {
143    my $self = shift;
144
145    croak "Not yet fixed" unless $self->{FIXED};
146
147    my @maps = $self->collect_maps();
148    my $maxlv = $self->{MAXLV};
149    my @bits = @{$self->{BITS}};
150
151    my @indirect = ();
152    for (my $lv = 0; $lv < $maxlv; $lv++) {
153	my $offset;
154	my $chunksz;
155	my $mapsz = @{$maps[$lv]->[0]};
156	if ($lv < $maxlv - 1) {
157	    # indirect map
158	    $offset = @indirect + @{$maps[$lv]} * @{$maps[$lv]->[0]};
159	    $chunksz = (1 << $bits[$lv + 1]);
160	} else {
161	    # direct map
162	    $offset = 0;
163	    $chunksz = 1;
164	}
165	my $nextmaps = $maps[$lv + 1];
166	foreach my $mapref (@{$maps[$lv]}) {
167	    croak "mapsize inconsistent ", scalar(@$mapref),
168	        " should be ", $mapsz, " (lv $lv)\n" if @$mapref != $mapsz;
169	    foreach my $m (@$mapref) {
170		my $idx;
171		for ($idx = 0; $idx < @$nextmaps; $idx++) {
172		    last if $nextmaps->[$idx] == $m;
173		}
174		croak "internal error: map corrupted" if $idx >= @$nextmaps;
175		push @indirect, $offset + $chunksz * $idx;
176	    }
177	}
178    }
179    @indirect;
180}
181
182sub cprog_imap {
183    my $self = shift;
184    my %opt = @_;
185    my $name = $opt{NAME} || 'map';
186    my @indirect = $self->indirectmap();
187    my $prog;
188    my $i;
189    my ($idtype, $idcol, $idwid);
190
191    my $max = 0;
192    $max < $_ and $max = $_ foreach @indirect;
193
194    if ($max < 256) {
195	$idtype = 'char';
196	$idcol = 8;
197	$idwid = 3;
198    } elsif ($max < 65536) {
199	$idtype = 'short';
200	$idcol = 8;
201	$idwid = 5;
202    } else {
203	$idtype = 'long';
204	$idcol = 4;
205	$idwid = 10;
206    }
207    $prog = "static const unsigned $idtype ${name}_imap[] = {\n";
208    $i = 0;
209    foreach my $v (@indirect) {
210	if ($i % $idcol == 0) {
211	    $prog .= "\n" if $i != 0;
212	    $prog .= "\t";
213	}
214	$prog .= sprintf "%${idwid}d, ", $v;
215	$i++;
216    }
217    $prog .= "\n};\n";
218    $prog;
219}
220
221sub cprog {
222    my $self = shift;
223    $self->cprog_imap(@_) . "\n" . $self->cprog_dmap(@_);
224}
225
226sub stat {
227    my $self = shift;
228    my @maps = $self->collect_maps();
229    my $elsize = $self->{ELSIZE};
230    my $i;
231    my $total = 0;
232    my @lines;
233
234    for ($i = 0; $i < $self->{MAXLV}; $i++) {
235	my $nmaps = @{$maps[$i]};
236	my $mapsz = @{$maps[$i]->[0]};
237	push @lines, "level $i: $nmaps maps (size $mapsz) ";
238	push @lines, "[", $nmaps * $mapsz * $elsize, "]" if $elsize;
239	push @lines, "\n";
240    }
241    my $ndmaps = @{$maps[$i]};
242    push @lines, "level $i: $ndmaps dmaps";
243    my $r = $maps[$i]->[0];
244    if (ref($r) eq 'ARRAY') {
245	push @lines, " (size ", scalar(@$r), ")";
246    }
247    push @lines, "\n";
248    join '', @lines;
249}
250
251sub collapse_tree {
252    my $self = shift;
253    my @tmp;
254
255    $self->_collapse_tree_rec($self->{MAP}, 0, \@tmp);
256}
257
258sub _collapse_tree_rec {
259    my ($self, $r, $lv, $refs) = @_;
260    my $ref = $refs->[$lv];
261    my $maxlv = $self->{MAXLV};
262    my $found;
263
264    return $r unless defined $r;
265
266    $ref = $refs->[$lv] = [] unless defined $ref;
267
268    if ($lv == $maxlv) {
269	$found = $self->find_dmap($ref, $r);
270    } else {
271	for (my $i = 0; $i < @$r; $i++) {
272	    $r->[$i] = $self->_collapse_tree_rec($r->[$i], $lv + 1, $refs);
273	}
274	$found = $self->find_imap($ref, $r);
275    }
276    unless ($found) {
277	$found = $r;
278	push @$ref, $found;
279    }
280    return $found;
281}
282
283sub fill_default {
284    my $self = shift;
285    my $maxlv = $self->{MAXLV};
286    my $bits = $self->{BITS};
287    my @zeros;
288
289    $zeros[$maxlv] = $self->create_dmap();
290    for (my $lv = $maxlv - 1; $lv >= 0; $lv--) {
291	my $r = $zeros[$lv + 1];
292	$zeros[$lv] = $self->create_imap($lv, $r);
293    }
294    _fill_default_rec($self->{MAP}, 0, $maxlv, \@zeros);
295}
296
297sub _fill_default_rec {
298    my ($r, $lv, $maxlv, $zeros) = @_;
299
300    return if $lv == $maxlv;
301    for (my $i = 0; $i < @$r; $i++) {
302	if (defined($r->[$i])) {
303	    _fill_default_rec($r->[$i], $lv + 1, $maxlv, $zeros);
304	} else {
305	    $r->[$i] = $zeros->[$lv + 1];
306	}
307    }
308}
309
310sub create_imap {
311    my ($self, $lv, $v) = @_;
312    my @map;
313    @map = ($v) x (1 << $self->{BITS}->[$lv]);
314    \@map;
315}
316
317sub find_imap {
318    my ($self, $maps, $map) = @_;
319    my $i;
320
321    foreach my $el (@$maps) {
322	next unless @$el == @$map;
323	for ($i = 0; $i < @$el; $i++) {
324	    last unless ($el->[$i] || 0) == ($map->[$i] || 0);
325	}
326	return $el if $i >= @$el;
327    }
328    undef;
329}
330
331sub collect_maps {
332    my $self = shift;
333    my @maps;
334    _collect_maps_rec($self->{MAP}, 0, $self->{MAXLV}, \@maps);
335    @maps;
336}
337
338sub _collect_maps_rec {
339    my ($r, $lv, $maxlv, $maps) = @_;
340    my $mapref = $maps->[$lv];
341
342    return unless defined $r;
343    foreach my $ref (@{$mapref}) {
344	return if $ref == $r;
345    }
346    push @{$maps->[$lv]}, $r;
347    if ($lv < $maxlv) {
348	_collect_maps_rec($_, $lv + 1, $maxlv, $maps) foreach @{$r};
349    }
350}
351
352sub add {confess "Subclass responsibility";}
353sub create_dmap {confess "Subclass responsibility";}
354sub add_to_dmap {confess "Subclass responsibility";}
355sub find_dmap {confess "Subclass responsibility";}
356sub cprog_dmap {confess "Subclass responsibility";}
357
3581;
359
360package SparseMap::Bit;
361
362use strict;
363use vars qw(@ISA);
364use Carp;
365#use SparseMap;
366
367@ISA = qw(SparseMap);
368
369sub new {
370    my $class = shift;
371    my $self = $class->SUPER::new(@_);
372    $self->{DEFAULT} = 0;
373    bless $self, $class;
374}
375
376sub add {
377    my $self = shift;
378
379    $self->add1($_, undef) foreach @_;
380}
381
382sub create_dmap {
383    my $self = shift;
384    my $bmbits = $self->{BITS}->[-1];
385
386    my $s = "\0" x (1 << ($bmbits - 3));
387    \$s;
388}
389
390sub add_to_dmap {
391    my ($self, $map, $idx, $val) = @_;
392    vec($$map, $idx, 1) = 1;
393}
394
395sub find_dmap {
396    my ($self, $ref, $r) = @_;
397    foreach my $map (@$ref) {
398	return $map if $$map eq $$r;
399    }
400    return undef;
401}
402
403sub cprog_dmap {
404    my $self = shift;
405    my %opt = @_;
406    my $name = $opt{NAME} || 'map';
407    my @maps = $self->collect_maps();
408    my @bitmap = @{$maps[-1]};
409    my $prog;
410    my $bmsize = 1 << ($self->{BITS}->[-1] - 3);
411
412    $prog = <<"END";
413static const struct {
414	unsigned char bm[$bmsize];
415} ${name}_bitmap[] = {
416END
417
418    foreach my $bm (@bitmap) {
419	my $i = 0;
420	$prog .= "\t{{\n";
421	foreach my $v (unpack 'C*', $$bm) {
422	    if ($i % 16 == 0) {
423		$prog .= "\n" if $i != 0;
424		$prog .= "\t";
425	    }
426	    $prog .= sprintf "%3d,", $v;
427	    $i++;
428	}
429	$prog .= "\n\t}},\n";
430    }
431    $prog .= "};\n";
432    $prog;
433}
434
4351;
436
437package SparseMap::Int;
438
439use strict;
440use vars qw(@ISA);
441use Carp;
442#use SparseMap;
443
444@ISA = qw(SparseMap);
445
446sub new {
447    my $class = shift;
448    my $self = $class->SUPER::new(@_);
449    $self->{DEFAULT} = 0 unless exists $self->{DEFAULT};
450    bless $self, $class;
451}
452
453sub add {
454    my $self = shift;
455    while (@_ > 0) {
456	my $n = shift;
457	my $val = shift;
458	$self->add1($n, $val);
459    }
460}
461
462sub create_dmap {
463    my $self = shift;
464    my $tblbits = $self->{BITS}->[-1];
465    my $default = $self->{DEFAULT};
466
467    my @tbl = ($default) x (1 << $tblbits);
468    \@tbl;
469}
470
471sub add_to_dmap {
472    my ($self, $map, $idx, $val) = @_;
473    $map->[$idx] = $val;
474}
475
476sub find_dmap {
477    my ($self, $ref, $r) = @_;
478    foreach my $map (@$ref) {
479	if (@$map == @$r) {
480	    my $i;
481	    for ($i = 0; $i < @$map; $i++) {
482		last if $map->[$i] != $r->[$i];
483	    }
484	    return $map if $i == @$map;
485	}
486    }
487    return undef;
488}
489
490sub cprog_dmap {
491    my $self = shift;
492    my %opt = @_;
493    my $name = $opt{NAME} || 'map';
494    my @maps = $self->collect_maps();
495    my @table = @{$maps[-1]};
496    my $prog;
497    my $i;
498    my ($idtype, $idcol, $idwid);
499    my $tblsize = 1 << $self->{BITS}->[-1];
500
501    my ($min, $max);
502    foreach my $a (@table) {
503	foreach my $v (@$a) {
504	    $min = $v if !defined($min) or $min > $v;
505	    $max = $v if !defined($max) or $max < $v;
506	}
507    }
508    if (exists $opt{MAPTYPE}) {
509	$idtype = $opt{MAPTYPE};
510    } else {
511	my $u = $min < 0 ? '' : 'unsigned ';
512	my $absmax = abs($max);
513	$absmax = abs($min) if abs($min) > $absmax;
514
515	if ($absmax < 256) {
516	    $idtype = "${u}char";
517	} elsif ($absmax < 65536) {
518	    $idtype = "${u}short";
519	} else {
520	    $idtype = "${u}long";
521	}
522    }
523
524    $idwid = decimalwidth($max);
525    $idwid = decimalwidth($min) if decimalwidth($min) > $idwid;
526
527    $prog = <<"END";
528static const struct {
529	$idtype tbl[$tblsize];
530} ${name}_table[] = {
531END
532
533    foreach my $a (@table) {
534	my $i = 0;
535	my $col = 0;
536	$prog .= "\t{{\n\t";
537	foreach my $v (@$a) {
538	    my $s = sprintf "%${idwid}d, ", $v;
539	    $col += length($s);
540	    if ($col > 70) {
541		$prog .= "\n\t";
542		$col = length($s);
543	    }
544	    $prog .= $s;
545	}
546	$prog .= "\n\t}},\n";
547    }
548    $prog .= "};\n";
549    $prog;
550}
551
552sub decimalwidth {
553    my $n = shift;
554    my $neg = 0;
555    my $w;
556
557    if ($n < 0) {
558	$neg = 1;
559	$n = -$n;
560    }
561    if ($n < 100) {
562	$w = 2;
563    } elsif ($n < 10000) {
564	$w = 4;
565    } elsif ($n < 1000000) {
566	$w = 6;
567    } elsif ($n < 100000000) {
568	$w = 8;
569    } else {
570	$w = 10;
571    }
572    $w + $neg;
573}
574
5751;
576