Подякувати Студентському архіву довільною сумою
Admin
26.02.2023 12:38
Дякуємо, що користуєтесь нашим архівом!
МЕТОДИ ОПТИМАЛЬНОГО КОДУВАННЯ
Інформація про навчальний заклад
ВУЗ:
Національний університет Львівська політехніка
Інститут:
Не вказано
Факультет:
Не вказано
Кафедра:
Кафедра САПР
Інформація про роботу
Рік:
2008
Тип роботи:
Звіт про виконання лабораторної роботи
Предмет:
Методи та засоби комп’ютерних інформаційних технологій
Група:
КН-316
Частина тексту файла (без зображень, графіків і формул):
Міністерство освіти і науки України
Національний університет «Львівська політехніка»
Кафедра САПР
ЗВІТ
про виконання лабораторної роботи №2
на тему: «МЕТОДИ ОПТИМАЛЬНОГО КОДУВАННЯ»
з курсу:
« Методи та засоби комп’ютерних інформаційних технологій»
МЕТА РОБОТИ
Мета роботи – отримати практичні навики використання методів оптимального кодування.
КОРОТКІ ТЕОРЕТИЧНІ ВІДОМОСТІ
2.1. Метод Шеннона-Фано
В цьому методі для кожного символа формується бітовий код, довжина якого залежить від частоти появи символа. Чим менша частота, тим довший код. Визначення частоти (ймовірності) символа буває статичне (на основі таблиці даних) та динамічне (коли відомості про ймовірність появи символів визначаються на основі обробки потоку даних). Статичний варіант використовується в архіваторах ARK, PKZIP.
Кодування здійснюється таким чином (рис. 1):
Всі символи записуються в таблицю по зменшенню їх частоти. Потім вони поділяються на дві групи так, щоб суми частот для отриманих груп були максимально близькі. Для першої групи перший біт коду встановлюється рівним 1, а для другої – 0.
Потім групи знову поділяємо на дві і визначаємо наступні розряди коду. Процес продовжується поки в групі не залишиться тільки один символ.
Номер Символ Частота Код
1 a 10 11
2 b 8 10
----------------------------- ----------------------------
3 c 6 011
4 d 5 010
5 e 4 001
6 f 3 000
Рис. 1.
Кодування Шеннона-Фано неоднозначне. В залежності від варіанту поділу на групи (при однаковій різниці частот між ними) будуть отримані різні коди для символів (рис. 2).
Символ Частота Код Символ Частота Код
с 22 11 с 22 11
e 20 101 e 20 10
h 16 100 --------------------------------------------
----------------------------------------------- h 16 011
i 16 011 і 16 010
a 10 010 a 10 001
k 10 001 k 10 0001
m 4 0001 m 4 00001
b 2 0000 b 2 00000
Рис. 2.
Можливий варіант програмної реалізації методу базується на формуванні і обробці такої таблиці
Nгр
Np
Nk
S
Код
1
1
2
18
1
3
6
18
0
2
1
1
10
11
2
2
8
10
3
3
4
11
01
5
6
7
00
4
3
3
6
011
4
4
5
010
5
5
5
4
001
6
6
3
000
Ця таблиця забезпечує зручний запис алгоритму поділу на підгрупи і формування кодів. Перша група (Nгр=1) складається з двох підгруп: перша - починається з першого символа (Np=1) і закінчується другим (Nк=2), друга – починається з третього символа (Nр=3) і закінчується шостим (Nк=6). Сума частот першої підгрупи S=18, другої S=18. Друга група (Nгр=2) формується в результаті поділу першої підгрупи з першої групи і складається теж з двох підгруп: перша – починається з першого символа (Nр=1) і ним закінчується (Nк=1), друга – починається другим символом (Nр=2) і ним закінчується (Nк=2). Третя група описує процес поділу другої підгрупи з першої групи. Процуес продовжується до тих пір поки кожна підгрупа не буде складатися тільки з одного символа (Nр=Nк). Відповідний новий біт коду кожної групи визначається таким чином: для першої підгрупи він встановлюється рівним одиниці, а для другої підгрупи – нулю.
2.2. Метод Хаффмана.
Метод полягає в побудові кодового дерева Хаффмана, положення символа на якому визначається частотою (ймовірністю) його появи. Реалізація методу здійснюється по таких кроках:
Всім символам ставиться у відповідність одна з вершин дерева.
Об’єднуємо дві вершини з мінімальними частотами і для нової вершини вказуємо сумарну частоту.
Переходимо на пункт 2, доки не об’єднаємо всі вершини.
Обходимо дерево і визначаємо розряди коду по такому правилу: перехід вліво – розряд =1, перехід вправо – розряд = 0 (рис.3).
Для програмної реалізації методу можна використати таку таблицю
c 22 22 22 26 32 42 58 100 01
e 20 20 20 22 26 32 42 00
h 16 16 16 20 22 26 111
l 16 16 16 16 20 110
a 10 10 16 16 100
k 10 10 10 1011
m4 6 10101
b 2 10110
Рис. 3.
ІНДИВІДУАЛЬНЕ ЗАВДАННЯ
Реалізувати програмно кодування рядка з наведеними параметрами методом Шеннона-Фано та методом Хаффмана:
Частота a
20
Частота b
20
Частота c
20
Частота d
10
Частота e
8
Частота f
7
Частота g
5
4. ТЕКСТ ПРОГРАМИ
Метод Шеннона-Фано. Кодування:
program Shennon_Fano_Coding;
uses crt;
type tptr=^telem;
telem=record
c: char;
n: longint;
status: 0..3;
code: string;
next: tptr
end;
var file_name,result_name: string;
i: byte;
c: char;
s,fs,fp: longint;
p,p0: tptr;
fc: text;
f_test: file of char;
function pow (x,y: real): real;
begin
if x>0 then pow:=exp (ln (x)*y) else
begin
if x=0 then if y>0 then pow:=0 else pow:=1/x
else begin
if y=trunc (y) then
if odd (trunc (y)) then pow:=-exp (ln (-x)*y) else pow:=exp (ln (-x)*y)
else pow:=sqrt (x)
end
end
end;
procedure newelem (var p0: tptr; c: char);
var p1: tptr;
begin
new (p1);
p1^.c:=c;
p1^.n:=1;
p1^.status:=0;
p1^.code:='';
p1^.next:=nil;
if p0<>nil then p0^.next:=p1;
p0:=p1
end;
procedure searchchar (p: tptr; var p1: tptr; c: char);
begin
p1:=p;
while p1<>nil do
if p1^.c=c then break else p1:=p1^.next
end;
procedure addchar (var p: tptr; var p0: tptr; c: char);
var p1: tptr;
begin
searchchar (p,p1,c);
if p1=nil then newelem (p0,c) else p1^.n:=p1^.n+1;
if p=nil then p:=p0
end;
procedure deletechar (var p: tptr);
var p1: tptr;
begin
while p<>nil do
begin
p1:=p;
p:=p^.next;
dispose (p1)
end
end;
procedure sort (var p: tptr);
var p1,p2,p3,p4,p5: tptr;
begin
new (p5);
p4:=p5;
p4^.next:=p;
p4^.status:=1;
p1:=p4^.next;
while p1^.next<>nil do
begin
p2:=p1;
p3:=p1^.next;
while p3<>nil do
begin
if p3^.n>p2^.n then p2:=p3;
p3:=p3^.next
end;
p3:=p1^.next;
p1^.next:=p2^.next;
p2^.next:=p3;
while (p3^.next<>p2) and (p3<>p2) and (p3<>nil) do p3:=p3^.next;
if p3<>nil then
begin
p3^.next:=p1;
p4^.next:=p2
end;
if p4^.status=1 then p:=p4^.next;
p4:=p4^.next;
p1:=p4^.next;
end;
dispose (p5)
end;
procedure createcode (var p: tptr; s: longint; c: string);
var p1,p2: tptr;
s1,s2,r1,r2: longint;
k: byte;
begin
if p^.status=3 then p^.code:=p^.code+c else
begin
p1:=p;
p1^.code:=p1^.code+c;
p1:=p1^.next;
while (p1<>nil) and (p1^.status in [0,2]) do
begin
p1^.code:=p1^.code+c;
p1:=p1^.next
end;
p1:=p;
p2:=p1;
k:=0;
s1:=p1^.n;
r1:=abs(s-s1-s1);
repeat
if p1^.next^.status in [0,2] then
begin
s2:=s1+p1^.next^.n;
r2:=abs(s-s2-s2);
if r2<r1 then
begin
s1:=s2;
r1:=r2;
p1:=p1^.next;
k:=1
end
else k:=0
end
until k=0;
if p1^.status=1 then p1^.status:=3 else p1^.status:=2;
if p1^.next<>nil then
begin
if p1^.next^.status=2 then p1^.next^.status:=3
else p1^.next^.status:=1
end;
createcode (p2,s1,'1');
if p1^.next<>nil then
begin
p1:=p1^.next;
createcode (p1,s-s1,'0')
end
end
end;
function getcode (p: tptr; c: char): string;
var p1: tptr;
begin
p1:=p;
while p1<>nil do
if p1^.c=c then
begin
getcode:=p1^.code;
break
end
else p1:=p1^.next
end;
procedure writeidentic (p: tptr; var fc: text; result_name: string);
var c: char;
fsf: text;
begin
assign (fsf,result_name);
rewrite (fsf);
write (fsf,'1 ');
write (fsf,fs,' ');
reset (fc);
read (fc,c);
write (fsf,c);
close (fc);
close (fsf)
end;
procedure writecode (p: tptr; var fc: text; result_name: string);
var c: char;
code,s1,cd,cd2,cd3: string;
i,j,n,n1: byte;
a,k: integer;
b: real;
p1: tptr;
fsf: text;
begin
assign (fsf,result_name);
rewrite (fsf);
p1:=p;
k:=0;
while p1<>nil do
begin
k:=k+1;
p1:=p1^.next
end;
str (k,s1);
write (fsf,s1,' ');
p1:=p;
while p1<>nil do
begin
cd:=p1^.code;
cd3:='';
b:=length (cd)/4;
if b<>int (b) then b:=int (b)+1;
while length (cd)<b*4 do cd:=cd+' ';
for i:=1 to round (b) do
begin
cd2:='';
for j:=1 to 4 do
case cd[4*(i-1)+j] of
'0': cd2:=cd2+'00';
'1': cd2:=cd2+'10';
' ': cd2:=cd2+'11'
end;
n:=0;
for j:=1 to 8 do
begin
val (cd2[j],n1,a);
n:=n+trunc (pow (2,j-1))*n1
end;
cd3:=cd3+chr (n)
end;
write (fsf,p1^.c,' ',cd3,' ');
p1:=p1^.next
end;
code:='';
reset (fc);
while fp<fs do
begin
read (fc,c);
fp:=fp+1;
code:=code+getcode (p,c);
if length (code)>=8 then
begin
n:=0;
for i:=1 to 8 do
begin
val (code[i],n1,a);
n:=n+trunc (pow (2,i-1))*n1
end;
c:=chr (n);
write (fsf,c);
code:=copy (code,9,length (code))
end
end;
k:=8-length (code);
for i:=1 to k do
code:=code+'0';
n:=0;
for i:=1 to 8 do
begin
val (code[i],n1,a);
n:=n+trunc (pow (2,i-1))*n1
end;
c:=chr (n);
write (fsf,c);
str (k,s1);
write (fsf,s1);
close (fc);
close (fsf)
end;
begin
if paramcount<1 then
begin
clrscr;
write ('Enter file name for coding (Shennon-Fano`s method): ');
file_name:='';
while file_name='' do readln (file_name)
end else
begin
file_name:=paramstr(1);
for i:=2 to paramcount do file_name:=file_name+' '+paramstr(i)
end;
{$I-}
assign (fc,file_name);
reset (fc);
{$I+}
if ioresult<>0 then
begin
writeln ('File ',file_name,' not found.');
halt
end;
p:=nil;
p0:=p;
assign (f_test,file_name);
reset (f_test);
fs:=filesize (f_test);
close (f_test);
if fs=0 then begin
writeln ('File ',file_name,' is empty.');
halt
end;
i:=pos ('.',file_name);
if i=0 then i:=length (file_name)+1;
result_name:=copy (file_name,1,i-1)+'.'+'sf';
fp:=0;
while fp<fs do
begin
read (fc,c);
fp:=fp+1;
addchar (p,p0,c)
end;
close (fc);
fp:=0;
sort (p);
p^.status:=1;
p0:=p;
while p0^.next<>nil do p0:=p0^.next;
if p0<>p then p0^.status:=2 else
begin
writeidentic (p,fc,result_name);
deletechar (p);
writeln ('ok');
halt
end;
s:=0;
p0:=p;
while p0<>nil do
begin
s:=s+p0^.n;
p0:=p0^.next
end;
createcode (p,s,'');
writecode (p,fc,result_name);
deletechar (p);
writeln ('ok')
end.
Метод Шеннона-Фано. Декодування:
program Shennon_Fano_Decoding;
uses crt;
type tptr=^telem;
telem=record
c: char;
code: string;
next: tptr
end;
var file_name,result_name,cd,st: string;
j: byte;
a,i,n: integer;
c,ch: char;
p,p0: tptr;
fs,fp: longint;
fc: text;
f_test: file of char;
procedure addelem (var p0: tptr; c: char; code: string);
var p1: tptr;
begin
new (p1);
p1^.c:=c;
p1^.code:=code;
p1^.next:=nil;
if p0<>nil then p0^.next:=p1;
p0:=p1
end;
procedure deletechar (var p: tptr);
var p1: tptr;
begin
while p<>nil do
begin
p1:=p;
p:=p^.next;
dispose (p1)
end
end;
procedure searchcode (p: tptr; code: string; var c: char; var status: byte);
var p1: tptr;
begin
p1:=p;
status:=1;
while p1<>nil do
if p1^.code=code then
begin
status:=0;
break
end
else p1:=p1^.next;
if status=0 then c:=p1^.c
end;
function ntocode (n: byte): string;
var i: byte;
a: real;
s: string;
begin
s:='';
a:=n;
for i:=1 to 8 do
begin
a:=a/2;
if a=int (a) then s:=s+'0' else s:=s+'1';
a:=int (a)
end;
ntocode:=s
end;
procedure readidentic (p: tptr; var fc: text; result_name: string);
var i,n: longint;
a: integer;
c: char;
st: string;
fsf: text;
begin
assign (fsf,result_name);
rewrite (fsf);
st:='';
read (fc,c);
while c<>' ' do
begin
st:=st+c;
read (fc,c)
end;
val (st,n,a);
read (fc,c);
for i:=1 to n do write (fsf,c);
close (fc);
close (fsf)
end;
procedure readcode (p: tptr; var fc: text; result_name: string);
var c,c2,ck: char;
code,s1: string;
i,k,n,status: byte;
a: integer;
fsf: text;
begin
assign (fsf,result_name);
rewrite (fsf);
s1:='';
status:=1;
while (fp<fs) or (s1<>'') do
begin
if (status=1) or (s1='') then
begin
read (fc,c);
fp:=fp+1;
if fp=fs-1 then
begin
read (fc,ck);
fp:=fp+1;
val (ck,k,a);
n:=ord (c);
s1:=s1+copy (ntocode (n),1,8-k)
end
else begin
n:=ord (c);
s1:=s1+ntocode (n)
end
end;
code:='';
for i:=1 to length (s1) do
begin
code:=code+s1[i];
searchcode (p,code,c2,status);
if status=0 then
begin
write (fsf,c2);
s1:=copy (s1,i+1,length (s1)-i);
break
end
end
end;
close (fc);
close (fsf)
end;
begin
if paramcount<1 then
begin
clrscr;
write ('Enter file name for decoding(Shennon-Fano`s method): ');
file_name:='';
while file_name='' do readln (file_name)
end else
begin
file_name:=paramstr(1);
for i:=2 to paramcount do file_name:=file_name+' '+paramstr(i)
end;
{$I-}
assign (fc,file_name);
reset (fc);
{$I+}
if ioresult<>0 then
begin
writeln ('File ',file_name,' not found.');
halt
end;
p:=nil;
p0:=p;
assign (f_test,file_name);
reset (f_test);
fs:=filesize (f_test);
close (f_test);
if fs=0 then begin
writeln ('File ',file_name,' is empty.');
halt
end;
i:=pos ('.',file_name);
if i=0 then i:=length (file_name)+1;
result_name:=copy (file_name,1,i-1)+'.'+'dsf';
fp:=0;
st:='';
read (fc,c);
fp:=fp+1;
while c<>' ' do
begin
st:=st+c;
read (fc,c);
fp:=fp+1
end;
val (st,n,a);
if n=1 then
begin
readidentic (p,fc,result_name);
writeln ('ok');
halt
end;
for i:=1 to n do
begin
read (fc,ch);
read (fc,c);
fp:=fp+2;
st:='';
read (fc,c);
fp:=fp+1;
while c<>' ' do
begin
st:=st+c;
read (fc,c);
fp:=fp+1
end;
cd:='';
for j:=1 to length (st) do cd:=cd+ntocode (ord (st[j]));
st:='';
for j:=1 to round (length (cd)/2) do
if cd[(j-1)*2+1]+cd[j*2]='00' then st:=st+'0' else
if cd[(j-1)*2+1]+cd[j*2]='10' then st:=st+'1' else break;
addelem (p0,ch,st);
if p=nil then p:=p0
end;
readcode (p,fc,result_name);
deletechar (p);
writeln ('ok')
end.
Метод Хаффмана. Кодування:
Program HafmenCoder;
Uses Crt, Dos;
Type Telem=record
inf: char;
num: longint;
mask: string[85];
ind: array[1..190] of boolean;
end;
Var S:array [1..190] of Telem;
b:Telem;
i,j,l:word;
f:text;
Procedure Make_Vector;
Var St:string;
In_F:string;
BEGIN
In_F:=ParamStr(1);
{$I-}
assign(f,In_F);
reset(f);
{$I+}
if IOResult <> 0 then
begin
writeln('Opening input file error!');
readkey;
halt;
end;
read(f,St[0]);
S[1].inf:=St[0];
S[1].num:=1;
j:=1;
while not eof(f) do
Begin
readln(f,St);
l:=1;
while l<=length(St) do
Begin
for i:=1 to j do
Begin
if ord(S[i].inf)=ord(St[l]) then
Begin
inc(S[i].num);
i:=j-1;
break;
End;
End;
if i=j then
Begin
inc(j);
S[j].inf:=St[l];
S[j].num:=1;
End;
inc(l);
End;
End;
END;
Procedure Sort_Vector;
Var m,k:integer;
BEGIN
for i:=2 to j do
Begin
b:=S[i];
m:=1;
while (b.num<S[m].num) do
inc(m);
for k:=i-1 downto m do
S[k+1]:=S[k];
S[m]:=b;
End;
l:=j;
END;
Procedure Set_Mask;
Var Ks:array [1..190] of word;
h:integer;
Procedure Sort_Ks;
Var max,imax,p,t:word;
S_ind:array [1..190] of boolean;
BEGIN
for t:=1 to j-1 do
Begin
max:=Ks[t];
imax:=t;
for i:=t+1 to j do
if Ks[i]>max then
Begin
max:=Ks[i];
imax:=i;
End;
if t<>imax then
Begin
for p:=1 to l do
S_ind[p]:=S[imax].ind[p];
for i:=j-1 downto t do
Begin
Ks[i+1]:=Ks[i];
S[i+1].ind:=S[i].ind;
End;
Ks[t]:=max;
for p:=1 to l do
S[t].ind[p]:=S_ind[p];
End;
End;
END;
BEGIN
for i:=1 to j do
S[i].ind[i]:=true;
for i:=1 to j do
Ks[i]:=S[i].num;
while j<>1 do
Begin
for i:=1 to l do
if S[j].ind[i]=true then
S[i].mask:='0'+ S[i].mask;
for i:=1 to l do
if S[j-1].ind[i]=true then
S[i].mask:='1'+ S[i].mask;
for i:=1 to l do
S[j-1].ind[i]:=S[j].ind[i] or S[j-1].ind[i];
Ks[j-1]:=Ks[j-1]+Ks[j];
Ks[j]:=0;
dec(j);
Sort_Ks;
End;
END;
Procedure Res_Out;
Var Res: text;
Out_F:string;
c:char;
f1:text;
b:boolean;
Begin
Out_F:=paramstr(2);
{$I-}
assign(Res,Out_F);
assign(f1,'table.tbl');
rewrite(Res);
rewrite(f1);
{$I+}
if IOResult <> 0 then
begin
writeln('Opening output file error!');
readkey;
halt;
end;
clrscr;
writeln('Char Quantity Bitmask');
j:=l;
for i:=1 to j do
Begin
writeln(f1,S[i].inf,S[i].mask);
if (i mod 23)=0 then readln;
End;
reset(f);
while not eof(f) do
begin
read(f,c);
for i:=1 to j do
if c=s[i].inf then
begin
write(res,s[i].mask);
break;
end;
end;
close(f1);
close(Res);
End;
BEGIN
clrscr;
Make_Vector;
Sort_Vector;
Set_Mask;
Res_Out;
writeln('Coder end!!!');
END. 5. ВИСНОВКИ
На цій лабораторній роботі я отримав практичні навики використання методів оптимального кодування.
Ділись своїми роботами та отримуй миттєві бонуси!
0%
Оголошення від адміністратора