Алгоритм Хафмана на 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;
   read(N);
   if N = 1 then      {if array consist of one element}
      writeln('1');  {answer is '1', not ''}
   for i := 1 to N do
       begin
       read(j);
       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.