aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Task/Huffman-coding/Perl-6/huffman-coding-1.pl6
View file

@ -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'; }