The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

#!/usr/bin/perl
use String::Random qw/random_string/;
use Test::More tests => 5 * 20 + 2;
use List::Util qw/max/;
use constant MAX_COUNT => 1_000;
use constant MAX_SUBSTRING_LENGTH => 10;
use constant HUFFMAN_ELEMENTS => 5_000;
use constant LONG_STRING_LENGTH => 10_000;
sub myrand($) {
return int( rand( int rand shift() ) + 1 );
}
# Create a random counting
my %counting = map { random_string('c' x myrand MAX_SUBSTRING_LENGTH)
=> myrand(MAX_COUNT)
}
(1 .. HUFFMAN_ELEMENTS);
$counting{$_} = myrand(MAX_COUNT) for ('a' .. 'z');
my $huff = Algorithm::Huffman->new(\%counting);
my $encode_hash = $huff->encode_hash;
my $max_length = max map length, keys %counting;
for (1 .. 20) {
my $s = random_string('c' x LONG_STRING_LENGTH);
my $c = "";
my $index = 0;
while ($index < LONG_STRING_LENGTH) {
for my $l (reverse (1 .. $max_length)) {
if (my $bitcode = $encode_hash->{substr($s, $index, $l)}) {
$c .= $bitcode;
$index += $l;
last;
}
}
}
my $encoded_with_huffman = $huff->encode_bitstring($s);
is $encoded_with_huffman, $c, "Coded huffman string of '$s'"
or diag Dumper($huff);
my $encoded_with_huffman_bitvector = $huff->encode($s);
is $encoded_with_huffman_bitvector,
pack("b*", $encoded_with_huffman),
"->encode('$s') checked with pack";
cmp_ok length($encoded_with_huffman)/8, "<=", LONG_STRING_LENGTH,
"Encoding produced a compression lower than only the compression of 26 characters";
is $huff->decode_bitstring($encoded_with_huffman),
$s,
"Decoding of encoding bitstring should be the same as the orig";
is $huff->decode($encoded_with_huffman_bitvector),
$s,
"Decoding of encoding (packed) bitvector should be the same as the orig";
}
my $string = random_string('c' x LONG_STRING_LENGTH);
UNKNOWN_CHAR_IN_BITSTRING_SHOULD_PRODUCE_AN_EXCEPTION: {
my $bitstring = $huff->encode_bitstring($string);
substr($bitstring,length($string)/2,1) = "a";
throws_ok {$huff->decode_bitstring($bitstring)}
qr/unknown/i,
"Unknown character (an a instead 0/1) into the bitstring";
}
BITSTRING_TOO_SHORT: {
my $bitstring = $huff->encode_bitstring($string);
$bitstring = substr($bitstring,0,length($bitstring-1));
dies_ok {$huff->decode_bitstring($bitstring)}
"Removed the last bit of the bitstring -> should die";
}