#!/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 $bitlength;

### 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{$_}++; }

#print "Characters found in $ARGV[0]:\n";
#foreach (sort keys %prob) {
#	print "$_ : $prob{$_}\n";
#}
#print '-'x60, "\n";
#print "Building the tree...\n";

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 = $_;
		}
	}
#	print "Smallest value is $smallest with probability 
#$prob{$smallest}\n";
	
	### 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 = $_;
		}
	}
#	print "Second smallest value is $second with probability 
#$prob{$second}\n";
	
	### 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];
	
#	foreach (sort keys %prob) { 
#		print "$_ => $prob{$_}\n";
#	}

}

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

#print "\nTraversing Binary Tree Structure...";
traverse_tree((keys %prob)[0], \@bitcode, \%compression);
#print "Analysis Completed\n";

#print "Compression Table:\n";
#print '-'x60, "\n";
#foreach (sort keys %compression) {
#	print "$_ : $compression{$_}\n";
#}

### Step 7: Encode the input data and output to a file

#print "\nEncoding Data...\n";
for (my $i=0; $i<@chars; $i++) {
	$chars[$i] = $compression{$chars[$i]};
}
$newdata = join ('', @chars);
#print "Raw data...\n";
#print "$newdata\n";
$bitlength = length($newdata);
#print "Packing into 8-bit ASCII characters...\n";
$newdata = pack("B*", $newdata);
#print "$newdata\n";

open (OUTFILE, ">$ARGV[1]") or die "Cannot write to $ARGV[1]: $!\n";
foreach (sort keys %compression) {
	print OUTFILE "$_ : $compression{$_}\n";
}
print OUTFILE "_BITLENGTH_ : $bitlength\n";
print OUTFILE $newdata;
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);
	}
}
