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.
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)