2016 Update

Task/Huffman-coding/Perl-6/huffman-coding-1.pl6

@@ -1,17 +1,13 @@
-sub huffman ($s) {
-    my $de = $s.chars;
-    my @q = $s.comb.classify({$_}).map({[+.value / $de, .key]}).sort;
-    while @q > 1 {
-	my ($a,$b) = @q.splice(0,2);
-	@q = sort flat $[$a[0] + $b[0], [$a[1], $b[1]]], @q;
+sub huffman (%frequencies) {
+    my @queue = %frequencies.map({ [.value, .key] }).sort;
+    while @queue > 1 {
+        given @queue.splice(0, 2) -> ([$freq1, $node1], [$freq2, $node2]) {
+            @queue = (|@queue, [$freq1 + $freq2, [$node1, $node2]]).sort;
+        }
     }
-    sort *.value, gather walk @q[0][1], '';
+    hash gather walk @queue[0][1], '';
 }
 
-multi walk (@node, $prefix) {
-    walk @node[0], $prefix ~ 1;
-    walk @node[1], $prefix ~ 0;
-}
-multi walk ($node, $prefix) { take $node => $prefix }
-
-say .perl for huffman('this is an example for huffman encoding');
+multi walk ($node,            $prefix) { take $node => $prefix; }
+multi walk ([$node1, $node2], $prefix) { walk $node1, $prefix ~ '0';
+                                         walk $node2, $prefix ~ '1'; }

Task/Huffman-coding/Perl-6/huffman-coding-2.pl6

@@ -1,9 +1,11 @@
-my $str = 'this is an example for huffman encoding';
-my %enc = huffman $str;
-my %dec = %enc.invert;
-say $str;
-my $huf = %enc{$str.comb}.join;
-say $huf;
-my $rx = join('|', map { "'" ~ .key ~ "'" }, %dec);
-$rx = EVAL '/' ~ $rx ~ '/';
-say $huf.subst(/<$rx>/, -> $/ {%dec{~$/}}, :g);
+sub huffman (%frequencies) {
+    my @queue = %frequencies.map: { .value => (hash .key => '') };
+    while @queue > 1 {
+        @queue.=sort;
+        my $x = @queue.shift;
+        my $y = @queue.shift;
+        @queue.push: ($x.key + $y.key) => hash $x.value.deepmap('0' ~ *),
+                                               $y.value.deepmap('1' ~ *);
+    }
+    @queue[0].value;
+}

Task/Huffman-coding/Perl-6/huffman-coding-3.pl6

@@ -0,0 +1,3 @@
+for huffman 'this is an example for huffman encoding'.comb.Bag {
+    say "'{.key}' : {.value}";
+}

Task/Huffman-coding/Perl-6/huffman-coding-4.pl6

@@ -0,0 +1,10 @@
+my $original = 'this is an example for huffman encoding';
+
+my %encode-key = huffman $original.comb.Bag;
+my %decode-key = %encode-key.invert;
+my @codes      = %decode-key.keys;
+
+my $encoded = $original.subst: /./,      { %encode-key{$_} }, :g;
+my $decoded = $encoded .subst: /@codes/, { %decode-key{$_} }, :g;
+
+.say for $original, $encoded, $decoded;