Курсовая работа: Сжатие данных методами Хафмана и Шеннона-Фано
Приложение 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
//с архивируемым файлом
Страницы: 1, 2, 3, 4, 5, 6, 7, 8 |
