{jack_wq(完美主义者——白杨)}帮个忙啊！谢谢！

[duzai]

Huffman编码要根据信息论中的概念去做，这个程序比较大也比较复杂，记得苏州大学的一个教授写的一本书的附录里面有源代码，这本书现在我不再身边！

你好，你上次所说的那本书大概什么书名是什么啊？谢谢！

[金笛子]

虽我不知道那是一本什么书但我可以提供源代码啊
基本一样啊可以根据自己的风格去修改啊
那好比是在进行软件维护一样试试看
program huffman;
{$APPTYPE CONSOLE}
uses
SysUtils;

const n=8;
m=2*n-1;
type nodetype=record
weight:integer;
parent,lch,rch:0..m
end;
bit=0..2;
codetype=record
bits:array[1..n] of bit;
start:1..n;
end;
huftree=array[1..m] of nodetype;
hufcode=array[1..n] of codetype;

var
ht:huftree;
hcd:hufcode;
w:array[1..n] of integer;
s:array[1..2] of 1..m;
c,f,k:integer;
cd:codetype;
cho:char;

procedure select(x:integer);
var
j,k:integer;
begin
s[1]:=1; s[2]:=1;
for j:=1 to 2 do
for k:=1 to x do
if ht[s[j]].parent<>0 then s[j]:=s[j]+1;
for j:=1 to 2 do
for k:=1 to x-1 do
begin
if (j=2) and (s[2]=s[1]) then s[2]:=s[2]+1;
if (ht[k+1].parent=0) and (k+1<>s[j-1]) and ((ht[k+1].weight<ht[s[j]].weight) or (ht[k+1].weight=ht[s[j-1]].weight)) then
s[j]:=k+1;
end;
end;

procedure print;
var
i:integer;
begin
writeln(' ':3,'|','weight':7,'|','parent':7,'|','lch':5,'|','rch':5);
for i:=1 to m do
writeln(i:3,'|',ht[i].weight:7,'|',ht[i].parent:7,'|',ht[i].lch:5,'|',ht[i].rch:5);
end;

procedure huffcode(var hit:huftree;var hcd:hufcode);
var
i,j:integer;
begin
for i:=1 to m do
begin
ht[i].parent:=0;
ht[i].lch:=0;
ht[i].rch:=0;
end;
for i:=1 to n do
ht[i].weight:=w[i];
print;
write('Begin: ',m-n,' times. Press Enter to go:');
readln;
readln;
for i:=n+1 to m do
begin
select(i-1);
ht[s[1]].parent:=i;
ht[s[2]].parent:=i;
ht[i].lch:=s[1];ht[i].rch:=s[2];
ht[i].weight:=ht[s[1]].weight+ht[s[2]].weight;
print;
if i<>m then
begin
write('Remain ',m-i,' times. Press Enter go on:');
readln;
end
else
write('Print Tree End. And Now Print Code:')
end;
for i:=1 to n do
begin
for j:=1 to n do
cd.bits[j]:=2;
cd.start:=n;
c:=i;
f:=ht[c].parent;
while f<>0 do
begin
if ht[f].lch=c then
cd.bits[cd.start]:=0
else cd.bits[cd.start]:=1;
cd.start:=cd.start-1;
c:=f;
f:=ht[f].parent
end;
hcd[i]:=cd
end;
end;


procedure chcode;
var
i,j,k,y:integer;
s,c:string;
begin
y:=0;
write('input the code:');
readln(s);
i:=length(s);
for j:=1 to n do
begin
if hcd[j].start=n-i then
begin
for k:=hcd[j].start+1 to n do
begin
c:=c+chr(ord(hcd[j].bits[k]+ord('0')));
end;
if s=c then
begin
y:=1;
writeln('The Number is：',j,' The Code is: ',ht[j].weight)
end
else
c:=''
end
end;
if y=0 then
writeln('The Code Not Find!');
end;

procedure printcode;
var
i,j:integer;
begin
writeln(' ':3,'|','bits':15,'|','start':5);
for i:=1 to n do
begin
write(i:3,'|');
for j:=1 to n do
if hcd[i].bits[j]<>2 then write(hcd[i].bits[j],'|')
else write(' ','|');
writeln(hcd[i].start:5);
end;
writeln('Print Code End.');
end;

begin
write('Input:');
for k:=1 to n do
read(w[k]);
huffcode(ht,hcd);
readln;
writeln('----------------------------------');
printcode;
writeln('------1:Print Huffman 2:Print Code 3:Ask Code 4:End.');
write('Choose:');
readln(cho);
while (cho<>'4') do
begin
if cho='1' then print;
if cho='2' then printcode;
if cho='3' then chcode;
writeln('------1:Print Huffman 2:Print Code 3:Ask Code 4:End.');
write('Choose:');
readln(cho);
end;
end.