Сжатие данных методами Хафмана и Шеннона-Фано

Курсовой проект - Компьютеры, программирование

Другие курсовые по предмету Компьютеры, программирование

Скачать Бесплатно!
Для того чтобы скачать эту работу.
1. Пожалуйста введите слова с картинки:

2. И нажмите на эту кнопку.
закрыть



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

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

s