Huffman coding: Difference between revisions

Content added Content deleted
(added Ol)
(Rename Perl 6 -> Raku, alphabetize, minor clean-up)
Line 598: Line 598:
decoded: this is an example for huffman encoding
decoded: this is an example for huffman encoding
</pre>
</pre>

=={{header|C}}==
=={{header|C}}==


Line 1,239: Line 1,240:
}
}
}</lang>
}</lang>
[[File:CSharpHuffman.jpg]]
[[File:CSharpHuffman.jpg]]


=={{header|C++}}==
=={{header|C++}}==
Line 1,629: Line 1,630:
101 : c (4)
101 : c (4)
11 : d (8)
11 : d (8)
</pre>
</pre>


=={{header|Common Lisp}}==
=={{header|Common Lisp}}==
Line 1,980: Line 1,981:
x: 01010
x: 01010
</pre>
</pre>

=={{header|Erlang}}==
=={{header|Erlang}}==
The main part of the code used here is extracted from [https://gist.github.com/rmies/2828351 Michel Rijnders' GitHubGist]. See also [http://codingpraxis.com/erlang/2012/10/23/huffman-coding-in-erlang.html his blog], for a complete description of the original module.
The main part of the code used here is extracted from [https://gist.github.com/rmies/2828351 Michel Rijnders' GitHubGist]. See also [http://codingpraxis.com/erlang/2012/10/23/huffman-coding-in-erlang.html his blog], for a complete description of the original module.
Line 2,262: Line 2,264:
! x 1 { 1 0 0 1 0 }
! x 1 { 1 0 0 1 0 }
</lang>
</lang>

=={{header|Fantom}}==
=={{header|Fantom}}==


Line 3,243: Line 3,246:
f 3 1101
f 3 1101
6 111</pre>
6 111</pre>





=={{header|JavaScript}}==
=={{header|JavaScript}}==
Line 4,365: Line 4,365:
this is an example for huffman encoding
this is an example for huffman encoding
</pre>
</pre>

=={{header|Perl 6}}==

===By building a tree===

This version uses nested <code>Array</code>s to build a tree [https://commons.wikimedia.org/wiki/File:HuffmanCodeAlg.png like shown in this diagram], and then recursively traverses the finished tree to accumulate the prefixes.

{{works with|rakudo|2015-12-17}}
<lang perl6>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;
}
}
hash gather walk @queue[0][1], '';
}

multi walk ($node, $prefix) { take $node => $prefix; }
multi walk ([$node1, $node2], $prefix) { walk $node1, $prefix ~ '0';
walk $node2, $prefix ~ '1'; }</lang>

===Without building a tree===

This version uses an <code>Array</code> of <code>Pair</code>s to implement a simple priority queue. Each value of the queue is a <code>Hash</code> mapping from letters to prefixes, and when the queue is reduced the hashes are merged on-the-fly, so that the last one remaining is the wanted Huffman table.

{{works with|rakudo|2015-12-17}}
<lang perl6>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;
}

# Testing

for huffman 'this is an example for huffman encoding'.comb.Bag {
say "'{.key}' : {.value}";
}

# To demonstrate that the table can do a round trip:

say '';
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;</lang>

{{out}}
<pre>'x' : 11000
'p' : 01100
'h' : 0001
'g' : 00000
'a' : 1001
'e' : 1101
'd' : 110011
's' : 0111
'f' : 1110
'c' : 110010
'm' : 0010
' ' : 101
'n' : 010
'o' : 0011
'u' : 10001
't' : 10000
'i' : 1111
'r' : 01101
'l' : 00001

this is an example for huffman encoding
1000000011111011110111110111101100101010111011100010010010011000000111011011110001101101101000110001111011100010100101010111010101100100011110011111101000000
this is an example for huffman encoding</pre>


=={{header|Phix}}==
=={{header|Phix}}==
Line 5,330: Line 5,247:


An extension to the method outlined above is given [http://paddy3118.blogspot.com/2009/04/abuse-of-pythons-in-built-data.html here].
An extension to the method outlined above is given [http://paddy3118.blogspot.com/2009/04/abuse-of-pythons-in-built-data.html here].



=={{header|Racket}}==
=={{header|Racket}}==
Line 5,439: Line 5,355:
;; Here's what the decoded message looks like:
;; Here's what the decoded message looks like:
(decode encoded)</lang>
(decode encoded)</lang>

=={{header|Raku}}==
(formerly Perl 6)

===By building a tree===

This version uses nested <code>Array</code>s to build a tree [https://commons.wikimedia.org/wiki/File:HuffmanCodeAlg.png like shown in this diagram], and then recursively traverses the finished tree to accumulate the prefixes.

{{works with|rakudo|2015-12-17}}
<lang perl6>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;
}
}
hash gather walk @queue[0][1], '';
}

multi walk ($node, $prefix) { take $node => $prefix; }
multi walk ([$node1, $node2], $prefix) { walk $node1, $prefix ~ '0';
walk $node2, $prefix ~ '1'; }</lang>

===Without building a tree===

This version uses an <code>Array</code> of <code>Pair</code>s to implement a simple priority queue. Each value of the queue is a <code>Hash</code> mapping from letters to prefixes, and when the queue is reduced the hashes are merged on-the-fly, so that the last one remaining is the wanted Huffman table.

{{works with|rakudo|2015-12-17}}
<lang perl6>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;
}

# Testing

for huffman 'this is an example for huffman encoding'.comb.Bag {
say "'{.key}' : {.value}";
}

# To demonstrate that the table can do a round trip:

say '';
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;</lang>

{{out}}
<pre>'x' : 11000
'p' : 01100
'h' : 0001
'g' : 00000
'a' : 1001
'e' : 1101
'd' : 110011
's' : 0111
'f' : 1110
'c' : 110010
'm' : 0010
' ' : 101
'n' : 010
'o' : 0011
'u' : 10001
't' : 10000
'i' : 1111
'r' : 01101
'l' : 00001

this is an example for huffman encoding
1000000011111011110111110111101100101010111011100010010010011000000111011011110001101101101000110001111011100010100101010111010101100100011110011111101000000
this is an example for huffman encoding</pre>


=={{header|Red}}==
=={{header|Red}}==
Line 5,560: Line 5,560:
decoded: this is an example for huffman encoding
decoded: this is an example for huffman encoding
</pre>
</pre>

=={{header|REXX}}==
=={{header|REXX}}==
<lang rexx>/* REXX ---------------------------------------------------------------
<lang rexx>/* REXX ---------------------------------------------------------------
Retrieved from "https://rosettacode.org/wiki/Huffman_coding"