Подякувати Студентському архіву довільною сумою
Admin
26.02.2023 12:38
Дякуємо, що користуєтесь нашим архівом!
Оптимальне кодування
Інформація про навчальний заклад
ВУЗ:
Національний університет Львівська політехніка
Інститут:
Не вказано
Факультет:
КН
Кафедра:
Не вказано
Інформація про роботу
Рік:
2007
Тип роботи:
Звіт до лабораторної роботи
Предмет:
Методи i засоби комп'ютерних інформаційних технологій
Частина тексту файла (без зображень, графіків і формул):
Міністерство освіти і науки України
Національний університет „Львівська політехніка”
Кафедра САП
Звіт
до лабораторної роботи №2
на тему: „Оптимальне кодування”
З курсу : ”Методи та засоби комп”ютерних інформаційних технологій”
Теоретичні відомості
МЕТА РОБОТИ
Мета роботи – отримати практичні навики використання методів оптимального кодування.
Різновидності кодів.
По формі представлення в каналі передачі розрізняють послідовні і паралельні коди. При послідовних кодах елементарні сигнали, що передають кодову комбінацію посилаються в канал передачі послідовно в часі. Вони можуть бути розділені часовим інтервалом або опитуватися в певні моменти часу (наприклад, як у послідовному інтерфейсі RS - 232 C).
Для паралельних кодів потрібні багатопровідні канали, тому при передачі інфрмації на значну відстань вони використовуються рідко через великі затрати (наприклад, паралельний інтерфейс Centronics). Паралельне представлення найчастіше використовується коли потрібна висока швидкість передачі даних (Centronics – 80 – 120 Кбайт/сек, сучасні двонаправлені системи – до 250 Кбайт/сек).
По можливості виявлення та виправлення помилок розрізняють прості (примітивні) і коректуючі коди.
В простих кодах помилка у будь-якому елементі кодової комбінації приводить до неправильного прийому декодованого повідомлення.
Коректуючі коди дозволяють виявляти і усувати помилки у кодових комбінаціях.
По основних законах кодоутворення коди поділяються на комбінаторні (нечислові) і арифметичні (числові).
Комбінаторні коди будуються по законах теорії поєднань. Наприклад, код з m різних символів утворює кодові комбінації з n<m символів. Довжина коду постійна і рівна n, а можлива кількість кодових комбінацій
;
Наприклад, комбінації з 3 по 2: a, b, c =>ab, ac, bc.
Арифметичні (числові, цифрові) коди базуються на системах числення і найчастіше використовуються в технічних системах.
Рівномірні прості цифрові коди.
Системи числення, на основі яких будуються цифрові коди, поділяються на позиційні і непозиційні.
В позиційних сисмтемах значення символа залежить від його позиції в ряду символів, що утворюють число. В непозиційних – ні. В позиційних системах значення кожного наступного розряду більше від попереднього в m раз (m – основа системи чиселення).
При цьому будь-яке n-розрядне число може бути представлене у вигляді суми
де: lі - значення і-го розрядного коефіцієнта.
Кількість можливих значень lі рівна m (від 0 до m-1).
Приклад: чотирьохрозрядне десяткове число 4752=4*103+7*102+5*101+2*100.
Максимальна кількість кодових комбінацій Nmax=mn.
На практиці в технічних системах найчастіше використовуються двійкові коди
де: li = 0(1; Nmax = 2n;
N=2010=0*25+1*24+0*23+1*22+0*21+0*20 (0101002)
Двійковий код зручний для обробки машиною, однак для оператора громіздкий, тому використовують вісімкову або шістнадцяткову системи з основою рівною 23 і 2 4 відповідно.
N=(0248)= (0000101002)
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=
Причому знак сумованих членів додатній для всіх непарних одиниць в числі (записаних у коді Грея зліва направо) і від’ємний для всіх парних
[1101101]г=--++
=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
Оптимальне (ефективне) кодування.
Ентропія джерела повідомлень визначається формулою
де: - ймовірність появи 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гр
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, доки не об’єднаємо всі вершини.
Обходимо дерево і визначаємо розряди коду по такому правилу: перехід вліво – розряд =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
10.02.2013 23:02-
Ділись своїми роботами та отримуй миттєві бонуси!
0%
Оголошення від адміністратора