langs a-z

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

@@ -0,0 +1,17 @@
+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 [$a[0] + $b[0], [$a[1], $b[1]]], @q;
+    }
+    sort *.value, gather walk @q[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');

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

@@ -0,0 +1,9 @@
+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);