{-------------------类型定义---------------------------------}
type
aset=set of char;
chrecord=record
data:integer;
ch:char;
end;
intar=array[0..51]of chrecord;{英文字母有26个}
charar=array ['a'..'z']of integer;
nodetype=record
weight:integer;
parent,lch,rch:0..51;{说需的节点最多为51个}
ch:char;
flag:0..1;
end;
bit=0..1;
codetype=record
bits:array[1..26]of bit;
start:1..26;
ch:char;
end;
hufftree=array[1..51]of nodetype;
huffcode=array[1..26]of codetype;
var i,j,m,n:integer;
ar:intar;
ht:hufftree; hcd:huffcode;
hnode:nodetype;
{---------------------------过程定义-------------------------} procedure createweight(var ar:intar;var n,m:integer);
var ch:char;
cch:charar;
a:aset;
begin
i:=1; n:=0;
a:=[];
for ch:='a' to 'z' do
cch[ch]:=0;
while not eof do
begin
read(ch);
cch[ch]:=cch[ch]+1;
a:=a+[ch];
end; for ch:='a' to 'z' do
begin
if ch in a then
begin
ar[i].data:=cch[ch];
ar[i].ch:=ch;
i:=i+1;
end;
n:=i-1; m:=2*n - 1;
end;
end; procedure huffmantree(var ht:hufftree);{初始化huffman树}
var i: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
begin
ht[i].weight:=ar[i].data;
ht[i].ch:=ar[i].ch;
end;
end;{结束初始化}
procedure select(g:integer; var s1,s2:integer);
var j,k:integer;{从数组[1。。g]中选取两个权值小的分别赋给s1,s2}
begin
j:=1;
while ht[j].flag <> 0 do
j:=j+1; {flag = 0 表示未被访问过,如果第一个数在以前曾被访问过
那么这个数肯定不是所需的,所以j后移}
s1:=j; s2:=j;
for k:=j+1 to g do
if ( ht[k].flag = 0 )and (ht[k].weight < ht[s1].weight ) then
s1:=k; {最后的到的s1为以前没访问过的最小值}
ht[s1].flag:= 1; {标记数组中第s1个元素已访问过}
for k:= j+1 to g do
if ( ht[k].flag = 0 )and (ht[k].weight < ht[s2].weight ) then
s2:=k;
ht[s2].flag:=1; end;
procedure joinweight;{ht为哈夫曼树}
var i,s1,s2:integer;
begin
for i:=n+1 to m+1 do begin
select(i-1,s1,s2);
ht[s1].parent:=i;
ht[s2].parent:=i;
ht[i].lch:=s1;
ht[i].rch:=s2;
ht[i].weight:=ht[s1].weight + ht[s2].weight; end; end;
procedure huffmancode(var hcd:huffcode) ;
var cd:codetype;i,j,c,f:integer;
begin
for i:=1 to n do begin
cd.start:=n;
c:=i; f:=ht[c].parent; cd.ch:=ht[c].ch;
while f<>0 do begin
if ht[f].lch=0 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 ;for i:= 1 to n do begin
write(hcd[i].ch);
for j:= n-hcd[i].start to n do
write(' ',hcd[i].bits[j]);writeln;
end;
end;
{---------------------------下面是主程序---------------------------------} begin
writeln('*****************************************************************************');
writeln(strin);
writeln('*****************************************************************************');
writeln('WARNING!');
writeln('place input your telegram characters and with ctrl+z to stop');{以ctrl+z结束输入}
createweight(ar,n,m);
for i:= 1 to m do
ht[i].flag:=0;
huffmantree(ht);
joinweight;
for i:= 1 to m do
writeln(ht[i].ch,' weight ',ht[i].weight,' parent ',ht[i].parent,' lch ',ht[i].lch,' rch ',ht[i].rch);
{ huffmancode(hcd);}
writeln('-------this is the end-----');
end.好象是山农大的一人写的偶不知道该怎么在DELPHI里运行。。
最近想在DELPHI里学算法。。无从下手的感觉。
谢谢
解决方案 »
- 东进语音卡,取得按键值的问题
- 为什么一条记录会重复上传2条完全相同的记录?
- 如何得到比较精准的浮点数?
- 在查询时如果用户输入了单引号怎么办?
- 昨天问题没解决,但已经揭帖,再次问时间格式的问题!50分
- 各位大侠,请帮帮忙吧....一个关于数据库中的一个表被锁的小问题...(解决了问题就送分了,反正分对我来说没什么用)
- 一个奇怪的问题
- 大家来帮忙,小弟很感激。不能比较或排序text、ntext和image数据类型,除非使用is null 或 like运算
- 在quickrep中画线的问题,急!
- const Something = ('123') 和 const Something = '123'的区别(无正文)
- 怎样将文本文件转换成mdb或者dbf?【悬赏50分】
- 如何取字符串中的其中几位?
之后将代码复制粘贴上去
在delphi中,新建一个工程,再把代码Copy过去做适当的修改即可运行。