#!/usr/bin/perl -w
# Huffman Compression - Operating on a string of ASCII characters
# Lossless compression - fixed length data to variable length representation
###############################################################################
### Given a random character set, the characters that appear least often should
### have the longest bit-codes and those that appear most often should have the
### shortest bit-codes.
###############################################################################

use strict;

die "Usage: enhuff.pl <input file> <output file>\n" if @ARGV != 2;

my @chars = ();
my %prob = ();
my ($smallest, $second);
my %leaf = ();
my @bitcode = ();
my %compression = ();
my $newdata;
my $datalength;
my @decodetable = ();
my $decodetable;
my $tablelength;
my ($maxlength, $minbitsneeded, $format);
my $bitbuffer;
my $output;

### Step 0: Open the file passed as the first argument to the program
########### Read the characters into the @chars array
########### EX: @chars = ('c','b','z',9,'i','#',...)

open (INFILE, "<$ARGV[0]") or die "Cannot read from $ARGV[0]: $!\n";
while (<INFILE>) {
	push (@chars, split (//, $_));
}
close (INFILE) or die "Cannot close $ARGV[0]: $!\n";

### Step 1: Count the instances of each character and save this
########### information into the %prob hash
########### EX: %prob = ('c'=>5, 'b'=>23, 9=>1,...)

foreach (@chars) { $prob{$_}++; }

while (keys %prob > 1) {

	### Step 2: Find the character that appears least often and
        ########### save it into $smallest

	### Initialize $smallest to the first character in %prob
	$smallest = (keys %prob)[0];
	foreach (keys %prob) {
		if ($prob{$_} < $prob{$smallest}) {
			$smallest = $_;
		}
	}
	
	### Step 3: Find the character that appears next least often
	########### and save it into $second

	### Initialize $second to the first character in %prob if
	### it is not $smallest.  Otherwise, initialize $second to
	### the last character in %prob
	if ($smallest ne (keys %prob)[0]) { 
		$second = (keys %prob)[0]; 
	} else { 
		$second = (keys %prob)[-1]; 
	}
	foreach (keys %prob) {
		if ($_ ne $smallest && $prob{$_} < $prob{$second}) {
			$second = $_;
		}
	}
	
	### Step 4: Create nodes for $smallest and $second and
	########### plug the two into the binary tree structure
	
	unless (defined($leaf{$smallest})) {
		$leaf{$smallest}[0] = undef;
		$leaf{$smallest}[1] = undef;
		$leaf{$smallest}[2] = $prob{$smallest};
	}
	unless (defined($leaf{$second})) {
		$leaf{$second}[0] = undef;
		$leaf{$second}[1] = undef;
		$leaf{$second}[2] = $prob{$second};
	}
	$leaf{$smallest.$second}[0] = $smallest;
	$leaf{$smallest.$second}[1] = $second;
	$leaf{$smallest.$second}[2] = $prob{$smallest} + $prob{$second};
	
	### Step 5: Remove $smallest and $second from %prob and replace them
	########### with ($prob{$smallest} + $prob{$second})
	
	delete $prob{$smallest};
	delete $prob{$second};
	$prob{$smallest.$second} = $leaf{$smallest.$second}[2];
	
}

### Step 6: Traverse binary tree and calculate bit-codes for individual chars

traverse_tree((keys %prob)[0], \@bitcode, \%compression);

### Step 7: Encode the input data

for (my $i=0; $i<@chars; $i++) {
	$chars[$i] = $compression{$chars[$i]};
}
$newdata = join('', @chars);
$datalength = length($newdata);

### Step 8: Encode the %compression table

### Determine the $minbitsneeded to save the compressed length value
$maxlength = 1;
foreach (keys %compression) {
	if (length($compression{$_}) > $maxlength) {
		$maxlength = length($compression{$_});
	}
}
$minbitsneeded = length(sprintf("%b", $maxlength));
$format = "%0".$minbitsneeded."b";

### Build the $decodetable and calculate $tablelength
foreach (sort keys %compression) {
	my @temp = ();
	$temp[0] = unpack("B*", $_);
	$temp[1] = sprintf($format, length($compression{$_}));
	$temp[2] = $compression{$_};
#	print unpack("B*", $_), " (Length: ", 
#		length($compression{$_}), ") $compression{$_}\n";
#	print join('', @temp), "\n";
	push(@decodetable, join('', @temp));
}
$decodetable = join('', @decodetable);
$tablelength = length($decodetable);

### Random Shtuff...
print "Minbitsneeded = $minbitsneeded (";
$minbitsneeded = sprintf("%04b", $minbitsneeded);
print "$minbitsneeded)\n";
print "Table Length = $tablelength (";
$tablelength = sprintf("%012b", $tablelength);
print "$tablelength)\n";
print "Data Length = $datalength\n";
$bitbuffer = 8-(19+$tablelength+$datalength)%8;
if ($bitbuffer == 8) { $bitbuffer = 0; }
print "Bitbuffer = $bitbuffer (";
$bitbuffer = sprintf("%03b", $bitbuffer);
print "$bitbuffer)\n";
print "Data for Output:\n";
$output = $minbitsneeded.$tablelength.$bitbuffer.$decodetable.$newdata;
print "$output\nLength: ", length($output), "\n";
$output = pack("B*", $output);
print "Packed length: ", length($output), "\n";

### Step 9: Output the data to a file

open (OUTFILE, ">$ARGV[1]") or die "Cannot write to $ARGV[1]: $!\n";
print OUTFILE $output;
close (OUTFILE) or die "Cannot close $ARGV[1]: $!\n";

print "Data has been written to $ARGV[1]\n";


###############################################################################

sub traverse_tree {
	my $leafname = $_[0];
	my $bitcode = $_[1];
	my $compression = $_[2];

	if ($leafname =~ /^.$/ || $leafname =~ /^\n$/) {
		$$compression{$leafname} = join("", @$bitcode);
	}
	if (defined($leaf{$leafname}[0])) {
		push (@$bitcode, 0);
		traverse_tree($leaf{$leafname}[0], $bitcode, $compression);
		pop (@$bitcode);
	}
	if (defined($leaf{$leafname}[1])) {
		push (@$bitcode, 1);
		traverse_tree($leaf{$leafname}[1], $bitcode, $compression);
		pop (@$bitcode);
	}
}
