From 5ed86987adc73ba5e8b53bc0c581dfab3dc31e57 Mon Sep 17 00:00:00 2001
From: Nathaniel Wesley Filardo <nwf@cs.jhu.edu>
Date: Fri, 25 Jul 2008 07:18:39 -0400
Subject: [PATCH] Made a huffman tree generator, mostly for fun.

darcs-hash:20080725111839-2ee1a-45d706847eeffcd2800d81da1b3c6ab9d7ae2c41.gz
---
 huffgen.pl | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 98 insertions(+)
 create mode 100644 huffgen.pl

diff --git a/huffgen.pl b/huffgen.pl
new file mode 100644
index 0000000..f639efb
--- /dev/null
+++ b/huffgen.pl
@@ -0,0 +1,98 @@
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+
+my $DEBUG = 1;
+my $PROGRESS = 1;
+my $NARY=6;
+
+my %count;
+my %icount;
+my $totalcount = 0;
+
+print STDERR "Consuming symbols...\n" if $PROGRESS;
+
+while (<>) {
+	chomp;
+	foreach my $char (split //) {
+		$count{$char}++;
+		$totalcount++;
+
+		print STDERR " Consumed $totalcount symbols...\r"
+			if $PROGRESS and ($totalcount % 1000 == 0);
+	}
+}
+
+print "\nRanking...\n" if $PROGRESS;
+
+print STDERR Dumper(\%count)."\n" if $DEBUG;
+
+foreach my $key (keys %count) {
+	unshift @{$icount{$count{$key}}}, $key;
+}
+
+print "Filing...\n" if $PROGRESS;
+
+print STDERR Dumper(\%icount)."\n" if $DEBUG;
+
+my @initial;
+foreach my $freq (sort { 0+$a <=> 0+$b } keys %icount) {
+	foreach my $char (@{$icount{$freq}}) {
+		push @initial, [$char, $freq];
+	}
+}
+
+print STDERR Dumper(\@initial)."\n" if $DEBUG;
+
+my @secondary = ();
+
+sub grabnext {
+	my ($inn, $inv) = @{$initial[0]} if exists $initial[0];
+	my ($sen, $sev) = @{$secondary[0]} if exists $secondary[0];
+
+	if (not defined $sev) {
+		print STDERR "    Undef sev\n" if $DEBUG > 2;
+		die if (not defined $inv);
+		return shift @initial;
+	} elsif (not defined $inv) {
+		print STDERR "    Undef inv\n" if $DEBUG > 2;
+		return shift @secondary;
+	} else {
+		if ($inv <= $sev) {
+			print STDERR "    Inv wins\n" if $DEBUG > 2;
+			return shift @initial;
+		}
+		print STDERR "    Sev wins\n" if $DEBUG > 2;
+		return shift @secondary;
+	}
+}
+
+sub numleft { return ((scalar @initial) + (scalar @secondary)) };
+
+print "Forming Huffman tree...\n" if $PROGRESS;
+
+while (numleft() > 1) {
+	my $i = 0;
+	my $cv = 0;
+	my @cs = ();
+
+	while ($i < $NARY and numleft() > 0) {
+		my ($nn, $nv) = @{grabnext()};
+
+		print STDERR "  Combined $nn\@$nv --- ".(numleft())."\n" if $DEBUG > 1;
+		print STDERR Dumper(\@initial, \@secondary)."\n" if $DEBUG > 2;
+
+		$cv += $nv;
+		push @cs, $nn;
+
+		$i++;
+	}
+
+	@cs = sort { length $a <=> length $b } @cs;
+	my $cn = join "",@cs;
+
+	print STDERR "GROUPING ($cn)\@$cv\n" if $DEBUG;
+
+	push @secondary, ["($cn)", $cv];
+}
+
+print @{$secondary[0]}[0]."\n";
-- 
2.50.1