# Алгоритм Хафмана на Pascal

```//(C) Eugene Barsky
var
N     : integer;                    {size of input array}

count : integer;                    {current count+1 of lists in tree}
value : array [1..1000] of integer; {weight of tree list}
next0 : array [1..1000] of integer; {first tree list child}
next1 : array [1..1000] of integer; {second tree list child}
parent: array [1..1000] of integer; {parent of this list}

i     : integer;
j     : integer;
k     : integer;

out   : array [1..1000] of integer; {array for printing in reverse order}

procedure add(x, n0, n1: integer);
{adds new list to tree}
begin
value[count] := x;
next0[count] := n0;
next1[count] := n1;
parent[count]  := 0;
if n0 <> 0 then         {0 means, that there no child}
parent[n0] := count;
if n1 <> 0 then         {0 means, that there no child}
parent[n1] := count;
inc(count);
end;

procedure split;
{finds two lists with minimum value
and adds parent of them}
var
x     : integer;
y     : integer;
z     : integer;
num   : integer;
begin
num :=1;

{find two first lists without parents}
while parent[num] <> 0 do
Inc(num);
x := num; {foundnd first lists without parents}
inc(num);

while parent[num] <> 0 do
Inc(num);
y := num; {foundnd second lists without parents}
Inc(num);

{sorting (x, y) set in ascending order}
if value[x] > value[y] then
begin
z := x;   {swaping x and y}
x := y;
y := z;
end;

{optimize current 2 lists for minimum value}
while num < count do
begin
if parent[num] =  0 then
begin
if value[num] < value[x] then
begin
y := x;
x := num;
end
else if value[num] < value[x] then
y := num;
end;
inc(num);
end;

{add new list - parent of these two with minimum value}
add(value[x] + value[y], x, y);
end;

begin
{reading input data and adds buttom lists}
count := 1;
if N = 1 then      {if array consist of one element}
writeln('1');  {answer is '1', not ''}
for i := 1 to N do
begin
add(j, 0, 0);  {0 means, that there no child}
end;

{creating tree}
for i := 1 to N-1 do
split;

{writing output data}
for i := 1 to N do          {for each buttom list}
begin
j := i;
k := 1;
while parent[j] <> 0 do {find reverse word}
begin
if next0[parent[j]] = j then out[k] := 0
else out[k] := 1;   {and save it to out array}
inc(k);
j := parent[j];
end;
while k <> 1 do         {then printing out array}
begin
write(out[k-1]);
dec(k);             {in reverse order}
end;
writeln('');
end;
end.```
-- EugeneBarsky - 16 Apr 2005
AlgorithmClasifyForm
Type: Код
Scope: Структуры данных
Strategy: Жадность
Complexity: Low