дерево Хаффмана.

[stas45rus]

Всем доброе утро. Подскажите пжл. как сформировать дерево от листьев к корню. Пишу архиватор по алгоритму Хаффмана. Частоты повторения байтов подсчитал, оформил их в список, отсортировал по возрастанию, а вот как построить дерево понятия не имею. Вот примерный код:

PROGRAM Haffman;
Uses Crt;
TYPE
  Tree=^PTree;
  PTree=Record
         sch:Longint;
         sim:Byte;
         Next:Tree;
         Right,Left:Tree;
        End;
VAR
  P,Root:Tree;
  f:File;
  r:Text;
  ch:Char;
  st:String;
  i:Byte;
 
{Процедура заполнения списка}
Procedure Insert(Var P:Tree; s:Longint; i:Byte);
Begin
  If P=Nil Then
   begin
     New(P);
     P^.sch:=s;
     P^.sim:=i;
     P^.Next:=Nil
   end
  Else Insert(P^.Next,s,i);
End;
 
{Процедура подсчёта повторяющихся байтов в файле}
Procedure Schetchik(Var f:File);
Const
  Kz=1;
Var
  i,Buf:Byte;
  s:Longint;
Begin
  P:=Nil;
  For i:=0 To 255 Do
   begin
     s:=0;
     While not(Eof(f)) Do
      begin
        BlockRead(f,Buf,Kz);
        If i=Buf Then Inc(s);
      end;
     If Eof(f) Then Seek(f,0);
     If s<>0 Then Insert(P,s,i);
   end;
End;
 
{Функция сортировки списка методом пузырька}
Function Sorting(Var P:Tree):Tree;
Var
  X,N:Tree;
  s:Longint;
  m:Byte;
Begin
  X:=P;
  While X<>Nil Do
   begin
     N:=X^.Next;
     While N<>Nil Do
      begin
        If N^.sch<X^.sch Then
         begin
           s:=N^.sch;
           m:=N^.sim;
           N^.sch:=X^.sch;
           N^.sim:=X^.sim;
           X^.sch:=s;
           X^.sim:=m;
         end;
        N:=N^.Next;
      end;
     X:=X^.Next;
   end;
  Sorting:=P;
End;
 
{Процедура вывода списка в файл}
Procedure Print(P:Tree);
Begin
  While P<>Nil Do
   begin
     Writeln(r,P^.sch,' ',P^.sim);
     P:=P^.Next;
   end;
End;
 
BEGIN
 ClrScr;
 Writeln('Для архивации файла нажмите клавишу ''a''.');
 Writeln('Для распаковки файла нажмите клавишу ''r''.');
 ch:=ReadKey;
 If ch=#97 Then
  begin
    Writeln('Введите полный путь и имя файла:');
    Readln(st);
    Assign(f,st);
    Assign(r,'D:\Kopiya.TXT');
    Reset(f,1);
    If FileSize(f)=0 Then Write('файл пуст!!!')
     Else
      begin
        Rewrite(r);
 
        Schetchik(f);
        Sorting(P);
        Print(P);
 
        Close(r);
      end;
    Close(f);
  end;
 Readln;
END.