Кодирование Шеннона-Фано

Первый алгоритм сжатия, который мы рассмотрим - кодирование Шеннона-Фано, названное так по имени двух исследователей, которые одновременно и независимо друг от друга разработали этот алгоритм: Клода Шеннона (Claude Shannon) и Р. М. Фано (R. М. Fano). Алгоритм анализирует входные данные и на их основе строит бинарное дерево минимального кодирования. Используя это дерево, затем можно выполнить повторное считывание входных данных и закодировать их.

Чтобы проиллюстрировать работу алгоритма, выполним сжатие предложения "How much wood could a woodchuck chuck?" ("Сколько дров мог бы заготовить дровосек?") Прежде всего, предложение необходимо проанализировать. Просмотрим данные и вычислим, сколько раз в предложении встречается каждый символ. Занесем результаты в таблицу (см. таблицу 1.1).

Теперь разделим таблицу на две части, чтобы общее число появлений символов в верхней половине таблицы приблизительно равнялось общему числу появлений в нижней половине. Предложение содержит 38 символов, следовательно, верхняя половина таблицы должна отражать приблизительно 19 появлений символов. Это просто: достаточно поместить разделительную линию между строкой o и строкой u. В результате этого верхняя половина таблицы будет отражать появление 18 символов, а нижняя - 20. Таким образом, мы получаем таблицу 1.2.

 

Теперь проделаем то же с каждой из частей таблицы: вставим линию между строками так, чтобы разделить каждую из частей. Продолжим этот процесс, пока все буквы не окажутся разделенными одна от другой. Результирующее дерево Шеннона-Фано представлено в таблице 1.3.

Я намеренно изобразил разделительные линии различными по длине, чтобы разделительная линия 1 была самой длинной, разделительная линия 2 немного короче и так далее, вплоть до самой короткой разделительной линии 6. Этот подход обусловлен тем, что разделительные линии образуют повернутое на 90° бинарное дерево (чтобы убедиться в этом, поверните таблицу на 90° против часовой стрелки). Разделительная линия 1 является корневым узлом дерева, разделительные линии 2 - двумя его дочерними узлами и т.д. Символы образуют листья дерева. Результирующее дерево в обычной ориентации показано на рис.1.1

Все это очень хорошо, но как оно помогает решить задачу кодирования каждого символа и выполнения сжатия? Что ж, чтобы добраться до символа пробела, мы начинаем с коневого узла, перемещаемся влево, а затем снова влево. Чтобы добраться до символа c, мы смещаемся влево из корневого узла, затем вправо, а затем влево. Для перемещения к символу o потребуется сместиться влево, а затем два раза вправо. Если принять, что перемещение влево эквивалентно нулевому биту, а вправо - единичному, можно создать таблицу кодирования, приведенную в таблице 11.4.

 

Cодержит всего 131 бит. Если мы предполагаем, что исходная фраза закодирована кодом ASCII, т.е. один байт на символ, то оригинальная фраза заняла бы 256 байт, т.е. мы получаем коэффициент сжатия 54%.

Для декодирования сжатого потока битов мы строим то же дерево, которое было построено на этапе сжатия. Мы начинаем с корневого узла и выбираем из сжатого потока битов по одному биту. Если бит является нулевым, мы перемещаемся влево, если единичным - вправо. Мы продолжаем этот процесс до тех пор, пока не достигнем листа, т.е. символа, после чего выводим символ в поток восстановленных данных. Затем мы снова начинаем процесс с корневого узла дерева с целью извлечения следующего бита. Обратите внимание, что поскольку символы расположены только в листьях дерева, код одного символа не образует первую часть кода другого символа. Благодаря этому, неправильное декодирование сжатых данных невозможно. (Бинарное дерево, в котором данные размещены только в листьях, называется префиксным деревом (prefix tree).)

Однако при этом возникает небольшая проблема: как распознать конец потока битов? В конце концов, внутри класса мы будем объединять восемь битов в байт, после чего выполнять запись байта. Маловероятно, чтобы поток битов содержал количество битов строго кратное 8. Существует два возможных решения этой дилеммы. Первое - закодировать специальный символ, отсутствующий в исходных данных, и назвать его символом конца файла. Второе - записать в сжатый поток длину несжатых данных перед тем, как приступить к сжатию самих данных. Первое решение вынуждает нас найти отсутствующий в исходных данных символ и использовать его (это предполагает передачу этого символа в составе сжатых данных программе восстановления, чтобы она знала, что следует искать). Или же можно было бы принять, что хотя символы данных имеют размер, равный размеру одного байта, символ конца файла имеет длину, равную длину слова (и заданное значение, например 256). Однако мы будем использовать второе решение. Перед сжатыми данными мы будем сохранять длину несжатых данных, и таким образом во время восстановления будет в точности известно, сколько символов нужно декодировать.

Еще одна проблема применения кодирования Шеннона-Фано, на которую до сих пор мы не обращали внимания, связана с деревом. Обычно сжатие данных выполняется в целях экономии объема памяти или уменьшения времени передачи данных. Как правило, сжатие и восстановление данных разнесено во времени и пространстве. Однако алгоритм восстановления требует использования дерева. В противном случае невозможно декодировать закодированный поток. Нам доступны две возможности. Первая - сделать дерево статическим. Иначе говоря, одно и то же дерево будет использоваться для сжатия всех данных. Для некоторых данных результирующее сжатие будет достаточно оптимальным, для других весьма далеким от приемлемого. Вторая возможность состоит в том, чтобы тем или иным способом присоединить само дерево к сжатому потоку битов. Конечно, присоединение дерева к сжатым данным ведет к снижению коэффициента сжатия, но с этим ничего нельзя поделать.

Листинг программы осуществляющей сжатие данных методом Шеннона приведён в приложении 1.

 

Кодирование Хаффмана

Алгоритм кодирования Хаффмана очень похож на алгоритм сжатия Шеннона-Фано. Этот алгоритм был изобретен Девидом Хаффманом (David Huffman) в 1952 году ("A method for the Construction of Minimum-Redundancy Codes" ("Метод создания кодов с минимальной избыточностью")), и оказался еще более удачным, чем алгоритм Шеннона-Фано. Это обусловлено тем, что алгоритм Хаффмана математически гарантированно создает наименьший по размеру код для каждого из символов исходных данных.

Аналогично применению алгоритма Шеннона-Фано, нужно построить бинарное дерево, которое также будет префиксным деревом, где все данные хранятся в листьях. Но в отличие от алгоритма Шеннона-Фано, который является нисходящим, на этот раз построение будет выполняться снизу вверх. Вначале мы выполняем просмотр входных данных, подсчитывая количество появлений значений каждого байта, как это делалось и при использовании алгоритма Шеннона-Фано. Как только эта таблица частоты появления символов будет создана, можно приступить к построению дерева.

Будем считать эти пары символ-количество "пулом" узлов будущего дерева Хаффмана. Удалим из этого пула два узла с наименьшими значениями количества появлений. Присоединим их к новому родительскому узлу и установим значение счетчика родительского узла равным сумме счетчиков его двух дочерних узлов. Поместим родительский узел обратно в пул. Продолжим этот процесс удаления двух узлов и добавления вместо них одного родительского узла до тех пор, пока в пуле не останется только один узел. На этом этапе можно удалить из пула один узел. Он является корневым узлом дерева Хаффмана.

Описанный процесс не очень нагляден, поэтому создадим дерево Хаффмана для предложения "How much wood could a woodchuck chuck?" Мы уже вычислили количество появлений символов этого предложения и представили их в виде таблицы 11.1, поэтому теперь к ней потребуется применить описанный алгоритм с целью построения полного дерева Хаффмана. Выберем два узла с наименьшими значениями. Существует несколько узлов, из которых можно выбрать, но мы выберем узлы "m" и "?". Для обоих этих узлов число появлений символов равно 1. Создадим родительский узел, значение счетчика которого равно 2, и присоединим к нему два выбранных узла в качестве дочерних. Поместим родительский узел обратно в пул. Повторим цикл с самого начала. На этот раз мы выбираем узлы "a" и "1", объединяем их в мини-дерево и помещаем родительский узел (значение счетчика которого снова равно 2) обратно в пул. Снова повторим цикл. На этот раз в нашем распоряжении имеется единственный узел, значение счетчика которого равно 1 (узел "H") и три узла со значениями счетчиков, равными 2 (узел "к" и два родительских узла, которые были добавлены перед этим). Выберем узел "к", присоединим его к узлу "Н" и снова добавим в пул родительский узел, значение счетчика которого равно 3. Затем выберем два родительских узла со значениями счетчиков, равными 2, присоединим их к новому родительскому узлу со значением счетчика, равным 4, и добавим этот родительский узел в пул. Несколько первых шагов построения дерева Хаффмана и результирующее дерево показаны на рис. 1.2.

 

Используя это дерево точно так же, как и дерево, созданное для кодирования Шенона-Фано, можно вычислить код для каждого из символов в исходном предложении и построить таблицу 11.5.

Следует обратить внимание на то, что таблица кодов - не единственная возможная. Каждый раз, когда имеется три или больше узлов, из числа которых нужно выбрать два, существуют альтернативные варианты результирующего дерева и, следовательно, результирующих кодов. Но на практике все эти возможные варианты деревьев и кодов будут обеспечивать максимальное сжатие. Все они эквивалентны.

Повторим снова, что, как и при применении алгоритма Шеннона-Фано, необходимо каким-то образом сжать дерево и включить его в состав сжатых данных.

Восстановление выполняется совершенно так же, как при использовании кодирования Шеннона-Фано: необходимо восстановить дерево из данных, хранящихся в сжатом потоке, и затем воспользоваться им для считывания сжатого потока битов.

Листинг программы осуществляющей сжатие данных методом Хаффмана приведён в приложении 2.

На рис.2.1. Показан вид окна работающей программы.

Рис.2.1 Вид окна работающей программы

 

Выводы

В задании к курсовой работе была задана проверка работы программы по сжатию файлов формата .bmp и .xls. Сжав файлы этих форматов получил следующие результаты. Для .bmp формата рисунок 2.2. Для .xsl формата рисунок 2.3. Отсюда можно сделать вывод, что используя метод Хаффмана можно достичь большего коэффициента сжатия, чем по методу Шеннона. Для файлов типа .bmp коэффициент сжатия выше чем для .xls.

Рис.2.2. Результаты по сжатию одного и того же .bmp файла

 

Рис.2.2 Результаты по сжатию одного и того же .xls файла

 

Литература

1. Фундаментальные алгоритмы с структуры данных в Delphi: Пер. с англ. /Джулиан М. Бакнел. – СПб: ООО «ДиаСофтЮП», 2003.- 560 с.

2. Искусство дизассемблирования К.Касперски Е.Рокко, БХВ-Петербург 2008. -780 с.

3. Win32 API. Эффективная разработка приложений. – СПб.: Питер, 2007 – 572 с.: ил.

4. Жоголев Е.А. Ж.78 Технология программирования. – М., Научный Мир, 2004, 216 с.

5. Фундаментальные алгоритмы на C++. Анализ/Структуры данных/Сортировка/Поиск: Пер. с англ./Роберт Седжвик. - К.: Издательство «ДиаСофт», 2001.- 688 с.

6. Искусство программирования на Ассемблере. Лекции и упражнения: Голубь Н.Г. – 2-е изд., испр. и доп. – СПб: ООО «ДиаСофтЮП». 2002. – 656 с.

 

Приложение 1

Реализация на Delphi алгоритма сжатия Шеннона

Листинг программы с комментариями

unit Shannon;

interface

Uses

Forms, Dialogs;

const

Count=4096;

ArchExt='she';

dot='.';

//две файловые переменные для чтения исходного файла и для

//записи архива

var

FileToRead,FileToWrite: File;

Str1:String='';

// Процедуры для работы с файлом

// Первая - кодирование файла

procedure RunEncodeShan(FileName_: string);

// Вторая - декодирование файла

procedure RunDecodeShan(FileName_: string);

implementation

Type

//тип элемета для динамической обработки статистики байтов

TByte=^PByte;

PByte=Record

//Символ (один из символв ASCII)

Symbol: Byte;

//статистика символа

SymbolStat: Integer;

//последовательность битов, в которые преобразуется текущий

//элемент после работы древа (Кодовое слово) (в виде строки из "0" и "1")

CodWord: String;

//ссылки на левое и правое поддеревья (ветки)

left, right: TByte;

End;

//массив из символов со статистикой , т.е. частотой появления их

//в архивируемом файле

BytesWithStat = Array [0..255] of TByte;

//объект, включающий в себя:

// массив элементов содержащий в себе количество элементов,

// встречающихся в файле хотя бы один раз

// процедура инициализации объекта

// процедура для увеличения частоты i-го элемента

TStat =Object

massiv: BytesWithStat;

CountByte: byte;

Procedure Create;//процера инициализации обьекта

Procedure Inc(i: Byte);

End;

//процедура инициализации объекта вызввается из

Procedure TStat.Create;

var

i: Byte;

Begin

CountByte:=255;

For i:=0 to CountByte do

Begin

New(massiv[i]);//создаём динамическую переменную

//и устанавливаем указатель на неё

massiv[i]^.Symbol:=i;

massiv[i]^.SymbolStat:=0;

massiv[i]^.left:=nil;

massiv[i]^.right:=nil;

Application.ProcessMessages;//Высвобождаем ресурсы

//чтобы приложение не казалось зависшим, иначе все ресуры процессора

//будт задействованы на обработку кода приложения

End;

End;

// процедура для для вычисления частот появления

// i-го элемента в сжимаемом файле. Вызывается из

Procedure TStat.Inc(i: Byte);

Begin

massiv[i]^.SymbolStat:=massiv[i]^.SymbolStat+1;

End;

Type

//объект включающий в себя:

//имя и путь к архивируемому файлу

//размер архивируемого файла

//массив статистики частот байтов

//дерево частот байтов

//функцию генерации по имени файла имени архива

//функцию генерации по имени архива имени исходного файла

//функцию для определения размера файла без заголовка

//иными словами возвращающую смещение в архивном файле

//откуда начинаются сжатые данные

File_=Object

Name: String;

Size: Integer;

Stat: TStat;

Tree: TByte;

Function ArcName: String;

Function DeArcName: String;

Function FileSizeWOHead: Integer;

End;

// генерация по имени файла имени архива

Function File_.ArcName: String;

Var

i: Integer;

name_: String;

Const

PostFix=ArchExt;

Begin

name_:=name;

i:=Length(Name_);

While (i>0) And not(Name_[i] in ['/','\','.']) Do

Begin

Dec(i);

Application.ProcessMessages;

End;

If (i=0) or (Name_[i] in ['/','\'])

Then

ArcName:=Name_+'.'+PostFix

Else

If Name_[i]='.'

Then

Begin

Name_[i]:='.';

//Name_[i]:='!';

ArcName:=Name_+'.'+PostFix;

End;

End;

// генерация по имени архива имени исходного файла

Function File_.DeArcName: String;

Var

i: Integer;

Name_: String;

Begin

Name_:=Name;

if pos(dot+ArchExt,Name_)=0

Then

Begin

ShowMessage('Неправильное имя архива,'#13#10'оно должно заканчиваться на ".'+ArchExt+'"');

Application.Terminate;

End

Else

Begin

i:=Length(Name_);

While (i>0) And (Name_[i]<>'!') Do

Begin

Dec(i);

Application.ProcessMessages;

End;

If i=0

Then

Begin

Name_:=copy(Name_,1,pos(dot+ArchExt,Name_)-1);

If Name_=''

Then

Begin

ShowMessage('Неправильное имя архива');

Application.Terminate;

End

Else

DeArcName:=Name_;

End

Else

Begin

Name_[i]:='.';

Delete(Name_,pos(dot+ArchExt,Name_),4);

DeArcName:=Name_;

End;

End;

End;

Function File_.FileSizeWOHead: Integer;

Begin

FileSizeWOHead:=FileSize(FileToRead)-4-1-

(Stat.CountByte+1)*5;

//размер исходного файла записывается в 4 байтах

//количество оригинальных байт записывается в 1байте

//количество байтов со статистикой - величина массива

End;

//процедура сортировки массива с байтами (сортировка производится

//по убыванию частоты байта

procedure SortMassiv(var a: BytesWithStat; length_mass: byte);

var

i,j: Byte;

b: TByte;

Begin

if length_mass<>0

Then

for j:=0 to length_mass-1 do

Begin

for i:=0 to length_mass-1 do

Begin

If a[i]^.SymbolStat < a[i+1]^.SymbolStat

Then

Begin

b:=a[i]; a[i]:=a[i+1]; a[i+1]:=b;

End;

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

End;

{Процедура построения древа частот Shennon}

procedure CreateTree(var Root: TByte;massiv: BytesWithStat;

last: byte);

//процедуа деления группы

procedure DivGroup(i1, i2: byte);

{процедура создания кодовых слов. Вызывается после того как отработала процедура деления массива на группы. В полученном первом массиве мы ко всем одовым словам добавляем символ '0' во втором символ единицы}

procedure CreateCodWord(i1, i2: byte;Value:string);

var

i:integer;

begin

for i:=i1 to i2 do

massiv[i]^.CodWord:=massiv[i]^.CodWord+Value;

end;

//Процедуа деления массива

var

k, i : byte;

c, oldc, s, g1, g2 :Single;

begin

//Пограничное условие, чтобы рекурсия у нас

// не была бесконечной

if (i1<i2) then

begin

s := 0;

for i := i1 to i2 do

s := s + massiv[i]^.SymbolStat;//Суммируем статистику частот

//появления символов в файле

k := i1; //Далее инициализируем переменные

g1 := 0;

g2 := s;

c := g2 - g1;

{Алгоритм: Переменные i1 и i2 это индексы начального и соответственно конечного элемента массива в k будем вырабатывать индекс пограничного элемента массива по которому мы его будем делить. с переменная в кторой будет хранится разность между g2 и g1. Потребуется для определения k. Сначала суммируем статистику появления символов в файле (Она как ни странно будет равна размеру файла =: т.е. количеству байт в нём)). Далее инициализируем переменные.

Затем цикл в котором происходит следующее к g1 нулевая статистика прибавляем статстику massiv[k] элемента массива massiv[k], а из g2 вычитаем ту же статистику. Далее oldc:=c это нам надо для определения дошли мы до значения k где статистика обойх частей массива равна. c := abs(g2-g1) именно по модулю иначе у нас не выполнится условие (c >= oldc) в том случае когда (g2<g1). Далее проверяется условие c > oldc, если оно верно то мы уменьшаем k на единицу, если не то оставляем k какое есть это и будет значение элемента в котором сумм статистик масивов примерно равны. Далее просто рекурсивно вызываем Эту же процедуру пока массивы полностью не разделятся на одиночные элементы или листья }

repeat

g1 := g1 + massiv[k]^.SymbolStat;

g2 := g2 - massiv[k]^.SymbolStat;

oldc := c;

c := abs(g2-g1);

Inc(k);

until (c >= oldc) or (k = i2);

if c > oldc then

begin

Dec(k); //вырабатываем значение k2

end;

CreateCodWord(i1, k-1,'0'); //Заполняем первый массив

//элементами

CreateCodWord(k, i2,'1'); //Заполняем второй массив

//элементами

DivGroup(i1, k-1);//снова вызываем процедуру

//деления массива (первой части)

DivGroup(k, i2);// вызываем процедуру

end;

end;

begin

DivGroup(0,last);

end;

var

//экземпляр объекта для текущего сжимаемого файла

MainFile: file_;

//процедура для полного анализа частот байтов встречающихся хотя бы

//один раз в исходном файле

procedure StatFile(Fname: String);

var

f: file; //переменная типа file в неё будем писать

i,j: Integer;

buf: Array [1..count] of Byte;//массив=4кБ содержащий в

//себе часть архивируемого файла до 4кБ делается это для ускорения

//работы програмы

countbuf, lastbuf: Integer;//countbuf переменная которая показывает

//какое целое количество буферов=4кБ содержится в исходном файле

//для анализа частот символов встречающих в исходнлм файле

//lastbuf остаток байт которые неободимо будет проанализировать

Begin

AssignFile(f,fname);//связываем файловую переменню f

//с архивируемым файлом

Try

Reset(f,1);//открываем файл

MainFile.Stat.create;//вызываем метод инициализации объекта

//для архивируемого файла

MainFile.Size:=FileSize(f);//метод определения размера

// архивируемого файла

///////////////////////

countbuf:=FileSize(f) div count;//столько целых буферов

//по 4096 байт содержится в исходном файле

lastbuf:=FileSize(f) mod count; // остаток (последий буфер)разница

//в байтах до 4096

////////////

For i:=1 to countbuf do

Begin

BlockRead(f,buf,count);

for j:=1 to count do

Begin

MainFile.Stat.inc(buf[j]);

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

/////////////

If lastbuf<>0 //просчитываем статистику для оставшихся

//байт

Then

Begin

BlockRead(f,buf,lastbuf);

for j:=1 to lastbuf do

Begin

MainFile.Stat.inc(buf[j]);

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

CloseFile(f);

Except

ShowMessage('ошибка доступа к файлу!')

End;

End;

//процедура записи сжатого потока битов в архив

Procedure WriteInFile(var buffer: String);

var

i,j: Integer;

k: Byte;

buf: Array[1..2*count] of byte;

Begin

i:=Length(buffer) div 8; // узнаем сколько получится

//байт в каждой последовательности

//////////////////////////

For j:=1 to i do // работаем с байтами

Begin

buf[j]:=0;// обнуляем тот элемент мссива в

//который будем писать

///////////////////////////

For k:=1 to 8 do //работаем с битами

{находим в строке тот элемент который будем записывать в виде последовательности бит (будем просматривать с (j-1) элемента строки buffer восемь элментов за ним тем самым сформируется строка из восьми '0' и '1'. Эту строку мы будем преобразовывать в байт, который должен будет содержать такуюже последовательность бит)}

Begin

If buffer[(j-1)*8+k]='1'

Then

{Преобразование будем производить с помощью операции битового сдвига влево shl и логической опереоции или (or). Делается это так поверяется условие buffer[(j-1)*8+k]='1' если в выделенной строке из восьми символов (мы просматриваем её по циклу от первого элемента до восьмого), элемент, индекс которого равен счётчику цикла к, равен единице, то к соответствующему биту (номер которого в байте равен переменной цикла к) будет применена операция or (0 or 1=1) т.е. это бит примет значение 1. Если в строке будет ноль то и соответствующий бит будет равен нулю. (нам его не требуется устанавливать т.к. в начале работы с каждым байтом мы его обнуляем)}

buf[j]:=buf[j] or (1 shl (8-k));

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

BlockWrite(FileToWrite,buf,i);

Delete(buffer,1,i*8);

End;

//процедура для окончательной записи остаточной цепочки битов в архив

Procedure WriteInFile_(var buffer: String);

var

a,k: byte;

Begin

WriteInFile(buffer);

If length(buffer)>=8

Then

ShowMessage('ошибка в вычислении буфера')

Else

If Length(buffer)<>0

Then

Begin

a:=$FF;

for k:=1 to Length(buffer) do

If buffer[k]='0'

Then

a:=a xor (1 shl (8-k));

BlockWrite(FileToWrite,a,1);

End;

End;

Type

Integer_=Array [1..4] of Byte;

//перевод целого числа в массив из четырех байт.

Procedure IntegerToByte(i: Integer; var mass: Integer_);

var

a: Integer;

b: ^Integer_;

Begin

b:=@a;

a:=i;

mass:=b^;

End;

//перевод массива из четырех байт в целое число.

Procedure ByteToInteger(mass: Integer_; var i: Integer);

var

a: ^Integer;

b: Integer_;

Begin

a:=@b;

b:=mass;

i:=a^;

End;

//процедура создания заголовка архива

Procedure CreateHead;

var

b: Integer_;

//a: Integer;

i: Byte;

Begin

//Размер несжатого файла

IntegerToByte(MainFile.Size,b);

BlockWrite(FileToWrite,b,4);

//Количество оригинальных байт

BlockWrite(FileToWrite,MainFile.Stat.CountByte,1);

//Байты со статистикой

For i:=0 to MainFile.Stat.CountByte do

Begin

BlockWrite(FileToWrite,MainFile.Stat.massiv[i]^.Symbol,1);

IntegerToByte(MainFile.Stat.massiv[i]^.SymbolStat,b);

BlockWrite(FileToWrite,b,4);

End;

End;

const

MaxCount=4096;

type

buffer_=object

ArrOfByte: Array [1..MaxCount] of Byte;

ByteCount: Integer;

GeneralCount: Integer;

Procedure CreateBuf;

Procedure InsertByte(a: Byte);

Procedure FlushBuf;

End;

/////////////////////////////

Procedure buffer_.CreateBuf;

Begin

ByteCount:=0;

GeneralCount:=0;

End;

////////////////////////////////////////

Procedure buffer_.InsertByte(a: Byte); //в а передаём уже

// раскодированный символ котрый надо записать в файл

Begin

if GeneralCount<MainFile.Size

Then

Begin

inc(ByteCount);

inc(GeneralCount);

ArrOfByte[ByteCount]:=a;

//////////////////////////

if ByteCount=MaxCount

Then

Begin

BlockWrite(FileToWrite,ArrOfByte,ByteCount);

ByteCount:=0;

End;

End;

End;

////////////////////////////

Procedure Buffer_.FlushBuf; //сброс буфера

Begin

If ByteCount<>0

Then

BlockWrite(FileToWrite,ArrOfByte,ByteCount);

End;

//создание деархивированного файла

Procedure CreateDeArc;

var

i,j: Integer;

k: Byte;

//////////////

Buf: Array [1..Count] of Byte;

CountBuf, LastBuf: Integer;

MainBuffer: buffer_;

BufSearch:string;

{Процедура поиска символа, кторый соотвествуеткодовому слову которое передаётся вызывающей функцией как параметр.

Алгоритм: Вызывающая ф-ия CreateDeArc вырабатывает значение символа из разархивируемого файла и вызывает ф-ию SearchSymbol (Str:string); с параметром Str в котором находится выработанны символ. Ф-ия SearchSymbol прибавляет этот символ к строке Str1 в которой формируется кодовое слово}

Procedure SearchSymbol (Str:string);

var

v:integer;

SearchStr:String;//вспомогательная переменная в которую

//загоняются кодовые слова для сравнения их с Str1

a:byte;//переменная в которой будет находится найденный

//символ

begin

Str1:=Str1+Str;//растим кодовое слово

For v:=0 to MainFile.Stat.CountByte do

begin //производим поиск в массиве

SearchStr:=MainFile.Stat.massiv[v]^.CodWord ;

If (SearchStr=Str1) Then

begin

//если нашли то в а загоняем значение символа

a:=MainFile.Stat.massiv[v]^.Symbol;

//вызываем процедуру записи символа

MainBuffer.InsertByte(a);

//обнуляем строковую переменную

Str1:='';

//выходим из цикла

Break;

end;

end;

end;

Begin

BufSearch:='';{переменная в которой хранится выработанный символ, который будет передаватся в процедуру SearchSymbol}

CountBuf:=MainFile.FileSizeWOHead div count;

LastBuf:=MainFile.FileSizeWOHead mod count;

MainBuffer.CreateBuf;

For i:=1 to CountBuf do

Begin

BlockRead(FileToRead,buf,count);

for j:=1 to Count do

Begin

{Выделяем байт в массиве. По циклу от 1 до 8 просматриваем значения его бит c 8 до 1. Для этого используется операция битового сдвига влево shl и логиеская операция and.

В цикле всё происходит следующим образом: Сначала просматривается старший бит (8-к)=7 и производится логическая операция and, если бит равен 1 то (1 and 1)=1 и в BufSearch:='1', если же бит равен 0 и (0 and 1)=0 и в BufSearch:='1' }

for k:=1 to 8 do

Begin

If ((Buf[j] and (1 shl (8-k)))<>0 ) Then

begin

BufSearch:='1';

//вызываем процедуру SearchSymbol

SearchSymbol (BufSearch);

//обнуляем поисковую переменную

BufSearch:='';

end

Else

begin

BufSearch:=BufSearch+'0';

SearchSymbol (BufSearch);

BufSearch:='';

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

If LastBuf<>0

Then //аналогично вышесказанному

Begin

BlockRead(FileToRead,Buf,LastBuf);

for j:=1 to LastBuf do

Begin

for k:=1 to 8 do

Begin

If ((Buf[j] and (1 shl (8-k)))<>0 )

Then

begin

BufSearch:=BufSearch+'1';

SearchSymbol (BufSearch);

BufSearch:='';

end

Else

begin

BufSearch:=BufSearch+'0';

SearchSymbol (BufSearch);

BufSearch:='';

end;

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

End;

MainBuffer.FlushBuf;

End;

//процедура чтения заголовка архива

Procedure ReadHead;

var

b: Integer_;

SymbolSt: Integer;

count_, SymbolId, i: Byte;

Begin

try

//узнаем исходный размер файла

BlockRead(FileToRead,b,4);

ByteToInteger(b,MainFile.size);

//узнаем количество оригинальных байтов

BlockRead(FileToRead,count_,1);

{}{}{}

MainFile.Stat.create;

MainFile.Stat.CountByte:=count_;

//загоняем частоты в массив

for i:=0 to MainFile.Stat.CountByte do

Begin

BlockRead(FileToRead,SymbolId,1);

MainFile.Stat.massiv[i]^.Symbol:=SymbolId;

BlockRead(FileToRead,b,4);

ByteToInteger(b,SymbolSt);

MainFile.Stat.massiv[i]^.SymbolStat:=SymbolSt;

End;

CreateTree(MainFile.Tree,MainFile.stat.massiv,MainFile.Stat.CountByte);

/////////////

CreateDeArc;

//////////////

// DeleteTree(MainFile.Tree);

except

ShowMessage('архив испорчен!');

End;

End;

//процедура извлечения архива

Procedure ExtractFile;

Begin

AssignFile(FileToRead,MainFile.Name);

AssignFile(FileToWrite,MainFile.DeArcName);

try

Reset(FileToRead,1);

Rewrite(FileToWrite,1);

//процедура чтения шапки файла

ReadHead;

Closefile(FileToRead);

Closefile(FileToWrite);

Except

ShowMessage('Ошибка распаковки файла');

End;

End;

//вспомогательная процедура для создания архива

Procedure CreateArchiv;

var

buffer: String;

ArrOfStr: Array [0..255] of String;

i,j: Integer;

//////////////

buf: Array [1..count] of Byte;

CountBuf, LastBuf: Integer;

Begin

Application.ProcessMessages;

AssignFile(FileToRead,MainFile.Name);

AssignFile(FileToWrite,MainFile.ArcName);

Try

Reset(FileToRead,1);

Rewrite(FileToWrite,1);

For i:=0 to 255 Do ArrOfStr[i]:='';

For i:=0 to MainFile.Stat.CountByte do

Begin

ArrOfStr[MainFile.Stat.massiv[i]^.Symbol]:=

MainFile.Stat.massiv[i]^.CodWord;

Application.ProcessMessages;

End;

CountBuf:=MainFile.Size div Count;

LastBuf:=MainFile.Size mod Count;

Buffer:='';

/////////////

CreateHead;

/////////////

for i:=1 to countbuf do

Begin

BlockRead(FileToRead,buf,Count);

//////////////////////

For j:=1 to count do

Begin

buffer:=buffer+ArrOfStr[buf[j]];

If Length(buffer)>8*count

Then

WriteInFile(buffer);

Application.ProcessMessages;

End;

End;

If lastbuf<>0

Then

Begin

BlockRead(FileToRead,buf,LastBuf);

For j:=1 to lastbuf do

Begin

buffer:=buffer+ArrOfStr[buf[j]];

If Length(buffer)>8*count

Then

WriteInFile(buffer);

Application.ProcessMessages;

End;

End;

WriteInFile_(buffer);

CloseFile(FileToRead);

CloseFile(FileToWrite);

Except

ShowMessage('Ошибка создания архива');

End;

End;

//главная процедура для создания архивного файла

Procedure CreateFile;

var

i: Byte;

Begin

With MainFile do

Begin

{сортировка массива байтов с частотами}

SortMassiv(Stat.massiv,stat.CountByte);

{поиск числа задействованных байтов из таблицы возмжных символов. В count_byte будем хранить количество этох самых байт }

i:=0;//обнуляем счётчик

While (i<Stat.CountByte) //до тех пор пока счётчик

//меньше количества задействовнных байт CountByte

//и статистика байта (частота появления в файле)

//не равна нулю делаем

and (Stat.massiv[i]^.SymbolStat<>0) do

Begin

Inc(i); //увеличиваем счётчик на единицу

End;

//////////////////////

If Stat.massiv[i]^.SymbolStat=0 //если дошли до символа

//с нулевой встречаемостью в файле то

Then

Dec(i); //уменьшаем счётчик на единицу тоесть возвращаемся

//назад это будет последний элемент

//////////////////////

Stat.CountByte:=i;//присваиваем значение счётчика

//count_byte. Это означает что в архивируемом файле

//используется такое количество из 256 возможных

//символов. Будет исползоватся для построения древа частот

{создание дерева частот.

Передаём в процедуру начальные параметры Tree=nil-эта переменная будет содержать после работы процедуры древо ,Stat.massiv-массив с символами и соответствующей им статистикой,а так же указанием на правое и левой дерево, Stat. CountByte-количество используемых символов в архивирумом файле }

CreateTree(Tree,Stat.massiv,Stat.CountByte);

//пишем сам файл

CreateArchiv;

//Удаляем уже ненужное дерево

//DeleteTree(Tree);

//Инициализируем статистику файла

MainFile.Stat.Create;

End;

End;

procedure RunEncodeShan(FileName_: string);

begin

MainFile.Name:=FileName_;//передаём имя

//архивируемого файла в программу

StatFile(MainFile.Name); //запускем процедуру создания

//статистики (частоты появления того или иного символа)для файла

CreateFile; //вызов процедуры созданя архивного файла

end;

procedure RunDecodeShan(FileName_: string);

begin

MainFile.name:=FileName_;//передаём имя

//архивируемого файла в программу

ExtractFile;//Вызываем процедуру извлечения архива

end;

end.

 

Приложение 2.

Реализация на Delphi алгоритма сжатия Хафмана

unit Haffman;

interface

Uses

Forms,ComCtrls, Dialogs;

const

Count=4096;

ArchExt='haf';

dot='.';

//две файловые переменные для чтения исходного файла и для

//записи архива

var

FileToRead,FileToWrite: File;

ProgressBar1:TProgressBar;

// Процедуры для работы с файлом

// Первая - кодирование файла

procedure RunEncodeHaff(FileName_: string);

// Вторая - декодирование файла

procedure RunDecodeHaff(FileName_: string);

implementation

Type

{тип элемета для динамической обработки статистики символов

встречающихся в файле}

TByte=^PByte;

PByte=Record

//Символ (один из символв ASCII)

Symbol: Byte;

//частота появления символа в сжимаемом файле

SymbolStat: Integer;

//последовательность битов, в которые преобразуется текущий

//элемент после работы древа (Кодовое слово) (в виде строки из "0" и "1")

CodWord: String;

//ссылки на левое и правое поддеревья (ветки)

left, right: TByte;

End;

{массив из символов со статистикой , т.е. частотой появления их в архивируемом файле}

BytesWithStat = Array [0..255] of TByte;

{объект, включающий в себя:

массив элементов содержащий в себе количество элементов,

встречающихся в файле хотя бы один раз

процедура инициализации объекта

процедура для увеличения частоты i-го элемента}

TStat =Object

massiv: BytesWithStat;

CountByte: byte;

Procedure Create;//процедура инициализации обьекта

Procedure Inc(i: Byte);

End;

// процедура инициализации объекта вызывается из процедуры StatFile

Procedure TStat.Create; //(291)

var

i: Byte;

Begin //создаём массив симолв (ASCII), обнуляем статистику

//и ставим указатели в положение не определено

CountByte:=255;

For i:=0 to CountByte do

Begin

New(massiv[i]);//создаём динамическую переменную

//и устанавливаем указатель на неё

massiv[i]^.Symbol:=i;

massiv[i]^.SymbolStat:=0;

massiv[i]^.left:=nil;

massiv[i]^.right:=nil;

Application.ProcessMessages;//Высвобождаем ресурсы

//чтобы приложение не казалось зависшим, иначе все ресуры процессора

//будут задействованы на обработку кода приложения

End;

End;

{процедура для вычисления частот появления

i-го элемента в сжимаемом файле вызывается строка(310)}

Procedure TStat.Inc(i: Byte);

Begin //увеличиваем значение статистики символа [i] наединицу

massiv[i]^.SymbolStat:=massiv[i]^.SymbolStat+1;

End;

Type

//объект включающий в себя:

//имя и путь к архивируемому файлу

//размер архивируемого файла

//массив статистики частот байтов

//дерево частот байтов

//функцию генерации по имени файла имени архива

//функцию генерации по имени архива имени исходного файла

//функцию для определения размера файла без заголовка

//иными словами возвращающую смещение в архивном файле

//откуда начинаются сжатые данные

File_=Object

Name: String;

Size: Integer;

Stat: TStat;

Tree: TByte;

Function ArcName: String;

Function DeArcName: String;

Function FileSizeWOHead: Integer;

End;

// генерация по имени файла имени архива

Function File_.ArcName: String;

Var

i: Integer;

name_: String;

Const

PostFix=ArchExt;

Begin

name_:=name;

i:=Length(Name_);

While (i>0) And not(Name_[i] in ['/','\','.']) Do

Begin

Dec(i);

Application.ProcessMessages;

End;

If (i=0) or (Name_[i] in ['/','\'])

Then

ArcName:=Name_+'.'+PostFix

Else

If Name_[i]='.'

Then

Begin

Name_[i]:='.';

// Name_[i]:='!';

ArcName:=Name_+'.'+PostFix;

End;

End;

// генерация по имени архива имени исходного файла

Function File_.DeArcName: String;

Var

i: Integer;

Name_: String;

Begin

Name_:=Name;

if pos(dot+ArchExt,Name_)=0

Then

Begin

ShowMessage('Неправильное имя архива,'#13#10'оно должно заканчиваться на ".'+ArchExt+'"');

Application.Terminate;

End

Else

Begin

i:=Length(Name_);

While (i>0) And (Name_[i]<>'.') Do //до тех пор пока

//не встритится '.' !

Begin

Dec(i); //уменьшаем счётчик на единицу

Application.ProcessMessages;

End;

If i=0

Then

Begin

Name_:=copy(Name_,1,pos(dot+ArchExt,Name_)-1);

If Name_=''

Then

Begin

ShowMessage('Неправильное имя архива');

Application.Terminate;

End

Else

DeArcName:=Name_;

End

Else

Begin

Name_[i]:='.';

Delete(Name_,pos(dot+ArchExt,Name_),4);

DeArcName:=Name_;

End;

End;

End;

Function File_.FileSizeWOHead: Integer;

Begin

FileSizeWOHead:=FileSize(FileToRead)-4-1-

(Stat.CountByte+1)*5;

//размер исходного файла записывается в 4 байтах

//количество оригинальных байт записывается в 1байте

//количество байтов со статистикой - величина массива

End;

//процедура сортировки массива с байтами (сортировка производится

//по убыванию частоты байта (743)

procedure SortMassiv(var a: BytesWithStat; LengthOfMass: byte);

var

i,j: Byte; //счётчики циклов

b: TByte;

Begin //сортировка перестановкой

if LengthOfMass<>0

Then

for j:=0 to LengthOfMass-1 do

Begin

for i:=0 to LengthOfMass-1 do

Begin

If a[i]^.SymbolStat < a[i+1]^.SymbolStat

Then

Begin

b:=a[i]; a[i]:=a[i+1]; a[i+1]:=b;

End;

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

End;

//процедура удаления динамической структуры частотного дерева

//из памяти

Procedure DeleteTree(Root: TByte);

Begin

Application.ProcessMessages;

If Root<>nil

Then

Begin

DeleteTree(Root^.left);

DeleteTree(Root^.right);

Dispose(Root);

Root:=nil;

End;

End;

//создание дерева частот для архивируемого файла Haffman (777)

Procedure CreateTree(var Root: TByte; massiv: BytesWithStat;

last: byte);

var

Node: