# $Id: SparseMap.pm,v 1.1.1.1 2003-06-04 00:27:53 marka Exp $ # # Copyright (c) 2001 Japan Network Information Center. All rights reserved. # # By using this file, you agree to the terms and conditions set forth bellow. # # LICENSE TERMS AND CONDITIONS # # The following License Terms and Conditions apply, unless a different # license is obtained from Japan Network Information Center ("JPNIC"), # a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda, # Chiyoda-ku, Tokyo 101-0047, Japan. # # 1. Use, Modification and Redistribution (including distribution of any # modified or derived work) in source and/or binary forms is permitted # under this License Terms and Conditions. # # 2. Redistribution of source code must retain the copyright notices as they # appear in each source code file, this License Terms and Conditions. # # 3. Redistribution in binary form must reproduce the Copyright Notice, # this License Terms and Conditions, in the documentation and/or other # materials provided with the distribution. For the purposes of binary # distribution the "Copyright Notice" refers to the following language: # "Copyright (c) 2000-2002 Japan Network Information Center. All rights reserved." # # 4. The name of JPNIC may not be used to endorse or promote products # derived from this Software without specific prior written approval of # JPNIC. # # 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A # PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL JPNIC BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF # ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. # package SparseMap; use strict; use Carp; my $debug = 0; sub new { # common options are: # BITS => [8, 7, 6], # 3-level map, 2nd level bits=7, 3rd = 6. # MAX => 0x110000 # actually, max + 1. my $class = shift; my $self = {@_}; croak "BITS unspecified" unless exists $self->{BITS}; croak "BITS is not an array reference" unless ref($self->{BITS}) eq 'ARRAY'; croak "MAX unspecified" unless exists $self->{MAX}; $self->{MAXLV} = @{$self->{BITS}} - 1; $self->{FIXED} = 0; my $lv0size = (indices($self, $self->{MAX} - 1))[0] + 1; my @map = (undef) x $lv0size; $self->{MAP} = \@map; bless $self, $class; } sub add1 { my ($self, $n, $val) = @_; croak "Already fixed" if $self->{FIXED}; carp("data ($n) out of range"), return if $n >= $self->{MAX}; my @index = $self->indices($n); my $r = $self->{MAP}; my $maxlv = $self->{MAXLV}; my $idx; my $lv; for ($lv = 0; $lv < $maxlv - 1; $lv++) { $idx = $index[$lv]; $r->[$idx] = $self->create_imap($lv + 1, undef) unless defined $r->[$idx]; $r = $r->[$idx]; } $idx = $index[$lv]; $r->[$idx] = $self->create_dmap() unless defined $r->[$idx]; $self->add_to_dmap($r->[$idx], $index[$maxlv], $val); } sub fix { my $self = shift; my $map = $self->{MAP}; my $maxlv = $self->{MAXLV}; my @tmp; my @zero; carp "Already fixed" if $self->{FIXED}; $self->collapse_tree(); $self->fill_default(); $self->{FIXED} = 1; } sub indices { my $self = shift; my $v = shift; my @bits = @{$self->{BITS}}; my @idx; print "indices($v,", join(',', @bits), ") = " if $debug; for (my $i = @bits - 1; $i >= 0; $i--) { my $bit = $bits[$i]; unshift @idx, $v & ((1 << $bit) - 1); $v = $v >> $bit; } print "(", join(',', @idx), ")\n" if $debug; @idx; } sub get { my $self = shift; my $v = shift; my $map = $self->{MAP}; my @index = $self->indices($v); croak "Not yet fixed" unless $self->{FIXED}; my $lastidx = pop @index; foreach my $idx (@index) { return $map->{DEFAULT} unless defined $map->[$idx]; $map = $map->[$idx]; } $map->[$lastidx]; } sub indirectmap { my $self = shift; croak "Not yet fixed" unless $self->{FIXED}; my @maps = $self->collect_maps(); my $maxlv = $self->{MAXLV}; my @bits = @{$self->{BITS}}; my @indirect = (); for (my $lv = 0; $lv < $maxlv; $lv++) { my $offset; my $chunksz; my $mapsz = @{$maps[$lv]->[0]}; if ($lv < $maxlv - 1) { # indirect map $offset = @indirect + @{$maps[$lv]} * @{$maps[$lv]->[0]}; $chunksz = (1 << $bits[$lv + 1]); } else { # direct map $offset = 0; $chunksz = 1; } my $nextmaps = $maps[$lv + 1]; foreach my $mapref (@{$maps[$lv]}) { croak "mapsize inconsistent ", scalar(@$mapref), " should be ", $mapsz, " (lv $lv)\n" if @$mapref != $mapsz; foreach my $m (@$mapref) { my $idx; for ($idx = 0; $idx < @$nextmaps; $idx++) { last if $nextmaps->[$idx] == $m; } croak "internal error: map corrupted" if $idx >= @$nextmaps; push @indirect, $offset + $chunksz * $idx; } } } @indirect; } sub cprog_imap { my $self = shift; my %opt = @_; my $name = $opt{NAME} || 'map'; my @indirect = $self->indirectmap(); my $prog; my $i; my ($idtype, $idcol, $idwid); my $max = 0; $max < $_ and $max = $_ foreach @indirect; if ($max < 256) { $idtype = 'char'; $idcol = 8; $idwid = 3; } elsif ($max < 65536) { $idtype = 'short'; $idcol = 8; $idwid = 5; } else { $idtype = 'long'; $idcol = 4; $idwid = 10; } $prog = "static const unsigned $idtype ${name}_imap[] = {\n"; $i = 0; foreach my $v (@indirect) { if ($i % $idcol == 0) { $prog .= "\n" if $i != 0; $prog .= "\t"; } $prog .= sprintf "%${idwid}d, ", $v; $i++; } $prog .= "\n};\n"; $prog; } sub cprog { my $self = shift; $self->cprog_imap(@_) . "\n" . $self->cprog_dmap(@_); } sub stat { my $self = shift; my @maps = $self->collect_maps(); my $elsize = $self->{ELSIZE}; my $i; my $total = 0; my @lines; for ($i = 0; $i < $self->{MAXLV}; $i++) { my $nmaps = @{$maps[$i]}; my $mapsz = @{$maps[$i]->[0]}; push @lines, "level $i: $nmaps maps (size $mapsz) "; push @lines, "[", $nmaps * $mapsz * $elsize, "]" if $elsize; push @lines, "\n"; } my $ndmaps = @{$maps[$i]}; push @lines, "level $i: $ndmaps dmaps"; my $r = $maps[$i]->[0]; if (ref($r) eq 'ARRAY') { push @lines, " (size ", scalar(@$r), ")"; } push @lines, "\n"; join '', @lines; } sub collapse_tree { my $self = shift; my @tmp; $self->_collapse_tree_rec($self->{MAP}, 0, \@tmp); } sub _collapse_tree_rec { my ($self, $r, $lv, $refs) = @_; my $ref = $refs->[$lv]; my $maxlv = $self->{MAXLV}; my $found; return $r unless defined $r; $ref = $refs->[$lv] = [] unless defined $ref; if ($lv == $maxlv) { $found = $self->find_dmap($ref, $r); } else { for (my $i = 0; $i < @$r; $i++) { $r->[$i] = $self->_collapse_tree_rec($r->[$i], $lv + 1, $refs); } $found = $self->find_imap($ref, $r); } unless ($found) { $found = $r; push @$ref, $found; } return $found; } sub fill_default { my $self = shift; my $maxlv = $self->{MAXLV}; my $bits = $self->{BITS}; my @zeros; $zeros[$maxlv] = $self->create_dmap(); for (my $lv = $maxlv - 1; $lv >= 0; $lv--) { my $r = $zeros[$lv + 1]; $zeros[$lv] = $self->create_imap($lv, $r); } _fill_default_rec($self->{MAP}, 0, $maxlv, \@zeros); } sub _fill_default_rec { my ($r, $lv, $maxlv, $zeros) = @_; return if $lv == $maxlv; for (my $i = 0; $i < @$r; $i++) { if (defined($r->[$i])) { _fill_default_rec($r->[$i], $lv + 1, $maxlv, $zeros); } else { $r->[$i] = $zeros->[$lv + 1]; } } } sub create_imap { my ($self, $lv, $v) = @_; my @map; @map = ($v) x (1 << $self->{BITS}->[$lv]); \@map; } sub find_imap { my ($self, $maps, $map) = @_; my $i; foreach my $el (@$maps) { next unless @$el == @$map; for ($i = 0; $i < @$el; $i++) { last unless ($el->[$i] || 0) == ($map->[$i] || 0); } return $el if $i >= @$el; } undef; } sub collect_maps { my $self = shift; my @maps; _collect_maps_rec($self->{MAP}, 0, $self->{MAXLV}, \@maps); @maps; } sub _collect_maps_rec { my ($r, $lv, $maxlv, $maps) = @_; my $mapref = $maps->[$lv]; return unless defined $r; foreach my $ref (@{$mapref}) { return if $ref == $r; } push @{$maps->[$lv]}, $r; if ($lv < $maxlv) { _collect_maps_rec($_, $lv + 1, $maxlv, $maps) foreach @{$r}; } } sub add {confess "Subclass responsibility";} sub create_dmap {confess "Subclass responsibility";} sub add_to_dmap {confess "Subclass responsibility";} sub find_dmap {confess "Subclass responsibility";} sub cprog_dmap {confess "Subclass responsibility";} 1; package SparseMap::Bit; use strict; use vars qw(@ISA); use Carp; #use SparseMap; @ISA = qw(SparseMap); sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{DEFAULT} = 0; bless $self, $class; } sub add { my $self = shift; $self->add1($_, undef) foreach @_; } sub create_dmap { my $self = shift; my $bmbits = $self->{BITS}->[-1]; my $s = "\0" x (1 << ($bmbits - 3)); \$s; } sub add_to_dmap { my ($self, $map, $idx, $val) = @_; vec($$map, $idx, 1) = 1; } sub find_dmap { my ($self, $ref, $r) = @_; foreach my $map (@$ref) { return $map if $$map eq $$r; } return undef; } sub cprog_dmap { my $self = shift; my %opt = @_; my $name = $opt{NAME} || 'map'; my @maps = $self->collect_maps(); my @bitmap = @{$maps[-1]}; my $prog; my $bmsize = 1 << ($self->{BITS}->[-1] - 3); $prog = <<"END"; static const struct { unsigned char bm[$bmsize]; } ${name}_bitmap[] = { END foreach my $bm (@bitmap) { my $i = 0; $prog .= "\t{{\n"; foreach my $v (unpack 'C*', $$bm) { if ($i % 16 == 0) { $prog .= "\n" if $i != 0; $prog .= "\t"; } $prog .= sprintf "%3d,", $v; $i++; } $prog .= "\n\t}},\n"; } $prog .= "};\n"; $prog; } 1; package SparseMap::Int; use strict; use vars qw(@ISA); use Carp; #use SparseMap; @ISA = qw(SparseMap); sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{DEFAULT} = 0 unless exists $self->{DEFAULT}; bless $self, $class; } sub add { my $self = shift; while (@_ > 0) { my $n = shift; my $val = shift; $self->add1($n, $val); } } sub create_dmap { my $self = shift; my $tblbits = $self->{BITS}->[-1]; my $default = $self->{DEFAULT}; my @tbl = ($default) x (1 << $tblbits); \@tbl; } sub add_to_dmap { my ($self, $map, $idx, $val) = @_; $map->[$idx] = $val; } sub find_dmap { my ($self, $ref, $r) = @_; foreach my $map (@$ref) { if (@$map == @$r) { my $i; for ($i = 0; $i < @$map; $i++) { last if $map->[$i] != $r->[$i]; } return $map if $i == @$map; } } return undef; } sub cprog_dmap { my $self = shift; my %opt = @_; my $name = $opt{NAME} || 'map'; my @maps = $self->collect_maps(); my @table = @{$maps[-1]}; my $prog; my $i; my ($idtype, $idcol, $idwid); my $tblsize = 1 << $self->{BITS}->[-1]; my ($min, $max); foreach my $a (@table) { foreach my $v (@$a) { $min = $v if !defined($min) or $min > $v; $max = $v if !defined($max) or $max < $v; } } if (exists $opt{MAPTYPE}) { $idtype = $opt{MAPTYPE}; } else { my $u = $min < 0 ? '' : 'unsigned '; my $absmax = abs($max); $absmax = abs($min) if abs($min) > $absmax; if ($absmax < 256) { $idtype = "${u}char"; } elsif ($absmax < 65536) { $idtype = "${u}short"; } else { $idtype = "${u}long"; } } $idwid = decimalwidth($max); $idwid = decimalwidth($min) if decimalwidth($min) > $idwid; $prog = <<"END"; static const struct { $idtype tbl[$tblsize]; } ${name}_table[] = { END foreach my $a (@table) { my $i = 0; my $col = 0; $prog .= "\t{{\n\t"; foreach my $v (@$a) { my $s = sprintf "%${idwid}d, ", $v; $col += length($s); if ($col > 70) { $prog .= "\n\t"; $col = length($s); } $prog .= $s; } $prog .= "\n\t}},\n"; } $prog .= "};\n"; $prog; } sub decimalwidth { my $n = shift; my $neg = 0; my $w; if ($n < 0) { $neg = 1; $n = -$n; } if ($n < 100) { $w = 2; } elsif ($n < 10000) { $w = 4; } elsif ($n < 1000000) { $w = 6; } elsif ($n < 100000000) { $w = 8; } else { $w = 10; } $w + $neg; } 1;