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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

54
Task/Huffman-coding/Perl/huffman-coding.pl
View file

@ -3,48 +3,48 @@ use strict;
# produce encode and decode dictionary from a tree
sub walk {
my ($node, $code, $h, $rev_h) = @_;
my ($node, $code, $h, $rev_h) = @_;
my $c = $node->[0];
if (ref $c) { walk($c->[$_], $code.$_, $h, $rev_h) for 0,1 }
else { $h->{$c} = $code; $rev_h->{$code} = $c }
my $c = $node->[0];
if (ref $c) { walk($c->[$_], $code.$_, $h, $rev_h) for 0,1 }
else { $h->{$c} = $code; $rev_h->{$code} = $c }
$h, $rev_h
$h, $rev_h
}
# make a tree, and return resulting dictionaries
sub mktree {
my (%freq, @nodes);
$freq{$_}++ for split '', shift;
@nodes = map([$_, $freq{$_}], keys %freq);
my (%freq, @nodes);
$freq{$_}++ for split '', shift;
@nodes = map([$_, $freq{$_}], keys %freq);
do { # poor man's priority queue
@nodes = sort {$a->[1] <=> $b->[1]} @nodes;
my ($x, $y) = splice @nodes, 0, 2;
push @nodes, [[$x, $y], $x->[1] + $y->[1]]
} while (@nodes > 1);
do { # poor man's priority queue
@nodes = sort {$a->[1] <=> $b->[1]} @nodes;
my ($x, $y) = splice @nodes, 0, 2;
push @nodes, [[$x, $y], $x->[1] + $y->[1]]
} while (@nodes > 1);
walk($nodes[0], '', {}, {})
walk($nodes[0], '', {}, {})
}
sub encode {
my ($str, $dict) = @_;
join '', map $dict->{$_}//die("bad char $_"), split '', $str
my ($str, $dict) = @_;
join '', map $dict->{$_}//die("bad char $_"), split '', $str
}
sub decode {
my ($str, $dict) = @_;
my ($seg, @out) = ("");
my ($str, $dict) = @_;
my ($seg, @out) = ("");
# append to current segment until it's in the dictionary
for (split '', $str) {
$seg .= $_;
my $x = $dict->{$seg} // next;
push @out, $x;
$seg = '';
}
die "bad code" if length($seg);
join '', @out
# append to current segment until it's in the dictionary
for (split '', $str) {
$seg .= $_;
my $x = $dict->{$seg} // next;
push @out, $x;
$seg = '';
}
die "bad code" if length($seg);
join '', @out
}
my $txt = 'this is an example for huffman encoding';