303913 (Сжатие данных методами Хафмана и Шеннона-Фано), страница 4

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

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;//вызываем метод инициализации объекта

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

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

// архивируемого файла. Стандартная функция FileSize

//возвращает начение в байтах

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

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 //мы берём из буфера элемент от 1 до 4096 и с этими

//параметрами вызываем функцию Stat.inc(элемент)

//он же будет являтся и указателем на самого себя в

//в массиве символов там мы просто увеличиваем значение

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

MainFile.Stat.inc(buf[j]);//(строка 80)

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]);//(80)

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

CloseFile(f);//Закрываем файл

Except //Если чтото не так то выводим сообщение

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

End;

End;

{функция поиска в дереве Found(Tree: TByte; i: byte): Boolean;

параметры Tree:корень дерева или его узел, i:символ кодовое слово которого ищем; возвращает булево значение в функцию HSymbolToCodWord.

Алгоритм работы:

функция HSymbolToCodWord вызывает функцию Found(Tree^.left,i) т.е c параметром поиска в левой ветке дерева начиная от корня. Функция Found будет рекурсивно вызывать сама себя двигаясь по узлам дерева пока не дойдёт до искомого символа. Если там окажется искомый символ то Found вернёт true и в HSymbolToCodWord запишется первый нолик если Found(Tree^.left,i):true или единичка если Found(Tree^.right,i):true далее HSymbolToCodWord вызывает Found, но уже в параметрах указывается не корень, а седующий за ним узел, находящийся слева или справа, в зависимости от пред идущего результата поиска (в какой ветви от корня был найден символ(если слева его не было зачем там искать)) так будет продолжатся до тех пор пока HSymbolToCodWord не будет достигнут символ т.е. параметры функции будут Tree=узлу где находится символ (т.е. указатели на левую и правую ветви =nil)далее при выполнении функции она выработает значение для Tree=nil. Далее Found вернёт значение

Tree= узлу где нахоится искомый символ, выработает значение Found=True и вернётся в вызывающую функцию HSymbolToCodWord где в значение

HSymbolToCodWord в конец запишется '+'-означающий что кодовое слово найдено. Псле этого HSymbolToCodWord вернёт в вызвавшую её функциюSymbolToCodWord значение кодового слова+'+'на конце где произойдё проверка и символ '+' будет удалён, в вызывающий метод Stat.massiv[i]^.CodWord будет возвращено значение кодового слова}Function Found(Tree: TByte; i: byte): Boolean;

Begin

Application.ProcessMessages;

if (Tree=nil)//если древо nil то

Then

Found:=False //функция прекращает работу

Else //иначе

Begin //если указатель на левую часть древа или

//на правую nil, и указатель на символ равен счётчику

if ((Tree^.left=nil) or (Tree^.right=nil))

and (Tree^.Symbol=i)

Then

Found:=True {то функция возвращает флаг, что найден символ

и прекращает работу и возвращает в вызвавшую её функцию }

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

//т.е.рекурсивно вызывает сама себя с другими параметрами

Found:=Found(Tree^.left, i) or Found(Tree^.right, i);

End;

End;

//функция для определения строкового представления сжатой последовательности

//битов для исходного байта i

Function HSymbolToCodWord(Tree: TByte; i: Byte): String;

Begin

Application.ProcessMessages;

if (Tree=nil)

Then

HSymbolToCodWord:='+=='

Else

Begin

if (Found(Tree^.left,i))//если символ находится в левой ветви

//в зависимости от того что вернула Found

Then //то в строку добавляем символ нуля и вызываем HSymbolToCodWord

//от ниже лежащего левого узла

HSymbolToCodWord:='0'+HSymbolToCodWord(Tree^.left,i)

Else

Begin

if Found(Tree^.right,i)//если символ находится в правой ветви

Then //то в строку добавляем символ единицы и вызываем HSymbolToCodWord

//от ниже лежащего правого узла

HSymbolToCodWord:='1'+HSymbolToCodWord(Tree^.right,i)

Else //иначе

Begin //если найден символ

If (Tree^.left=nil) and (Tree^.right=nil)

and (Tree^.Symbol=i)

Then //HSymbolToCodWord //помечаем символ найден

HSymbolToCodWord:='+'

Else //иначе

HSymbolToCodWord:=''; //символа нет

End;

End;

End;

End;

//вспомогательная функция для определения Кодового слова

//сжатой последовательности битов для исходного байта i (с учетом

//того экстремального случая, когда исходный файл состоит всего из одного

//и того же символа)

Function SymbolToCodWord(Tree: TByte; i: Byte): String;

var

s: String;

Begin //Вызыаем ф-ию поиска кодовых слов

s:=HSymbolToCodWord(Tree, i);

s:=s;

If (s='+'){если функция HSymbolToCodWord вернула строку

содержащую '+' т.е. исходный файл состоит из одного и того же

символа то кодовому слову присваиваем строку из '0' }

Then

SymbolToCodWord:='0'

Else {иначе уменьшаем строку на один символ т.е. убираем '+'

признак того что символ найден}

SymbolToCodWord:=Copy(s,1,length(s)-1);

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//работаем с битами

Begin

If buffer[(j-1)*8+k]='1'{находим в строке тот элементкоторый будем записывать в виде последовательности бит(будем просматривать с (j-1) элемента строки buffer восемь элментов за ним тем самым сформируется строка из восьми '0' и '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

{Так как эту процедуру вызывает процедура которая передаёт в буфереотнюдь не один последний байт, то срау вызываем процедуруобычной записи в файл. После работы которой в buffer должнаостася последвательность из не более 8 символов. По этомумы производим проверку и если что то не так то выводим сообщение.

Иначе устанавливаем в переменной а все биты в 1 и далее производимследующие действия: Просматриваем по циклу всё что осталось вbuffer и если найдётся символ '0' то к сответтвующему биту переменной априменяем операцию xor (т.е. 1 xor 1 что даст 0) т.е. оответствующийбит установится в 0 все остальные биты переменной а останутся в том жесостоянии что и были. Оставшиеся биты будут единицами}

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;

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

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

var

a: Integer;

b: ^Integer_;

Begin

b:=@a;// соединяем адресс переменной а с b

a:=i;//в а перегоняем наше значение типа integer

mass:=b^;{разименовываем b и соединяем результат с massв результате работы этого кода число типа Integerперейд в массив из 4 байт. Это требуется для того что ,бы мызапись в файл производим по байтно}

End;

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

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

var

a: ^Integer;

b: Integer_;

Begin

a:=@b;// соединяем адресс переменной b с а

b:=mass;//b присваиваем значение mass

i:=a^;{разименовываем а и соединяем результат с i

в результате работы этого кода массив из 4 байтперейд в число типа Integer. Это требуется для того что бы мымогли узнать наши значения типа Integer}

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);

{зисываем байты со статистикой (на каждую запись требуется по пять байт. Первый байт содержит сам символ далее идут 4 байта со статистикой (Intege занимает 4 байта)}

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_ это объект включающий в себя массив из байт ArrOfByteсчётчик байт ByteCount (необходим для учёта промежуточнойзапися разархивируемых байт в файл)и основной счётчик (необходимдля отслеживани какое количество байт должно быть разархивированокак только он стнет равным размеру сжимаемого файла то процессразархивирования первётся)}

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 //до тех пор пока GeneralCount меньше