huffmantree.pas

HUFFMAN SUANFA SHI YONG JAVA BIAB DE

unit HuffmanTree;

interface
   uses ClassLib,HCodes,Classes;

   type PCode = ^TCode;

        PHTreeNode = ^HTreeNode;
        HTreeNode = record
             Amount: Cardinal;
             case Terminal: boolean of
                  True : (Symbol: Longint);
                  False: (Left,Right: PHTreeNode);
        end;

        TCodeBuffer = class(TRecordBuffer)
        protected
                 function  GetCode(i: Indexes): PCode;
                 procedure SetCode(i: Indexes; Code: PCode);
        public
                 property Codes[Ind:Indexes]: PCode read GetCode write SetCode; default;
                 constructor Create;
        end;

        TCountBuffer = class(TRecordBuffer)
                  constructor Create;
                  function    GetCount(i: Indexes): Longint;
                  procedure   SetCount(i: Indexes; Count: Longint);
                  property Countes[I: Indexes]: Longint
                           read GetCount write SetCount; default;
        end;

        procedure GetHuffmanCodes(CB: TCountBuffer; var HB: TCodeBuffer);

implementation

  constructor TCountBuffer.Create;
  begin
       inherited;
       RecordSize := SizeOf(Longint)
  end;

  function TCountBuffer.GetCount(i: Indexes): Longint;
  begin
       GetRecord(i,Result)
  end;

  procedure TCountBuffer.SetCount(i: Indexes; Count: Longint);
  begin
       SetRecord(i,Count)
  end;

{...........................TCodeBuffer........................................}
constructor TCodeBuffer.Create;
begin
     inherited;
     RecordSize := sizeof(PCode)
end;

function  TCodeBuffer.GetCode(i: Indexes): PCode;
begin
     GetRecord(i,Result)
end;

procedure TCodeBuffer.SetCode(i: Indexes; Code: PCode);
begin
     SetRecord(i,Code)
end;


  function HTree(CB: TCountBuffer): HTreeNode;
    var pH,pH1,pH2: PHTreeNode;
        Lst: TList;
        i: Indexes;
  begin
       Lst := TList.Create;
       for i := 0 to CB.Amount-1 do
       begin
            pH := new(PHTreeNode);
            pH^.Symbol := i;
            pH^.Amount := CB[i];
            pH^.Terminal := True;
            Lst.Add(pH)
       end;
       while Lst.Count>1 do
       begin
            pH1 := Lst.Items[0];
            pH2 := Lst.Items[1];
            Lst.Delete(0);
            Lst.Delete(0);
            pH  := new(PHTreeNode);
            pH^.Left  := pH1;
            pH^.Right := pH2;
            pH^.Amount := pH1^.Amount + pH2^.Amount;
            pH^.Terminal := False;
            i := 0;
            while (i<Lst.Count) and
              (HTreeNode(Lst.Items[i]^).Amount<=pH^.Amount) do inc(i);
            Lst.Insert(i,pH);
       end;
       Result := HTreeNode(Lst[0]^);
       Lst.Free
  end;

  procedure make(var HB: TCodeBuffer; T: HTreeNode; C: TCode);
    var C1: PCode;
        CC: TCode;
  begin
       if T.Terminal
       then begin
            new(C1);
            C1^ := TCode.Create(C.N);
            C1^.Code := C.Code;
            HB[T.Symbol] := C1;
       end
       else begin
            CC := TCode.Create(C.N+1);
            CC.Code := C.Code;
            CC.SetBit(C.N,False);
            make(HB,T.Left^,CC);
            CC.SetBit(C.N,True);
            make(HB,T.Right^,CC);
            CC.Free
       end
  end;

  procedure GetHuffmanCodes(CB: TCountBuffer; var HB: TCodeBuffer);
    var T: HTreeNode;
        C: TCode;
  begin
       HB.Amount := CB.Amount;
       T := HTree(CB);
       C := TCode.Create(0);
       make(HB,T,C);
       C.Free
  end;

end.