算术编码算法

算术编码是把一个信源表示为实轴上0和1之间的一个区间，信源集合中的每一个元素都用来缩短这个区间。

算术编码的过程如下：

（1）设定编码区间的高段为h，编码区间的长度为g，EndC为编码字符分配的高段，StartC

为字符分配区间的低端。

（2）根据有限的信源估算出各元素的概率。

（3）杜宇编码的元素A1，根据（2）估算的概率和区间，计算出该元素编码后的新的l，和h。其公式如下：

h = StartC + g* K;

l = Endc + g* K1;

其具体程序如下：

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;

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;

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;

end.