Подякувати Студентському архіву довільною сумою
Admin
26.02.2023 12:38
Дякуємо, що користуєтесь нашим архівом!
Оптимальне кодування.
Інформація про навчальний заклад
ВУЗ:
Національний університет Львівська політехніка
Інститут:
Не вказано
Факультет:
Не вказано
Кафедра:
Системи автоматизованого проектуваня
Інформація про роботу
Рік:
2007
Тип роботи:
Лабораторна робота
Предмет:
Методи i засоби комп'ютерних інформаційних технологій
Група:
КН
Частина тексту файла (без зображень, графіків і формул):
Міністерство освіти і науки України
Національний університет „Львівська політехніка”
Кафедра САП
Звіт
до лабораторної роботи №2
на тему: „Оптимальне кодування”
З курсу : ”Методи та засоби комп”ютерних інформаційних технологій”
ВИКОНАВ:
студент групи КН-3
Львів 2007
Теоретичні відомості
МЕТА РОБОТИ
Мета роботи – отримати практичні навики використання методів оптимального кодування.
Різновидності кодів.
По формі представлення в каналі передачі розрізняють послідовні і паралельні коди. При послідовних кодах елементарні сигнали, що передають кодову комбінацію посилаються в канал передачі послідовно в часі. Вони можуть бути розділені часовим інтервалом або опитуватися в певні моменти часу (наприклад, як у послідовному інтерфейсі RS - 232 C).
Для паралельних кодів потрібні багатопровідні канали, тому при передачі інфрмації на значну відстань вони використовуються рідко через великі затрати (наприклад, паралельний інтерфейс Centronics). Паралельне представлення найчастіше використовується коли потрібна висока швидкість передачі даних (Centronics – 80 – 120 Кбайт/сек, сучасні двонаправлені системи – до 250 Кбайт/сек).
По можливості виявлення та виправлення помилок розрізняють прості (примітивні) і коректуючі коди.
В простих кодах помилка у будь-якому елементі кодової комбінації приводить до неправильного прийому декодованого повідомлення.
Коректуючі коди дозволяють виявляти і усувати помилки у кодових комбінаціях.
По основних законах кодоутворення коди поділяються на комбінаторні (нечислові) і арифметичні (числові).
Комбінаторні коди будуються по законах теорії поєднань. Наприклад, код з m різних символів утворює кодові комбінації з n<m символів. Довжина коду постійна і рівна n, а можлива кількість кодових комбінацій
EMBED Equation.3 ;
Наприклад, комбінації з 3 по 2: a, b, c =>ab, ac, bc.
Арифметичні (числові, цифрові) коди базуються на системах числення і найчастіше використовуються в технічних системах.
Рівномірні прості цифрові коди.
Системи числення, на основі яких будуються цифрові коди, поділяються на позиційні і непозиційні.
В позиційних сисмтемах значення символа залежить від його позиції в ряду символів, що утворюють число. В непозиційних – ні. В позиційних системах значення кожного наступного розряду більше від попереднього в m раз (m – основа системи чиселення).
При цьому будь-яке n-розрядне число може бути представлене у вигляді суми
EMBED Equation.3
де: lі - значення і-го розрядного коефіцієнта.
Кількість можливих значень lі рівна m (від 0 до m-1).
Приклад: чотирьохрозрядне десяткове число 4752=4*103+7*102+5*101+2*100.
Максимальна кількість кодових комбінацій Nmax=mn.
На практиці в технічних системах найчастіше використовуються двійкові коди
EMBED Equation.3
де: li = 01; Nmax = 2n;
N=2010=0*25+1*24+0*23+1*22+0*21+0*20 (0101002)
Двійковий код зручний для обробки машиною, однак для оператора громіздкий, тому використовують вісімкову або шістнадцяткову системи з основою рівною 23 і 2 4 відповідно.
EMBED Equation.3
N=(0248)= (0000101002)
EMBED Equation.3
N=(01416)= (0000000101002)
Для запису шістнадцяткових чисел використовуються цифри 0-9 та букви А-F.
Складні коди.
Складні коди базуються на системах числення, що мають дві і більше основ. При такому кодуванні числа, задані в системі з основою q, записуються за допомогою цифр іншої системи числення з основою p<q.
Найбільш характерні двійково-десяткові коди. Вони використовуються як проміжні при переводі десяткових у двійкові та навпаки.
У двійково-десятковій системі числення основна система числення десяткова. Однак кожна цифра десяткового числа записується у вигляді чотирьохрозрядного двійкового числа.
Найбільш часто використовують чотирьохрозрядні двійкові вагові коди 8-4-2-1; 7-4-2-1; 5-1-2-1; 2-4-2-1. Так як з 16 комбінацій використовують 10, то код – надлишковий.
Приклад:
8 4 2 1 7 4 2 1 5 1 2 1 2 4 2 1
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1
2 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
3 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1
4 0 1 0 0 0 1 0 0 0 1 1 1 0 1 0 0
5 0 1 0 1 0 1 0 1 1 0 0 0 1 0 1 1
6 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0
7 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1
8 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0
9 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1
Рефлексні (відбиті) коди.
У простому (двійковому) коді при переході від одного числа до сусіднього може бути зміна цифр у кількох розрядах. Це може спричинити значні помилки при кодуванні неперервних повідомлень. Так, наприклад, кодування секторним перетворювачем кута при переході від 7 до 8 (1112 => 10002) тимчасово може дати значення 1111 (помилка у 2 рази).
Для усунення цього явища використовують спеціальні двійкові коди, у яких при переході від числа до числа міняється тільки один розряд. При цьому похибка за рахунок неоднозначності зчитування не буде перевищувати одиниці цього числа.
Одним з таких кодів є код Грея. Це непозиційний код, вага одиниці якого не визначається номером розряду. У цих кодах спостерігається симетричність відносно деякої осі відбиття – тобто ідентичність молодших розрядів. Звідси - “рефлексний код” (reflect – відбивати). У коді Грея вага одиниці у j-му розряді по абсолютній величині визначається формулою
Wj= EMBED Equation.3
Причому знак сумованих членів додатній для всіх непарних одиниць в числі (записаних у коді Грея зліва направо) і від’ємний для всіх парних
[1101101]г= EMBED Equation.3 - EMBED Equation.3 - EMBED Equation.3 + EMBED Equation.3 + EMBED Equation.3
=64+32+16+8+4+2+1-32-16-8-4-2-1-8-4-2-1+4+2+1+1=57
двійковий код код Грея двійковий код код Грея
0 0000 0000 8 1000 1100
1 0001 0001 9 1001 1101
2 0010 0011 10 1010 1111
3 0011 0010 11 1011 1110
4 0100 0110 12 1100 1010
5 0101 0111 13 1101 1011
6 0110 0101 14 1110 1001
7 0111 0100 15 1111 1000
Оптимальне (ефективне) кодування.
Ентропія джерела повідомлень визначається формулою
EMBED Equation.3 EMBED Equation.3 EMBED Equation.3 EMBED Equation.3
де: EMBED Equation.3 - ймовірність появи xi з N символів алфавіту джерела. N – об’єм алфавіту джерела.
Теорема Шенона для каналу без завад: в каналі зв’язку без завад можна так перетворити послідовність символів джерела, що середня довжина символів коду буде як завгодно близька до ентропії джерела повідомлень.
Ентропія H(x) виступає кількісною мірою різноманітності повідомлень джерела і є його основною характеристикою. Ентропія джерела максимальна, якщо ймовірності повідомлень є рівними. Якщо одне повідомлення достовірне, а інші неможливі, то H(x)=0. Одиниця виміру ентропії – 1 біт. Це та невизначеність, коли джерело має однакову ймовірність двох можливих повідомлень (0 або 1).
Ентропія H(x) визначає середню кількість двійкових знаків, необхідних для кодування початкових символів джерела. Наприклад, для російських букв n=32=25. Якщо вони подаються рівномірно і незалежні між собою, то H(x)<5. Для російського літературного тексту H(x)=1.5 біт, для віршів H(x)=1 біт, а для телеграм H(x)=0.8 біт. Це означає, що при певному способі кодування на передачу букви може бути затрачено відповідно 1.5, 1, 0.8 двійкових символів.
Якщо символи нерівноімовірні і залежні, то ентропія буде менша від свого максимального значення Нmax(x)=log2N. При цьому можливе деяке більш економне (ефективне) кодування, при якому на кожен символ буде в середньому затрачено n*=H(x) символів коду. Коефіцієнт надлишковості визначається такою формулою
Кнадл=1-H(x)/Hmax(x)
Для характеристики досягнутого стиснення використовують коефіцієнт стиснення
Кстисн=Lпочат/Lстисн
Можна показати, що Кнадл>Кстисн.
Різні методи оптимального кодування базуються на зменшенні надлишковості викликаної неоднаковою апріорною ймовірностю символів або залежністю між порядком надходження символів.
В першому випадку для кодування використовується нерівномірний код - більш ймовірні символи мають коротший код, а менш ймовірні – довший.
В другому випадку переходять від кодування окремих символів до кодування їх груп. При цьому здійснюється укрупнення алфавіту джерела, через те N зростає. Загальна надлишковість укрупненого алфавіту при цьому не міняється. Однак, зменшення надлишковості обумовлене зменшенням різниці ймовірностей різних груп символів. Таким чином, процес кодування зводиться до двох операцій: укрупнення алфавіту і кодування оптимальним нерівномірним кодом.
Стиснення буває із втратами і без втрат. Втрати допустимі при стисненні аудіо-та відеоінформації (наприклад, MPEG - 20 до 1; MPEG3 - 100 до 1; TIFF - 10до 1 при 10% втрат, 100 до 1 при 20% втрат і т.д.).
Метод Шеннона-Фано
В цьому методі для кожного символа формується бітовий код, довжина якого залежить від частоти появи символа. Чим менша частота, тим довший код. Визначення частоти (ймовірності) символа буває статичне (на основі таблиці даних) та динамічне (коли відомості про ймовірність появи символів визначаються на основі обробки потоку даних). Статичний варіант використовується в архіваторах 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гр=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, доки не об’єднаємо всі вершини.
Обходимо дерево і визначаємо розряди коду по такому правилу: перехід вліво – розряд =1, перехід вправо – розряд = 0 (рис.3).
Для програмної реалізації методу можна використати таку таблицю
a-30 11
b-20 10
c-20 00
d-10 010
e-5 0110
f-5 1111
g-2 0111
Рис. 3.
Програма стиснення методом Хаффмана
Program Lab22;
Uses Crt,Dos,Printer;
Type PCodElement = ^CodElement;
CodElement = record
NewLeft,NewRight,
P0, P1 : PCodElement;
LengthBiteChain : byte;
BiteChain : word;
CounterEnter : word;
Key : boolean;
Index : byte;
end;
TCodeTable = array [0..255] of PCodElement;
Var CurPoint,HelpPoint,
LeftRange,RightRange : PCodElement;
CodeTable : TCodeTable;
Root : PCodElement;
InputF, OutputF, InterF : file;
TimeUnPakFile : longint;
AttrUnPakFile : word;
NumRead, NumWritten: Word;
InBuf : array[0..10239] of byte;
OutBuf : array[0..10239] of byte;
BiteChain : word;
CRC,
CounterBite : byte;
OutCounter : word;
InCounter : word;
OutWord : word;
St : string;
LengthOutFile, LengthArcFile : longint;
Create : boolean;
NormalWork : boolean;
ErrorByte : byte;
DeleteFile : boolean;
{-------------------------------------------------}
procedure ErrorMessage;
begin
If ErrorByte <> 0 then
begin
Case ErrorByte of
2 : Writeln('File not found ...');
3 : Writeln('Path not found ...');
5 : Writeln('Access denied ...');
6 : Writeln('Invalid handle ...');
end;
NormalWork:=False;
ErrorByte:=0;
end;
end;
procedure ResetFile;
Var St : string;
begin
Assign(InputF, ParamStr(3));
Reset(InputF, 1);
ErrorByte:=IOResult;
ErrorMessage;
If NormalWork then Writeln('Pak file : ',ParamStr(3),'...');
end;
procedure ResetArchiv;
begin
St:=ParamStr(2);
If Pos('.',St)<>0 then Delete(St,Pos('.',St),4);
St:=St+'.vsg';
Assign(OutputF, St);
Reset(OutPutF,1);
Create:=False;
If IOResult=2 then
begin
Rewrite(OutputF, 1);
Create:=True;
end;
If NormalWork then
If Create then Writeln('Create archiv : ',St,'...')
else Writeln('Open archiv : ',St,'...')
end;
procedure SearchNameInArchiv;
begin
Seek(OutputF,FileSize(OutputF));
ErrorByte:=IOResult;
ErrorMessage;
end;
procedure DisposeCodeTable;
Var I : byte;
begin
For I:=0 to 255 do Dispose(CodeTable[I]);
end;
procedure ClosePakFile;
Var I : byte;
begin
If DeleteFile then Erase(InputF);
Close(InputF);
end;
procedure CloseArchiv;
begin
If FileSize(OutputF)=0 then Erase(OutputF);
Close(OutputF);
end;
procedure InitCodeTable;
Var I : byte;
begin
For I:=0 to 255 do
begin
New(CurPoint);
CodeTable[I]:=CurPoint;
With CodeTable[I]^ do
begin
P0:=Nil;
P1:=Nil;
LengthBiteChain:=0;
BiteChain:=0;
CounterEnter:=1;
Key:=True;
Index:=I;
end;
end;
For I:=0 to 255 do
begin
If I>0 then CodeTable[I-1]^.NewRight:=CodeTable[I];
If I<255 then CodeTable[I+1]^.NewLeft:=CodeTable[I];
end;
LeftRange:=CodeTable[0];
RightRange:=CodeTable[255];
CodeTable[0]^.NewLeft:=Nil;
CodeTable[255]^.NewRight:=Nil;
end;
procedure SortQueueByte;
Var Pr1,Pr2 : PCodElement;
begin
CurPoint:=LeftRange;
While CurPoint <> RightRange do
begin
If CurPoint^.CounterEnter > CurPoint^.NewRight^.CounterEnter then
begin
HelpPoint:=CurPoint^.NewRight;
HelpPoint^.NewLeft:=CurPoint^.NewLeft;
CurPoint^.NewLeft:=HelpPoint;
If HelpPoint^.NewRight<>Nil then HelpPoint^.NewRight^.NewLeft:=CurPoint;
CurPoint^.NewRight:=HelpPoint^.NewRight;
HelpPoint^.NewRight:=CurPoint;
If HelpPoint^.NewLeft<>Nil then HelpPoint^.NewLeft^.NewRight:=HelpPoint;
If CurPoint=LeftRange then LeftRange:=HelpPoint;
If HelpPoint=RightRange then RightRange:=CurPoint;
CurPoint:=CurPoint^.NewLeft;
If CurPoint = LeftRange then CurPoint:=CurPoint^.NewRight
else CurPoint:=CurPoint^.NewLeft;
end
else CurPoint:=CurPoint^.NewRight;
end;
end;
procedure CounterNumberEnter;
Var C : word;
begin
For C:=0 to NumRead-1 do
Inc(CodeTable[(InBuf[C])]^.CounterEnter);
end;
function SearchOpenCode : boolean;
begin
CurPoint:=LeftRange;
HelpPoint:=LeftRange;
HelpPoint:=HelpPoint^.NewRight;
While not CurPoint^.Key do
CurPoint:=CurPoint^.NewRight;
While (not (HelpPoint=RightRange)) and (not HelpPoint^.Key) do
begin
HelpPoint:=HelpPoint^.NewRight;
If (HelpPoint=CurPoint) and (HelpPoint<>RightRange) then
HelpPoint:=HelpPoint^.NewRight;
end;
If HelpPoint=CurPoint then SearchOpenCode:=False else SearchOpenCode:=True;
end;
procedure CreateTree;
begin
While SearchOpenCode do
begin
New(Root);
With Root^ do
begin
P0:=CurPoint;
P1:=HelpPoint;
LengthBiteChain:=0;
BiteChain:=0;
CounterEnter:=P0^.CounterEnter + P1^.CounterEnter;
Key:=True;
P0^.Key:=False;
P1^.Key:=False;
end;
HelpPoint:=LeftRange;
While (HelpPoint^.CounterEnter < Root^.CounterEnter) and
(HelpPoint<>Nil) do HelpPoint:=HelpPoint^.NewRight;
If HelpPoint=Nil then
begin
Root^.NewLeft:=RightRange;
RightRange^.NewRight:=Root;
Root^.NewRight:=Nil;
RightRange:=Root;
end
else
begin
Root^.NewLeft:=HelpPoint^.NewLeft;
HelpPoint^.NewLeft:=Root;
Root^.NewRight:=HelpPoint;
If Root^.NewLeft<>Nil then Root^.NewLeft^.NewRight:=Root;
end;
end;
end;
procedure ViewTree( P : PCodElement );
Var Mask,I : word;
begin
Inc(CounterBite);
If P^.P0<>Nil then ViewTree( P^.P0 );
If P^.P1<>Nil then
begin
Mask:=(1 SHL (16-CounterBite));
BiteChain:=BiteChain OR Mask;
ViewTree( P^.P1 );
Mask:=(1 SHL (16-CounterBite));
BiteChain:=BiteChain XOR Mask;
end;
If (P^.P0=Nil) and (P^.P1=Nil) then
begin
P^.BiteChain:=BiteChain;
P^.LengthBiteChain:=CounterBite-1;
end;
Dec(CounterBite);
end;
procedure CreateCompressCode;
begin
BiteChain:=0;
CounterBite:=0;
Root^.Key:=False;
ViewTree(Root);
end;
procedure DeleteTree;
Var P : PCodElement;
begin
CurPoint:=LeftRange;
While CurPoint<>Nil do
begin
If (CurPoint^.P0<>Nil) and (CurPoint^.P1<>Nil) then
begin
If CurPoint^.NewLeft <> Nil then
CurPoint^.NewLeft^.NewRight:=CurPoint^.NewRight;
If CurPoint^.NewRight <> Nil then
CurPoint^.NewRight^.NewLeft:=CurPoint^.NewLeft;
If CurPoint=LeftRange then LeftRange:=CurPoint^.NewRight;
If CurPoint=RightRange then RightRange:=CurPoint^.NewLeft;
P:=CurPoint;
CurPoint:=P^.NewRight;
Dispose(P);
end
else CurPoint:=CurPoint^.NewRight;
end;
end;
procedure SaveBufHeader;
Type
ByteField = array[0..6] of byte;
Const
Header : ByteField = ( $56, $53, $31, $00, $00, $00, $00 );
begin
If Create then
begin
Move(Header,OutBuf[0],7);
OutCounter:=7;
end
else
begin
Move(Header[3],OutBuf[0],4);
OutCounter:=4;
end;
end;
procedure SaveBufFATInfo;
Var I : byte;
St : PathStr;
R : SearchRec;
begin
St:=ParamStr(3);
For I:=0 to Length(St)+1 do
begin
OutBuf[OutCounter]:=byte(Ord(St[I]));
Inc(OutCounter);
end;
FindFirst(St,$00,R);
Dec(OutCounter);
Move(R.Time,OutBuf[OutCounter],4);
OutCounter:=OutCounter+4;
OutBuf[OutCounter]:=R.Attr;
Move(R.Size,OutBuf[OutCounter+1],4);
OutCounter:=OutCounter+5;
end;
procedure SaveBufCodeArray;
Var I : byte;
begin
For I:=0 to 255 do
begin
OutBuf[OutCounter]:=Hi(CodeTable[I]^.CounterEnter);
Inc(OutCounter);
OutBuf[OutCounter]:=Lo(CodeTable[I]^.CounterEnter);
Inc(OutCounter);
end;
end;
procedure CreateCodeArchiv;
begin
InitCodeTable;
CounterNumberEnter;
SortQueueByte;
SaveBufHeader;
SaveBufFATInfo;
SaveBufCodeArray;
CreateTree;
CreateCompressCode;
DeleteTree;
end;
procedure PakOneByte;
Var Mask : word;
Tail : boolean;
begin
CRC:=CRC XOR InBuf[InCounter];
Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHR CounterBite;
OutWord:=OutWord OR Mask;
CounterBite:=CounterBite+CodeTable[InBuf[InCounter]]^.LengthBiteChain;
If CounterBite>15 then Tail:=True else Tail:=False;
While CounterBite>7 do
begin
OutBuf[OutCounter]:=Hi(OutWord);
Inc(OutCounter);
If OutCounter=(SizeOf(OutBuf)-4) then
begin
BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
OutCounter:=0;
end;
CounterBite:=CounterBite-8;
If CounterBite<>0 then OutWord:=OutWord SHL 8 else OutWord:=0;
end;
If Tail then
begin
Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHL
(CodeTable[InBuf[InCounter]]^.LengthBiteChain-CounterBite);
OutWord:=OutWord OR Mask;
end;
Inc(InCounter);
If (InCounter=(SizeOf(InBuf))) or (InCounter=NumRead) then
begin
InCounter:=0;
BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
end;
end;
procedure PakFile;
begin
ResetFile;
SearchNameInArchiv;
If NormalWork then
begin
BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
OutWord:=0;
CounterBite:=0;
OutCounter:=0;
InCounter:=0;
CRC:=0;
CreateCodeArchiv;
While (NumRead<>0) do PakOneByte;
OutBuf[OutCounter]:=Hi(OutWord);
Inc(OutCounter);
OutBuf[OutCounter]:=CRC;
Inc(OutCounter);
BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
DisposeCodeTable;
ClosePakFile;
end;
end;
procedure ResetUnPakFiles;
begin
InCounter:=7;
St:='';
repeat
St[InCounter-7]:=Chr(InBuf[InCounter]);
Inc(InCounter);
until InCounter=InBuf[7]+8;
Assign(InterF,St);
Rewrite(InterF,1);
ErrorByte:=IOResult;
ErrorMessage;
If NormalWork then
begin
WriteLn('UnPak file : ',St,'...');
Move(InBuf[InCounter],TimeUnPakFile,4);
InCounter:=InCounter+4;
AttrUnPakFile:=InBuf[InCounter];
Inc(InCounter);
Move(InBuf[InCounter],LengthArcFile,4);
InCounter:=InCounter+4;
end;
end;
procedure CloseUnPakFile;
begin
If not NormalWork then Erase(InterF)
else
begin
SetFAttr(InterF,AttrUnPakFile);
SetFTime(InterF,TimeUnPakFile);
end;
Close(InterF);
end;
procedure RestoryCodeTable;
Var I : byte;
begin
InitCodeTable;
For I:=0 to 255 do
begin
CodeTable[I]^.CounterEnter:=InBuf[InCounter];
CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter SHL 8;
Inc(InCounter);
CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter+InBuf[InCounter];
Inc(InCounter);
end;
end;
procedure UnPakByte( P : PCodElement );
Var Mask : word;
begin
If (P^.P0=Nil) and (P^.P1=Nil) then
begin
OutBuf[OutCounter]:=P^.Index;
Inc(OutCounter);
Inc(LengthOutFile);
If OutCounter = (SizeOf(OutBuf)-1) then
begin
BlockWrite(InterF,OutBuf,OutCounter,NumWritten);
OutCounter:=0;
end;
end
else
begin
Inc(CounterBite);
If CounterBite=9 then
begin
Inc(InCounter);
If InCounter = (SizeOf(InBuf)) then
begin
InCounter:=0;
BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);
end;
CounterBite:=1;
end;
Mask:=InBuf[InCounter];
Mask:=Mask SHL (CounterBite-1);
Mask:=Mask OR $FF7F;
If Mask=$FFFF then UnPakByte(P^.P1)
else UnPakByte(P^.P0);
end;
end;
procedure UnPakFile;
begin
BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);
ErrorByte:=IOResult;
ErrorMessage;
If NormalWork then ResetUnPakFiles;
If NormalWork then
begin
RestoryCodeTable;
SortQueueByte;
CreateTree;
CreateCompressCode;
CounterBite:=0;
OutCounter:=0;
LengthOutFile:=0;
While LengthOutFile<LengthArcFile do
UnPakByte(Root);
BlockWrite(InterF,OutBuf,OutCounter,NumWritten);
DeleteTree;
DisposeCodeTable;
end;
CloseUnPakFile;
end;
{ ------------------------- main text ------------------------- }
begin
DeleteFile:=False;
NormalWork:=True;
ErrorByte:=0;
WriteLn;
ResetArchiv;
If NormalWork then
begin
St:=ParamStr(1);
Case St[1] of
'a','A' : PakFile;
'm','M' : begin
DeleteFile:=True;
PakFile;
end;
'e','E' : UnPakFile;
else ;
end;
end;
CloseArchiv;
end.
Програма методом Шеннона-Фано
Program Lab21;
CONST
N = 4096;
F = 18;
THRESHOLD = 2;
NUL = N * 2;
DBLARROW = $AF;
BUFSIZE = 1024;
InBufPtr : WORD = BUFSIZE;
InBufSize : WORD = BUFSIZE;
OutBufPtr : WORD = 0;
VAR
infile, outfile : File;
printcount, height, matchPos, matchLen, lastLen, printPeriod : WORD;
opt : BYTE;
TextBuf : Array[0.. N + F - 2] OF BYTE;
Left,Mom: Array [0..N] OF WORD;
Right: Array [0..N + 256] OF WORD;
codeBuf: Array [0..16] of BYTE;
Inbuf,OutBuf : Array[0..PRED(BUFSIZE)] of BYTE;
FUNCTION ReadChunk: WORD;
VAR
Actual : WORD;
BEGIN
BlockRead(InFile,InBuf,BUFSIZE,Actual);
ReadChunk := Actual;
END;
Procedure Getc; Assembler;
ASM
push bx
mov bx, inBufPtr
cmp bx, inBufSize
jb @getc1
push cx
push dx
push di
push si
call readchunk
pop si
pop di
pop dx
pop cx
mov inBufSize, ax
or ax, ax
jz @getc2 { ; EOF }
xor bx, bx
@getc1: mov al, [Offset InBuf + bx]
inc bx
mov inBufPtr, bx
pop bx
clc { ; clear the carry flag }
jmp @end
@getc2: pop bx
stc { ; set carry to indicate EOF }
@end:
END;
Procedure Writeout;
VAR
Actual : WORD;
BEGIN
BlockWrite(OutFile,OutBuf,OutBufPtr,Actual);
END;
PROCEDURE Putc; Assembler;
ASM
push bx
mov bx, outBufPtr
mov [OFFSet OutBuf + bx], al
inc bx
cmp bx, BUFSIZE
jb @putc1
mov OutBufPtr,BUFSIZE { Just so the flush will work. }
push cx
push dx
push di
push si
call writeOut
pop si
pop di
pop dx
pop cx
xor bx, bx
@putc1: mov outBufPtr, bx
pop bx
END;
PROCEDURE InitTree; Assembler;
ASM
cld
push ds
pop es
mov di, offset right
add di, (N + 1) * 2
mov cx, 256
mov ax, NUL
rep stosw
mov di, offset mom
mov cx, N
rep stosw
END;
PROCEDURE Splay; Assembler;
ASM
@Splay1: mov si, [Offset Mom + di]
cmp si, NUL
ja @Splay4
mov bx, [Offset Mom + si]
cmp bx, NUL
jbe @Splay5
cmp di, [Offset Left + si]
jne @Splay2
mov dx, [Offset Right + di]
mov [Offset Left + si], dx
mov [Offset Right + di], si
jmp @Splay3
@Splay2: mov dx, [Offset Left + di]
mov [Offset Right + si], dx
mov [Offset Left + di], si
@Splay3: mov [Offset Right + bx], di
xchg bx, dx
mov [Offset Mom + bx], si
mov [Offset Mom + si], di
mov [Offset Mom + di], dx
@Splay4: jmp @end
@Splay5: mov cx, [Offset Mom + bx]
cmp di, [Offset Left + si]
jne @Splay7
cmp si, [Offset Left + bx]
jne @Splay6
mov dx, [Offset Right + si]
mov [Offset Left + bx], dx
xchg bx, dx
mov [Offset Mom + bx], dx
mov bx, [Offset Right + di]
mov [Offset Left +si], bx
mov [Offset Mom + bx], si
mov bx, dx
mov [Offset Right + si], bx
mov [Offset Right + di], si
mov [Offset Mom + bx], si
mov [Offset Mom + si], di
jmp @Splay9
@Splay6: mov dx, [Offset Left + di]
mov [Offset Right + bx], dx
xchg bx, dx
mov [Offset Mom + bx], dx
mov bx, [Offset Right + di]
mov [Offset Left + si], bx
mov [Offset Mom + bx], si
mov bx, dx
mov [Offset Left + di], bx
mov [Offset Right + di], si
mov [Offset Mom + si], di
mov [Offset Mom + bx], di
jmp @Splay9
@Splay7: cmp si, [Offset Right + bx]
jne @Splay8
mov dx, [Offset Left + si]
mov [Offset Right + bx], dx
xchg bx, dx
mov [Offset Mom + bx], dx
mov bx, [Offset Left + di]
mov [Offset Right + si], bx
mov [Offset Mom + bx], si
mov bx, dx
mov [Offset Left + si], bx
mov [Offset Left + di], si
mov [Offset Mom + bx], si
mov [Offset Mom + si], di
jmp @Splay9
@Splay8: mov dx, [Offset Right + di]
mov [Offset Left + bx], dx
xchg bx, dx
mov [Offset Mom + bx], dx
mov bx, [Offset Left + di]
mov [Offset Right + si], bx
mov [Offset Mom + bx], si
mov bx, dx
mov [Offset Right + di], bx
mov [Offset Left + di], si
mov [Offset Mom + si], di
mov [Offset Mom + bx], di
@Splay9: mov si, cx
cmp si, NUL
ja @Splay10
cmp bx, [Offset Left + si]
jne @Splay10
mov [Offset Left + si], di
jmp @Splay11
@Splay10: mov [Offset Right + si], di
@Splay11: mov [Offset Mom + di], si
jmp @Splay1
@end:
END;
PROCEDURE InsertNode; Assembler;
ASM
push si
push dx
push cx
push bx
mov dx, 1
xor ax, ax
mov matchLen, ax
mov height, ax
mov al, byte ptr [Offset TextBuf + di]
shl di, 1
add ax, N + 1
shl ax, 1
mov si, ax
mov ax, NUL
mov word ptr [Offset Right + di], ax
mov word ptr [Offset Left + di], ax
@Ins1: inc height
cmp dx, 0
jl @Ins3
mov ax, word ptr [Offset Right + si]
cmp ax, NUL
je @Ins2
mov si, ax
jmp @Ins5
@Ins2: mov word ptr [Offset Right + si], di
mov word ptr [Offset Mom + di], si
jmp @Ins11
@Ins3: mov ax, word ptr [Offset Left + si]
cmp ax, NUL
je @Ins4
mov si, ax
jmp @Ins5
@Ins4: mov word ptr [Offset Left + si], di
mov word ptr [Offset Mom + di], si
jmp @Ins11
@Ins5: mov bx, 1
shr si, 1
shr di, 1
xor ch, ch
xor dh, dh
@Ins6: mov dl, byte ptr [Offset Textbuf + di + bx]
mov cl, byte ptr [Offset TextBuf + si + bx]
sub dx, cx
jnz @Ins7
inc bx
cmp bx, F
jb @Ins6
@Ins7: shl si, 1
shl di, 1
cmp bx, matchLen
jbe @Ins1
mov ax, si
shr ax, 1
mov matchPos, ax
mov matchLen, bx
cmp bx, F
jb @Ins1
@Ins8: mov ax, word ptr [Offset Mom + si]
mov word ptr [Offset Mom + di], ax
mov bx, word ptr [Offset Left + si]
mov word ptr [Offset Left + di], bx
mov word ptr [Offset Mom + bx], di
mov bx, word ptr [Offset Right + si]
mov word ptr [Offset Right + di], bx
mov word ptr [Offset Mom + bx], di
mov bx, word ptr [Offset Mom + si]
cmp si, word ptr [Offset Right + bx]
jne @Ins9
mov word ptr [Offset Right + bx], di
jmp @Ins10
@Ins9: mov word ptr [Offset Left + bx], di
@Ins10: mov word ptr [Offset Mom + si], NUL
@Ins11: cmp height, 30
jb @Ins12
call Splay
@Ins12: pop bx
pop cx
pop dx
pop si
shr di, 1
END;
PROCEDURE DeleteNode; Assembler;
ASM
push di
push bx
shl si, 1
cmp word ptr [Offset Mom + si], NUL
je @del7
cmp word ptr [Offset Right + si], NUL
je @del8
mov di, word ptr [Offset Left + si]
cmp di, NUL
je @del9
mov ax, word ptr [Offset Right + di]
cmp ax, NUL
je @del2
@del1: mov di, ax
mov ax, word ptr [Offset Right + di]
cmp ax, NUL
jne @del1
mov bx, word ptr [Offset Mom + di]
mov ax, word ptr [Offset Left + di]
mov word ptr [Offset Right + bx], ax
xchg ax, bx
mov word ptr [Offset Mom + bx], ax
mov bx, word ptr [Offset Left + si]
mov word ptr [Offset Left + di], bx
mov word ptr [Offset Mom + bx], di
@del2: mov bx, word ptr [Offset Right + si]
mov word ptr [Offset Right + di], bx
mov word ptr [Offset Mom + bx], di
@del3: mov bx, word ptr [Offset Mom + si]
mov word ptr [Offset Mom + di], bx
cmp si, word ptr [Offset Right + bx]
jne @del4
mov word ptr [Offset Right + bx], di
jmp @del5
@del4: mov word ptr [Offset Left + bx], di
@del5: mov word ptr [Offset Mom + si], NUL
@del7: pop bx
pop di
shr si, 1
jmp @end;
@del8: mov di, word ptr [Offset Left + si]
jmp @del3
@del9: mov di, word ptr [Offset Right + si]
jmp @del3
@end:
END;
PROCEDURE Encode; Assembler;
ASM
call initTree
xor bx, bx
mov [Offset CodeBuf + bx], bl
mov dx, 1
mov ch, dl
xor si, si
mov di, N - F
@Encode2: call getc
jc @Encode3
mov byte ptr [Offset TextBuf +di + bx], al
inc bx
cmp bx, F
jb @Encode2
@Encode3: or bx, bx
jne @Encode4
jmp @Encode19
@Encode4: mov cl, bl
mov bx, 1
push di
sub di, 1
@Encode5: call InsertNode
inc bx
dec di
cmp bx, F
jbe @Encode5
pop di
call insertNode
@Encode6: mov ax, matchLen
cmp al, cl
jbe @Encode7
mov al, cl
mov matchLen, ax
@Encode7: cmp al, THRESHOLD
ja @Encode8
mov matchLen, 1
or byte ptr codeBuf, ch
mov bx, dx
mov al, byte ptr [Offset TextBuf + di]
mov byte ptr [Offset CodeBuf + bx], al
inc dx
jmp @Encode9
@Encode8: mov bx, dx
mov al, byte ptr matchPos
mov byte ptr [Offset Codebuf + bx], al
inc bx
mov al, byte ptr (matchPos + 1)
push cx
mov cl, 4
shl al, cl
pop cx
mov ah, byte ptr matchLen
sub ah, THRESHOLD + 1
add al, ah
mov byte ptr [Offset Codebuf + bx], al
inc bx
mov dx, bx
@Encode9: shl ch, 1
jnz @Encode11
xor bx, bx
@Encode10: mov al, byte ptr [Offset CodeBuf + bx]
call putc
inc bx
cmp bx, dx
jb @Encode10
mov dx, 1
mov ch, dl
mov byte ptr codeBuf, dh
@Encode11: mov bx, matchLen
mov lastLen, bx
xor bx, bx
@Encode12: call getc
jc @Encode14
push ax
call deleteNode
pop ax
mov byte ptr [Offset TextBuf + si], al
cmp si, F - 1
jae @Encode13
mov byte ptr [Offset TextBuf + si + N], al
@Encode13: inc si
and si, N - 1
inc di
and di, N - 1
call insertNode
inc bx
cmp bx, lastLen
jb @Encode12
@Encode14: sub printCount, bx
jnc @Encode15
mov ax, printPeriod
mov printCount, ax
(* push dx { Print out a period as a sign. }
mov dl, DBLARROW
mov ah, 2
int 21h
pop dx *)
@Encode15: cmp bx, lastLen
jae @Encode16
inc bx
call deleteNode
inc si
and si, N - 1
inc di
and di, N - 1
dec cl
jz @Encode15
call insertNode
jmp @Encode15
@Encode16: cmp cl, 0
jbe @Encode17
jmp @Encode6
@Encode17: cmp dx, 1
jb @Encode19
xor bx, bx
@Encode18: mov al, byte ptr [Offset Codeb...
Ділись своїми роботами та отримуй миттєві бонуси!
0%
Оголошення від адміністратора