#! perl -slw use strict; use Data::Dump qw[ pp ]; use List::Util qw[ reduce ]; use enum qw[ NAME FREQ LEFT RIGHT ]; our $N //= 1; my$n = 0; my @heap = map{ $_->[LEFT] = ++$n; $_->[RIGHT] = ++$n; $_; } sort { $a->[FREQ] <=> $b->[FREQ] } map[ $_ , int( rand 1000 ) ], 'A'x$N .. 'Z'x$N;; my @tree = map { $_->[LEFT] = $heap[ $_->[LEFT] ], $_->[RIGHT] = $heap[ $_->[RIGHT] ] } @heap; pp \@tree; #### C:\test>1031775.pl do { my $a = [ [ "Y", 1, [ "G", 4, [ "D", 166, ["X", 245, ["I", 516, undef, undef], ["O", 563, undef, undef]], ["K", 315, ["M", 628, undef, undef], ["R", 710, undef, undef]], ], [ "A", 218, ["P", 324, ["T", 731, undef, undef], ["Q", 732, undef, undef]], ["J", 374, ["V", 735, undef, undef], ["C", 835, undef, undef]], ], ], [ "E", 33, [ "U", 220, ["L", 393, ["S", 845, undef, undef], ["F", 930, undef, undef]], ["W", 471, ["Z", 944, undef, undef], undef], ], ["H", 228, ["B", 507, undef, undef], ["N", 515, undef, undef]], ], ], 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', 'fix', ]; $a->[1] = $a->[0][2]; $a->[2] = $a->[0][3]; $a->[3] = $a->[0][2][2]; $a->[4] = $a->[0][2][3]; $a->[5] = $a->[0][3][2]; $a->[6] = $a->[0][3][3]; $a->[7] = $a->[0][2][2][2]; $a->[8] = $a->[0][2][2][3]; $a->[9] = $a->[0][2][3][2]; $a->[10] = $a->[0][2][3][3]; $a->[11] = $a->[0][3][2][2]; $a->[12] = $a->[0][3][2][3]; $a->[13] = $a->[0][3][3][2]; $a->[14] = $a->[0][3][3][3]; $a->[15] = $a->[0][2][2][2][2]; $a->[16] = $a->[0][2][2][2][3]; $a->[17] = $a->[0][2][2][3][2]; $a->[18] = $a->[0][2][2][3][3]; $a->[19] = $a->[0][2][3][2][2]; $a->[20] = $a->[0][2][3][2][3]; $a->[21] = $a->[0][2][3][3][2]; $a->[22] = $a->[0][2][3][3][3]; $a->[23] = $a->[0][3][2][2][2]; $a->[24] = $a->[0][3][2][2][3]; $a->[25] = $a->[0][3][2][3][2]; $a; }