算术编码算法

 
算术编码算法 <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

  算术编码是把一个信源表示为实轴上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;
      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;
end.次程序在Delphi6+Windows2000下通过。