主题：C++出血者请教Delphi的一例程序。。。大哥受教来。。。。
luoul
[专家分：0] 发布于 2006-06-07 17:40:00
下面是一段用Delphi编写的算术编码程序
[b][color=800000]哪位大哥 有时间给耐心做个指点。。[/color][/b]
[b]也熟悉C语言最好，能对源代码做个注释拨。。。[/b]
受教。。。
算术编码是把一个信源表示为实轴上0和1之间的一个区间，信源集合中的每一个元素都用来缩短这个区间。
算术编码的过程如下：
（1） 设定编码区间的高段为h，编码区间的长度为g，endc为编码字符分配的高段，startc
为字符分配区间的低端。
（2） 根据有限的信源估算出各元素的概率。
（3） 杜宇编码的元素a1，根据（2）估算的概率和区间，计算出该元素编码后的新的l，和h。其公式如下：
h = startc + g* k;
l = endc + g* k1;
[em8][em17][em17][em17]
回复列表 （共1个回复）
沙发
luoul [专家分：0] 发布于 2006-06-07 17:44:00
其具体程序如下：
const ca = 0.2; ce = 0.3;
ci = 0.2; co = 0.2;
cu = 0.1;
var
form1: tform1;
s: string;
startc, endc: extended;
implementation
{$r *.dfm}
procedure convertto(s: string; var startc, endc: extended);{将字符串变为数值}
var n, i: integer;
c: char;
g: extended;
begin
startc := 0;
endc := 1;
n := strlen(pchar(s));
for i := 1 to n do
begin
c := s[i];
g := endc - startc;
case c of
'a':
begin
endc :=startc + g * ca;
startc := startc + g * 0;
end;
'e':
begin
endc := startc + g * (ca + ce);
startc := startc + g * ca;
end;
'i':
begin
endc := startc + g * (ca + ce + ci);
startc := startc + g * (ca + ce);
end;
'o':
begin
endc := startc + g * (ca + ce + ci + co);
startc := startc + g * (ca + ce + ci);
end;
'u':
begin
endc := startc + g * (ca + ce + ci + co + cu);
startc := startc + g * (ca + ce + ci + co);
end;
else
begin
showmessage(' 输入的字符串有误 ');
exit;
end;
end;
end;
end;
procedure nemuricaltostr(var s: string; var startc, endc: extended);
{将数值转换为字符串}
const eps = -1e-5;
begin
if startc-0.2 < -eps then
if (endc- 0.2<= -eps) and (endc > startc) then
begin
startc := startc / 0.2;
endc := endc / 0.2;
s := s + 'a';
if (startc <>0) or (endc <> 1) then
nemuricaltostr(s,startc,endc);
end;
if (startc- 0.2 >= eps) and (startc-0.5 < -eps) then
if (endc-0.5<= -eps) and (endc>startc) then
begin
startc := startc - 0.2;
endc := endc - 0.2;
startc := startc / 0.3;
endc := endc / 0.3;
s := s + 'e';
if (startc <>0) or (endc <> 1) then
nemuricaltostr(s,startc,endc);
end ;
if (startc- 0.5>= eps) and (startc- 0.7< -eps) then
if (endc-0.7<= -eps) and (endc>startc) then
begin
startc := startc - 0.5;
endc := endc - 0.5;
startc := startc / 0.2;
endc := endc / 0.2;
s := s + 'i';
if (startc <>0) or (endc <> 1) then
nemuricaltostr(s,startc,endc);
end ;
if (startc-0.7 >= eps) and (startc-0.9 < -eps) then
if (endc-0.9<=-eps) and (endc>startc) then
begin
startc := startc - 0.7;
endc := endc - 0.7;
startc := startc / 0.2;
endc := endc / 0.2;
s := s + 'o';
if (startc <>0) or (endc <> 1) then
nemuricaltostr(s,startc,endc);
end ;
if (startc -0.9>=eps) and (startc-1 < -eps) then
if (endc-1<= -eps) and (endc>startc) then
begin
startc := startc - 0.9;
endc := endc - 0.9;
startc := startc / 0.1;
endc := endc / 0.1;
s := s + 'u';
if (startc <>0) or (endc <> 1) then
nemuricaltostr(s,startc,endc);
end;
end;
procedure tform1.button1click(sender: tobject);
begin
s := edit1.text;
convertto(s,startc,endc);
edit2.text := floattostr(startc);
edit3.text := floattostr(endc);
end;
procedure tform1.button2click(sender: tobject);
begin
s := '';
startc := strtofloat(edit2.text);
endc := strtofloat(edit3.text);
nemuricaltostr(s,startc,endc);
edit1.text := s;
end;
我来回复
您所在位置：