следующий фpагмент (2)
Huffman - Сначала кажется что создание файла меньших размеров из исходного
без кодировки последовательностей или исключения повтора байтов
будет невозможной задачей. Но давайте мы заставим себя сделать несколько
умственных усилий и понять алгоритм Хаффмана ( Huffman ). Потеряв не так
много времени мы приобретем знания и дополнительное место на дисках.
Сжимая файл по алгоритму Хаффмана первое что мы должны сделать - это
необходимо прочитать файл полностью и подсчитать сколько раз встречается
каждый символ из расширенного набора ASCII. Если мы будем учитывать все
256 символов, то для нас не будет разницы в сжатии текстового и EXE файла.
После подсчета частоты вхождения каждого символа, необходимо просмотреть
таблицу кодов ASCII и сформировать мнимую компоновку между кодами по
убыванию. То есть не меняя местонахождение каждого символа из таблицы в
памяти отсортировать таблицу ссылок на них по убыванию. Каждую ссылку из
последней таблицы назовем "узлом". В дальнейшем ( в дереве ) мы будем позже
размещать указатели которые будут указывает на этот "узел". Для ясности
давайте рассмотрим пример:
Мы имеем файл длинной в 100 байт и имеющий 6 различных символов в
себе . Мы подсчитали вхождение каждого из символов в файл и получили
следующее :
------------------T-----T-----T-----T-----T-----T-----¬
¦ cимвол ¦ A ¦ B ¦ C ¦ D ¦ E ¦ F ¦
+-----------------+-----+-----+-----+-----+-----+-----+
¦ число вхождений ¦ 10 ¦ 20 ¦ 30 ¦ 5 ¦ 25 ¦ 10 ¦
L-----------------+-----+-----+-----+-----+-----+------
Теперь мы берем эти числа и будем называть их частотой вхождения
для каждого символа. Разместим таблицу как ниже.
------------------T-----T-----T-----T-----T-----T-----¬
¦ cимвол ¦ C ¦ E ¦ B ¦ F ¦ A ¦ D ¦
+-----------------+-----+-----+-----+-----+-----+-----+
¦ число вхождений ¦ 30 ¦ 25 ¦ 20 ¦ 10 ¦ 10 ¦ 5 ¦
L-----------------+-----+-----+-----+-----+-----+------
Мы возьмем из последней таблицы символы с наименьшей частотой. В нашем
случае это D (5) и какой либо символ из F или A (10), можно взять любой из
них например A.
Сформируем из "узлов" D и A новый "узел", частота вхождения для которого
будет равна сумме частот D и A :
Частота 30 10 5 10 20 25
Символа C A D F B E
¦ ¦
L--T---
-+-¬
¦15¦ = 5 + 10
L---
Номер в рамке - сумма частот символов D и A. Теперь мы снова ищем два
символа с самыми низкими частотами вхождения. Исключая из просмотра D и A и
рассматривая вместо них новый "узел" с суммарной частотой вхождения. Самая
низкая частота теперь у F и нового "узла". Снова сделаем операцию слияния
узлов :
Частота 30 10 5 10 20 25
Символа C A D F B E
¦ ¦ ¦
¦ ¦ ¦
¦ ---¬¦ ¦
L-+15+- ¦
LT-- ¦
¦ ¦
¦ ---¬ ¦
L----+25+-- = 10 + 15
L---
Рассматриваем таблицу снова для следующих двух символов ( B и E ).
Мы продолжаем в этот режим пока все "дерево" не сформировано, т.е. пока все
не сведется к одному узлу.
Частота 30 10 5 10 20 25
Символа C A D F B E
¦ ¦ ¦ ¦ ¦ ¦
¦ ¦ ¦ ¦ ¦ ¦
¦ ¦ ---¬¦ ¦ ¦ ¦
¦ L-+15+- ¦ ¦ ¦
¦ LT-- ¦ ¦ ¦
¦ ¦ ¦ ¦ ¦
¦ ¦ ---¬ ¦ ¦ ---¬ ¦
¦ L----+25+-- L-+45+--
¦ LT-- LT--
¦ ---¬ ¦ ¦
L----+55+------- ¦
L-T- ¦
¦ -------------¬ ¦
L---+ Root (100) +-----
L-------------
Теперь когда наше дерево создано, мы можем кодировать файл . Мы должны
всенда начнинать из корня ( Root ) . Кодируя первый символ (лист дерева С)
Мы прослеживаем вверх по дереву все повороты ветвей и если мы делаем левый
поворот, то запоминаем 0-й бит, и аналогично 1-й бит для правого поворота.
Так для C, мы будем идти влево к 55 ( и запомним 0 ), затем снова влево (0)
к самому символу . Код Хаффмана для нашего символа C - 00. Для следующего
символа ( А ) у нас получается - лево,право,лево,лево , что выливается в
последовательность 0100. Выполнив выше сказанное для всех символов получим
C = 00 ( 2 бита )
A = 0100 ( 4 бита )
D = 0101 ( 4 бита )
F = 011 ( 3 бита )
B = 10 ( 2 бита )
E = 11 ( 2 бита )
Каждый символ изначально представлялся 8-ю битами ( один байт ), и так
как мы уменьшили число битов необходимых для представления каждого символа,
мы следовательно уменьшили размер выходного файла . Сжатие складывется
следующим образом :
-----------T----------------T-------------------T--------------¬
¦ Частота ¦ первоначально ¦ уплотненные биты ¦ уменьшено на ¦
+----------+----------------+-------------------+--------------+
¦ C 30 ¦ 30 x 8 = 240 ¦ 30 x 2 = 60 ¦ 180 ¦
¦ A 10 ¦ 10 x 8 = 80 ¦ 10 x 3 = 30 ¦ 50 ¦
¦ D 5 ¦ 5 x 8 = 40 ¦ 5 x 4 = 20 ¦ 20 ¦
¦ F 10 ¦ 10 x 8 = 80 ¦ 10 x 4 = 40 ¦ 40 ¦
¦ B 20 ¦ 20 x 8 = 160 ¦ 20 x 2 = 40 ¦ 120 ¦
¦ E 25 ¦ 25 x 8 = 200 ¦ 25 x 2 = 50 ¦ 150 ¦
L----------+----------------+-------------------+---------------
Первоначальный размер файла : 100 байт - 800 бит;
Размер сжатого файла : 30 байт - 240 бит;
240 - 30% из 800 , так что мы сжали этот файл на 70%.
Все это довольно хорошо, но неприятность находится в том факте, что для
восстановления первоначального файла, мы должны иметь декодирующее дерево,
так как деревья будут различны для разных файлов . Следовательно мы должны
сохранять дерево вместе с файлом . Это превращается в итоге в увеличение
размеров выходного файла .
В нашей методике сжатия и каждом узле находятся 4 байта указателя,
по этому, полная таблица для 256 байт будет приблизительно 1 Кбайт длинной.
Таблица в нашем примере имеет 5 узлов плюс 6 вершин ( где и находятся
наши символы ) , всего 11 . 4 байта 11 раз - 44 . Если мы добавим после
небольшое количество байтов для сохранения места узла и некоторую другую
статистику - наша таблица будет приблизительно 50 байтов длинны.
Добавив к 30 байтам сжатой информации, 50 байтов таблицы получаем, что
общая длинна архивного файла вырастет до 80 байт . Учитывая , что
первоначальная длинна файла в рассматриваемом примере была 100 байт - мы
получили 20% сжатие информации.
Не плохо . То что мы действительно выполнили - трансляция символьного
ASCII набора в наш новый набор требующий меньшее количество знаков по
сравнению с стандартным.
Что мы можем получить на этом пути ?
Рассмотрим максимум которй мы можем получить для различных разрядных
комбинацй в оптимальном дереве, которое является несимметричным.
Мы получим что можно иметь только :
4 - 2 разрядных кода;
8 - 3 разрядных кодов;
16 - 4 разрядных кодов;
32 - 5 разрядных кодов;
64 - 6 разрядных кодов;
128 - 7 разрядных кодов;
Необходимо еще два 8 разрядных кода.
4 - 2 разрядных кода;
8 - 3 разрядных кодов;
16 - 4 разрядных кодов;
32 - 5 разрядных кодов;
64 - 6 разрядных кодов;
128 - 7 разрядных кодов;
--------
254
Итак мы имеем итог из 256 различных комбинаций которыми можно
кодировать байт . Из этих комбинаций лишь 2 по длинне равны 8 битам.
Если мы сложим число битов которые это представляет, то в итоге получим
1554 бит или 195 байтов. Так в максимуме , мы сжали 256 байт к 195 или 33%,
таким образом максимально идеализированный Huffman может достигать сжатия
в 33% когда используется на уровне байта .
Все эти подсчеты производились для не префиксных кодов Хаффмана т.е.
кодов, которые нельзя идентифицировать однозначно. Например код A - 01011 и
код B - 0101 . Если мы будем получать эти коды побитно, то получив биты 0101
мы не сможем сказать какой код мы получили A или B , так как следующий бит
может быть как началом следующего кода, так и продолжением предыдущего.
Необходимо добавить, что ключем к построению префиксных кодов служит
обычное бинарное дерево и если внимательно рассмотреть предыдущий пример
с построением дерева , можно убедится , что все получаемые коды там
префиксные.
Одно последнее примечание - алгоритм Хаффмана требует читать входной
файл дважды , один раз считая частоты вхождения символов , другой раз
производя непосредственно кодирование.
P.S. О "ключике" дающем дорогу алгоритму Running.
---- Прочитав обзорную информацию о Huffman кодировании подумайте
над тем, что на нашем бинарном дереве может быть и 257
листиков.
Литература :
------------
1) Описание архиватора Narc фирмы Infinity Design Concepts, Inc.;
2) Чарльз Сейтер,'Сжатие данных', "Мир ПК",N2 1991;
{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,655360}
{******************************************************}
{* Алгоритм уплотнения данных по методу *}
{* Хафмана. *}
{******************************************************}
Program Hafman;
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 ...');
8 : Writeln('Not enough memory ...');
10 : Writeln('Invalid environment ...');
11 : Writeln('Invalid format ...');
18 : Writeln('No more files ...');
else Writeln('Error #',ErrorByte,' ...');
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;
{ --- поиск в очереди пары открытых по Key минимальных значений --- }
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 { вставка перед HelpPoint }
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; { cортировка по возрастанию числа вхождений }
SaveBufHeader; { сохранить заголовок архива в буфере }
SaveBufFATInfo; { сохраняется FAT информация по файлу }
SaveBufCodeArray; { сохранить массив частот вхождений в архивном файле }
CreateTree; { создание дерева частот }
CreateCompressCode; { cоздание кода сжатия }
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;
WriteLn('ArcHaf version 1.0 (c) Copyright VVS Soft Group, 1992.');
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.
следующий фpагмент (3)|пpедыдущий фpагмент (1)
Смысл сжатия в том, что стpоится таблица частот (напpимеp, в тексте
только A...Z):
буква Q встpетилась 1625 pаз (вместо буквы как таковой может
A 1407 выступать любая последовательность)
G 890
........................
M 250
R 176
L 102
Y 76
Тепеpь эта таблица соpтиpуется по убыванию частот (уже сделано) и начинается
объединение гнезд: на пеpвом этапе будет некий новый элемент z1 = 102+76=178,
он встанет пеpед R:
z1 178
R 176 (число элементов на 1 меньше...)
Из него обpазуем z2 = 176+178 = 354, снова соpтиpуем по убыванию... И так до
одной-единственной веpшины-коpня. Тепеpь стpоим деpево, pаскpучивая пpоцесс
обpатно:
z_какое-то-там = SUM(frequencies)
0 / \ 1
znn (x1) z2(x2) <--- символы и частота
..................................
/ 0
z2(354)
0 / \ 1
R(176) z1(178)
0 / \ 1
Y(76) L(102) <--- как видишь, меньшее число у меня
идет налево, большее напpаво, но
можно и наобоpот.
Тепеpь осталось pазметить дуги этого гpафа битиками 0 и 1 (или 1 и 0 - т.е.
возможны два кода Хаффмэна), и мы имеем искомое. :-) Пpичем этот код очень
интеpесен тем, что не имеет пpефикса, т.е. ни один код какого-то символа
не может быть началом дpугого: если есть код ...011 (пусть это буква L), то
не может быть кода ...0110, ...0111011. Отсюда следует, что пpи кодиpовании
нам не надо записывать, сколько следующих битов пpедставляют собой код L -
код сам нам об этом скажет! Пpи кодиpовании достаточно бpать в табличке код
буывы (под буквой, конечно, может быть и последовательность какая) и сливать
все в поток, деля на байтики пpи записи. Пpи декодиpовании мы идем по деpеву,
пока не спустимся до листа, а там стоит буква. :-)
Все это звучит хоpошо, но есть и минусы - спеpва надо как-то пеpедать таблицу
кодиpовок получателю (1) и (2) надо читать файл дважды - пеpвый pаз набиpая
статистику, втоpой pаз собственно кодиpуя. Есть метод, позволяющий убить
2 зайцев pазом: и получатель, и отпpавитель начинают с pавномеpной таблицы
(веpоятности всех символов одинаковы) и коppектиpуют деpево (и код) по меpе
считывания символов. Звучит пpосто, но на пpактике тpебует изpядной возни по
пеpестановке поддеpевьев, так что 5 лет назад я это не делал. :-) Тем не
менее на наших текстах сляпанный за 2 мес. домоpощенный аpхивеp откусывал
около 40%. :-) Хотя и с хитpостью - был известен фоpмат и избыточные части
пpосто удалялись и вставлялись пpи pаспаковке. :-) Коpоче, комиссии хватило,
а сеpьезный аpхивеp - это годы pаботы...
Ilya Kusnetsov, 04 Jan 95 19:22
следующий фpагмент (4)|пpедыдущий фpагмент (2)
Функция Hform стpоит деpево и таблицу кодов по нему. Полное вpемя поиска кодов
Хаффмана не пpевышает 1.5 сек на IBM PC/XT (4.77MHz) для всех 256 символов с
ненулевыми частотами. Ее ассемблеpный ваpиант, пpавда не имеющий уже ничего
общего с пеpвоначальным после pучной оптимизации и pазумного пеpеосмысления, на
той же технике стpоит массив кодов ~ 0.2сек.
-----------------------------------------
const
MSN = 255; { Макс. число символов }
MaxNodeTree = MSN*2+2; { Число узлов дерева }
MaxSymbolsNumber :word = MSN; { Число символов для ст. Хаффмана }
Type
Huf_Cod=record { Код Хаффмана }
bstrin : word;
nbit : byte;
b : byte; { до 4 байт (* -> сдвиг) }
end;
DatTree=record { Узел дерева Хаффмана }
number : word;
bstrin : word;
left,right : integer;
nchar : word;
nbit : byte;
b1 : boolean; { до SizeOf=16. Тогда * -> сдвиг }
a1,a2 : word;
end;
----------------------------------------
Используется для постpоения деpева и кодов Хаффмана, потом копиpуется в Huf_Cod
с целью увеличения скоpости упаковки
----------------------------------------
DatTrees = array [0..MaxNodeTree] of DatTree; { Дерево Хаффмана }
frec = array [0..MSN] of word; { Массив частот }
Huf_Cods = array [0..MSN] of Huf_Cod; { Массив кодов Хаффмана }
function Hform(F:Frec; var HT : Huf_Cods):boolean;
{ Построение таблицы перекодировки. true - если успешно }
type rec=record
i1,i2 : word;
end;
var
i,j : word;
r : rec;
im : array [1..2] of word absolute r;
items : word;
overbit : boolean;
HTab : DatTrees;
w : DatTree;
function find2:boolean;
var Ct : byte;
begin
r.i2:=$FFFF;
for Ct:=1 to 2 do begin
if i<=MaxSymbolsNumber then begin
if j<Items then begin
if HTab[i].Number<=HTab[j].Number then begin
Im[Ct]:=i; inc(i)
end else begin
Im[Ct]:=j; inc(j)
end
end else begin
Im[Ct]:=i; inc(i)
end
end else begin
if j<Items then begin
Im[Ct]:=j; inc(j)
end
end;
end;
find2:=r.i2<$FFFF;
end;
procedure haddbit(item,bit:integer);
begin
with htab[item] do begin
bstrin:=(bstrin shl 1) or (bit and 1);
inc(nbit);
if nbit > 16 then overbit:=true
end
end;
procedure hsetb(item:integer);
begin
with htab[item] do
if left>=0 then begin
htab[left].bstrin:=bstrin; htab[right].bstrin:=bstrin;
htab[left].nbit:=nbit; htab[right].nbit:=nbit;
haddbit(left,1); hsetb(left); haddbit(right,0); hsetb(right)
end
end;
procedure Sort(l,r:integer);
var i,j : integer;
x,nc : word;
begin
i:=l; j:=r; x:=(l+r) div 2;
nc:=HTab[x].NChar; x:=HTab[x].Number;
repeat
while (HTab[i].Number < x) or
((HTab[i].Number=x) and (HTab[i].NChar < nc)) do inc(i);
while (HTab[j].Number > x) or
((HTab[j].Number=x) and (HTab[j].NChar > nc)) do dec(j);
if (i<=j) then begin
w:=HTab[i]; HTab[i]:=HTab[j]; HTab[j]:=w;
inc(i); dec(j)
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin
{ Инициализация дерева }
FillChar(htab, SizeOf(htab),#0);
For i:=0 to MaxSymbolsNumber do with htab[i] do begin
left:=-1; right:=-1; number:=f[i]; nchar:=i;
end;
For i:=MaxSymbolsNumber+1 to MaxNodeTree do with htab[i] do begin
left:=-1; right:=-1
end;
Sort(0,MaxSymbolsNumber);
items:=MaxSymbolsNumber+1; overbit:=false;
i:=0; j:=Items;
while HTab[i].Number=0 do inc(i);
while find2 do
with htab[items] do begin
number:=htab[r.i1].number+htab[r.i2].number;
left:=r.i1; right:=r.i2;
inc(items)
end;
hsetb(items-1);
for i:=0 to MaxSymbolsNumber do
with HTab[i] do begin
HT[nchar].BStrin:=BStrin; HT[nchar].nbit:=nbit
end;
HForm:=overbit;
end;
следующий фpагмент (5)|пpедыдущий фpагмент (3)
-->=8------------------------------------------------------ encode.c
/*
* Static 2-pass Huffman encoding.
* Basic realisation.
* (c) 1994, Rick Murray
*
* Usage:
*
* 1. counting all characters in area and place numbers
* for every ASCII value in char_count[] array.
* (for example: while((ch = getc(file))!=EOF) ++char_count[ch];
* 2. rewind to top of area.
* 3. use encode().
*/
#include <stdio.h>
#include <stdlib.h>
unsigned char_count[512]; /* Frequences of characters table */
int heap[512]; /* Sorting heap */
int father[512]; /* Tree pointers */
int mask[256]; /* Bit mask for every character */
char mlen[256]; /* Mask length for every mask */
int heap_size; /* Length of heap */
/* Quick-sorting the heap
*/
sort_heap(left,right)
int left, right;
{
int i,j,w,x;
if(left >= right) return;
i = left; j = right;
x = heap[(left + right) / 2];
do{
while(char_count[heap[i]] < char_count[x]) ++i;
while(char_count[x] < char_count[heap[j]]) --j;
if(i <= j){
w = heap[i]; heap[i] = heap[j]; heap[j] = w; ++i; --j;
}
} while(i <= j);
if(left < j) sort_heap(left,j);
if(i < right) sort_heap(i,right);
}
/* Building huffman encoding tree. At first - fill the heap
for used characters, then resort this and build tree in
father[]. Filling bit-mask array. May be up to 512 bytes.
*/
make_tree()
{
int index,i,tail;
heap_size = 0;
for(index=0; index < 256; ++index)
if(char_count[index])
heap[heap_size++] = index;
while(heap_size > 1){
sort_heap(0,heap_size-1);
index = heap_size+255;
char_count[index] = char_count[heap[0]] + char_count[heap[1]];
father[heap[0]] = index;
father[heap[1]] = -index;
heap[0] = index;
heap[1] = heap[--heap_size];
}
for(i=0; i<256; ++i){
mlen[i] = 0; mask[i] = 0; tail = i;
while(tail = father[abs(tail)])
mask[i] |= (tail > 0 ? 1 : 0) << mlen[i]++;
if(mlen[i] > 16) exit(-1);
}
}
/* Encoding. Just get bit mask and send'em
* to output stream for every input byte
*/
encode(in,out)
int (*in)();
int (*out)();
{
int inbyte, outbyte;
int i, bit;
outbyte = 0; bit = 7;
while(in(&inbyte)){
inbyte &= 0xFF;
for(i=mlen[inbyte]-1; i>=0; --i){
outbyte |= (((mask[inbyte] >> i) & 1) << bit);
if(--bit < 0){
out(outbyte);
outbyte = 0; bit = 7;
}
}
}
if(bit) out(outbyte);
}
-->=8------------------------------------------------------ decode.c
/*
* Static Huffman decoding.
* Basic realisation.
* (c) 1994, Rick Murray
*
* For restoring Huffman tree used mask[] and mlen[] array
* whuch was build with make_tree() procedure from encoder.
* You must fill mask[] and mlen[] before decode() calling.
*
*/
#include <stdio.h>
#include <stdlib.h>
int father[512]; /* Tree pointers */
int mask[256]; /* Bit mask for every character */
char mlen[256]; /* Mask length for every mask */
/* Build decoding tree using source bit-mask. Tree placed in
* father[] array, every 2-bytes is the tree node with left [0],
* and right [1] branch. For branch detection used bit accepted from
* bit mask. Tails of branches stoped with real byte code with negative
* sign.
*/
restore_tree()
{
int i, index, bit, ptr;
for(i=0; i<512; ++i) father[i] = 0;
index = 0;
for(i=0; i<256; ++i){
if(mlen[i]){
ptr = 0;
for(bit = mlen[i]-1; bit > 0; --bit){
if(!father[ptr + ((mask[i] >> bit) & 1)])
father[ptr + ((mask[i] >> bit) & 1)] = (index += 2);
ptr = father[ptr + ((mask[i] >> bit) & 1)];
}
father[ptr + ((mask[i] >> bit) & 1)] = -i;
}
}
}
/* Decode input stream using decoding tree. Just walk throw tree
* using accepted bit as adder for left/right branch definition.
*/
decode(in,out)
int (*in)();
int (*out)();
{
int inbyte;
int ptr, bit;
ptr = 0;
while(in(&inbyte)){
for(bit = 0x80; bit; bit >>= 1){
if(father[ptr + ((inbyte & bit) != 0)] <= 0){
out(-father[ptr + ((inbyte & bit) != 0)]);
ptr = 0;
}
else
ptr = father[ptr + ((inbyte & bit) != 0)];
}
}
}