view release on metacpan or  search on metacpan

Huffman.pm  view on Meta::CPAN

                last;
            }
        }
    }
    return $bitvector;
}

sub decode_bitstring {
    my ($self, $bitstring) = @_;
    
    my $max_length_decoding_key = $self->{max_length_decoding_key};
    my $min_length_decoding_key = $self->{min_length_decoding_key};
    my %decode_hash = %{$self->decode_hash};
    
    my $string = "";
    my ($index, $max_index) = (0, length($bitstring)-1);
    while ($index < $max_index) {
        my $decode = undef;
        foreach my $l ($min_length_decoding_key .. $max_length_decoding_key) {
            if ($decode = $decode_hash{substr($bitstring,$index,$l)}) {
                $string .= $decode;
                $index  += $l;
                last;
            }
        }
        defined $decode
            or die "Unknown bit sequence starting at index $index in the bitstring";
    }
    return $string;
}

sub decode {
    my ($self, $bitvector) = @_;
    
    my $max_length_decoding_key = $self->{max_length_decoding_key};
    my $min_length_decoding_key = $self->{min_length_decoding_key};
    my %decode_hash = %{$self->decode_hash};
    
    my $string = "";
    my ($offset, $max_offset) = (0, 8 * (length($bitvector)-1));
    while ($offset < $max_offset) {
        my $decode = undef;
        my $bitpattern = "";
        my $last_offset_ok = $offset;
        foreach my $l (1 .. $max_length_decoding_key) {
            $bitpattern .= vec($bitvector,$offset++,1);
            if ($decode = $decode_hash{$bitpattern}) {
                $string .= $decode;
                last;
            }
        }
        defined $decode
            or die "Unknown bit sequence starting at offset $last_offset_ok in the bitstring";
    }
    return $string;
}


sub __validate_counting_hash {
    my $c = shift;
    my $error_msg = undef;
    defined $c        
        or croak "Undefined counting hash";
    ref($c) eq 'HASH' 
        or croak "The argument for the counting hash is not a hash reference, as expected";
    scalar(keys %$c) >= 2
        or croak "The counting hash must have at least 2 keys";
}

1;

package KeyValuePair;

use Heap::Elem;

require Exporter;

our @ISA = qw/Exporter Heap::Elem/;

sub new {
   my ($proto, $key, $value) = @_;
   my $class = ref($proto) || $proto;

   my $self = $class->SUPER::new;

   $self->{"KeyValuePair::key"}   = $key;
   $self->{"KeyValuePair::value"} = $value;
   
   return $self;
}

sub cmp {
   my ($self, $other) = @_;
   $self->{"KeyValuePair::value"} <=> $other->{"KeyValuePair::value"};
}

sub key {
    my $self = shift;
    return $self->{"KeyValuePair::key"};
}

sub value {
    my $self = shift;
    return $self->{"KeyValuePair::value"};
}

1;


__END__

=head1 NAME

Algorithm::Huffman - Perl extension that implements the Huffman algorithm

=head1 SYNOPSIS

  use Algorithm::Huffman;

  my %char_counting = map {$_ => int rand(100)} ('a' .. 'z', 'A' .. 'Z');
  # or better the real counting for your characters

Huffman.pm  view on Meta::CPAN

=item $huff->encode_hash

Returns a reference to the encoding hash.
The keys of the encoding hash are the characters/strings passed
at the construction. The values are their bit representation.
Please note that the bit represantations are strings 
of ones and zeros is returned and not binary numbers.

=item $huff->decode_hash

Returns a reference to the decoding hash.
The keys of the decoding hash are the bit presentations,
while the values are the characters/strings the bitstrings stands for.
Please note that the bit represantations are strings 
of ones and zeros is returned and not binary numbers.

=item $huff->encode_bitstring($string)

Returns a bitstring of '1' and '0',
representing an encoded version (with the current huffman tree) 
of the given string.

There could be some ambiguities,
e.g. if there is an 'e' and an 'er' in the huffman tree.
This algorithm is greedy.
That means the given string is traversed from the beginning
and in every loop, the longest possible encoding from the huffman tree is taken.
In the above example,
that would be 'er' instead of 'e'.

The greedy way isn't guarantueed to exist also in future versions.
(E.g., I could imagine to look for the next two (or n) possible encoding
substrings from the huffman tree
and to select the one with the shortest encoding bitstring).

=item $huff->encode($string)

Returns the huffman encoded packed bitvector of C<$string>.

Please look to the description of C<encode_bitstring> for details.

=item $huff->decode_bitstring($bitstring)

Decodes a bitstring of '1' and '0' to the original string.
Allthough the encoding could be a bit ambigious,
the decoding is alway unambigious.

Please take care that only ones and zeroes are in the bitstring.
The method will die otherwise.

It will also die if the bitstring isnt complete.
E.g., assuming,
you have a Huffman-Table

  a => 1
  b => 01
  c => 00
  
and wanted to code 'abc'. The right coding is '10100'.
But '1010' (the last 0 is missing) will produce the error message:
C<Unknown bit sequence starting at index 3 in the bitstring>.

=item $huff->decode($bitvector)

Decodes a packed bitvector (encoded with the ->encode method).

Please look to the description of C<decode_bitstring> for details.

=back   

=head2 EXPORT

None by default.

=head1 BUGS

If a character/string has occurs zero times, it is still coded.
At the moment, you have to grep them out before.
I don't plan to change it,
as it can realistic happen and they would play a role.
(Imagine, you would code all three letter combinations found in some
english texts, you still would have to code all ASCII characters,
even if they don't occur in the texts you have analyzed.
Reason is that they could occur in other texts and
you would have to guarantee that you can code every text
without any lost information)

If you encode part for part your stream,
you could get the idea of doing stuff like:

  my $encode1 = $huff->encode_bitstring($chapter1);
  my $encode2 = $huff->encode_bitstring($chapter2);
  
  my $total_encode = $encode1 . $encode2;
  
  my $all_chapters = $huff->decode_bitstring($total_encode);
  
  # Now $all_chapter eq $chapter1 . $chapter2
  
That will work fine,
but I'm afraid, it won't work,
if you replace the C<..code_bitstring methods>
with the C<..code> methods.

It isn't tested with a big histogram of characters/strings.

There could be some others,
as this code is still in the ALPHA stadium.

=head1 TODO

Up till now, I didn't care a lot about the speed.
Some parts could still be improved in Perl and a lot of the parts
could be reimplemented in C.

=head1 THANKS

Thanks to Perry Leopold who found some problems
with the parameter validation and the synopsis.