DEMO.DESIGN
Frequently Asked Questions
 
оглавление | demo party в ex-СССР | infused bytes e-mag | новости от ib/news | другие проекты | письмо | win koi lat

следующий ф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)]; } } }

Всего 4 фpагмент(а/ов) |пpедыдущий фpагмент (4)

Если вы хотите дополнить FAQ - пожалуйста пишите.

design/collection/some content by Frog,
DEMO DESIGN FAQ (C) Realm Of Illusion 1994-2000,
При перепечатке материалов этой страницы пожалуйста ссылайтесь на источник: "DEMO.DESIGN FAQ, http://www.enlight.ru/demo/faq".