栾宫涅吧 关注:6贴子:216
  • 0回复贴,共1
const n=5;
type wtype=integer;
     warray=array[1..n]of wtype;
     ptree=^nodew;
     nodew=record
        lch,rch:ptree;
        weight:wtype
     end;
     pforest=^nodef;
     nodef=record
        root:ptree;
        link:pforest;
     end;
var w:warray;   rootw:ptree; i:integer;
procedure inforest(var f:pforest;  t:ptree);
var p,q,r:pforest;  ti:ptree;
begin
    new(r); r^.root:=t;
    q:=f;   p:=f^.link;
    while p<>nil do
    begin
        ti:=p^.root;
        if t^.weight>ti^.weight then
            begin   q:=p;   p:=p^.link; end
        else    p:=nil
    end;
    r^.link:=q^.link;   q^.link:=r;
end;
procedure huffman(w:warray; var rootw:ptree);
var f,p1,p2:pforest;    ti,t,t1,t2:ptree;   i:integer;
begin
    new(f);
    f^.link:=nil;
    for i:=1 to n do
    begin
        new(ti);
        ti^.weight:=w[i];   ti^.lch:=nil;  ti^.rch:=nil;
        inforest(f,ti)
    end;
    while f^.link^.link<>nil do
        begin
            p1:=f^.link;    p2:=p1^.link;
            f^.link:=p2^.link;
            t1:=p1^.root;   t2:=p2^.root;
            dispose(p1);    dispose(p2);
            new(t);
            t^.weight:=t1^.weight+t2^.weight;
            t^.lch:=t1; t^.rch:=t2;
            inforest(f,t)
        end;
    p1:=f^.link;    rootw:=p1^.root;
    dispose(f); dispose(p1);
end;
procedure inorder(wbt:ptree);
begin
    if wbt<>nil then
    begin
        inorder(wbt^.lch);
        write(wbt^.weight:5);
        inorder(wbt^.rch);
    end;
end;
begin
    for i:=1 to n do read(w[i]);
    huffman(w,rootw);
    inorder(rootw);
    readln;readln;
end.



1楼2006-04-16 09:34回复