请教算术编码的算法?

请教算术编码的算法?,第1张

h = StartC + g* K

l = Endc + g* K1

其具体程序如下:

const Ca = 0.2Ce = 0.3

Ci = 0.2Co = 0.2

Cu = 0.1

var

Form1: TForm1

s: string

StartC, EndC: Extended

implementation

{$R *.dfm}

procedure ConvertTo(s: stringvar 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: Stringvar 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.

close allclear allclc %关闭所有图形窗口,清除工作空间所有变量,清空命令行

I=imread('lena.bmp')%待编码的矩阵

imshow(I)

thresh = graythresh(I)%自动确定二值化阈值

I2 = im2bw(I,thresh) %对图像二值化

imshow(I2)

[m,n]=size(I2) %计算矩阵大小

I2=double(I2)

p_table=tabulate(I2(:))%统计矩阵中元素出现的概率,第一列为矩阵元素,第二列为个数,第三列为概率百分数

color=p_table(:,1)'

p=p_table(:,3)'/100 %转换成小数表示的概率

psum=cumsum(p_table(:,3)')%计算数组各行的累加值

allLow=[0,psum(1:end-1)/100]%由于矩阵中元素只有两种,将[0,1)区间划分为两个区域allLow和 allHigh

allHigh=psum/100

numberlow=0 %定义算术编码的上下限numberlow和numberhigh

numberhigh=1

for k=1:m %以下计算算术编码的上下限,即编码结果

for kk=1:n

data=I2(k,kk)

low=allLow(data==color)

high=allHigh(data==color)

range=numberhigh-numberlow

tmp=numberlow

numberlow=tmp+range*low

numberhigh=tmp+range*high

end

end

fprintf('算术编码范围下限为%16.15f\n\n',numberlow)

fprintf('算术编码范围上限为%16.15f\n\n',numberhigh)

Mat=zeros(m,n) %解码

for k=1:m

for kk=1:n

temp=numberlow<low

temp=[temp 1]

indiff=diff(temp)

indiff=logical(indiff)

Mat(k,kk)=color(indiff)

low=low(indiff)

high=allHigh(indiff)

range=high - low

numberlow=numberlow-low

numberlow=numberlow/range

end

end

用老牛下书

很不错

算术编码算法

算术编码是把一个信源表示为实轴上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: stringvar 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: Stringvar 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.


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/11701994.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-18
下一篇 2023-05-18

发表评论

登录后才能评论

评论列表(0条)

保存