Реферат по предмету "Информатика, программирование"


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

Введение
Думая оданных, обычно мы представляем себе ни что иное, как передаваемую этими даннымиинформацию: список клиентов, мелодию на аудио компакт-диске, письмо и томуподобное. Как правило, мы не слишком задумываемся о физическом представленииданных. Заботу об этом — отображении списка клиентов, воспроизведениикомпакт-диска, печати письма — берет на себя программа, манипулирующая данными.
1. Представление данных
Рассмотримдвойственность природы данных: с одной стороны, содержимое информации, а сдругой — ее физическое представление. В 1950 году Клод Шеннон (Claude Shannon)заложил основы теории информации, в том числе идею о том, что данные могут бытьпредставлены определенным минимальным количеством битов. Эта величина получиланазвание энтропии данных (термин был заимствован из термодинамики). Шеннон установилтакже, что обычно количество бит в физическом представлении данных превышаетзначение, определяемое их энтропией.
В качествепростого примера рассмотрим исследование понятия вероятности с помощью монеты.Можно было бы подбросить монету множество раз, построить большую таблицурезультатов, а затем выполнить определенный статистический анализ этогобольшого набора данных с целью формулирования или доказательства какой-тотеоремы. Для построения набора данных, результаты подбрасывания монеты можнобыло бы записывать несколькими различными способами: можно было бы записыватьслова «орел» или «решка»; можно было бы записывать буквы«О» или «Р»; или же можно было бы записывать единственныйбит (например «да» или «нет», в зависимости от того, накакую сторону падает монета). Согласно теории информации, результат каждогоподбрасывания монеты можно закодировать единственным битом, поэтому последнийприведенный вариант был бы наиболее эффективным с точки зрения объема памяти,необходимого для кодирования результатов. С этой точки зрения первый вариантявляется наиболее расточительным, поскольку для записи результата единственногоподбрасывания монеты требовалось бы четыре или пять символов.
Однакопосмотрим на это под другим углом: во всех приведенных примерах записи данныхмы сохраняем одни и те же результаты — одну и ту же информацию — используя всеменьший и меньший объем памяти. Другими словами, мы выполняем сжатие данных.1.1.Сжатие данных
Сжатие данных(data compression) — это алгоритм эффективного кодирования информации, прикотором она занимает меньший объем памяти, нежели ранее. Мы избавляемся отизбыточности (redundancy), т.е. удаляем из физического представления данных тебиты, которые в действительности не требуются, оставляя только то количествобитов, которое необходимо для представления информации в соответствии созначением энтропии. Существует показатель эффективности сжатия данных:коэффициент сжатия (compression ratio). Он вычисляется путем вычитания изединицы частного от деления размера сжатых данных на размер исходных данных иобычно выражается в процентах. Например, если размер сжатых данных равен 1000бит, а несжатых — 4000 бит, коэффициент сжатия составит 75%, т.е. мы избавилисьот трех четвертей исходного количества битов.
Конечно,сжатые данные могут быть записаны в форме недоступной для непосредственногосчитывания и понимания человеком. Люди нуждаются в определенной избыточностипредставления данных, способствующей их эффективному распознаванию и пониманию.Применительно к эксперименту с подбрасыванием монеты последовательностисимволов «О» и «Р» обладают большей наглядностью, чем8-битовые значения байтов. (Возможно, что для большей наглядности пришлось быразбить последовательности символов «О» и «Р» на группы,скажем, по 10 символов в каждой.) Иначе говоря, возможность выполнения сжатияданных бесполезна, если отсутствует возможность их последующего восстановления.Эту обратную операцию называют декодированием (decoding).1.2 Типы сжатия
Существуетдва основных типа сжатия данных: с потерями (lossy) и без потерь (lossless).Сжатие без потерь проще для понимания. Это метод сжатия данных, когда привосстановлении данных возвращается точная копия исходных данных. Такой типсжатия используется программой PKZIB®1: распаковка упакованного файлаприводит к созданию файла, который имеет в точности то же содержимое, что иоригинал перед его сжатием. И напротив, сжатие с потерями не позволяет привосстановлении получить те же исходные данные. Это кажется недостатком, но дляопределенных типов данных, таких как данные изображений и звука, различие междувосстановленными и исходными данными не имеет особого значения: наши зрение ислух не в состоянии уловить образовавшиеся различия. В общем случае алгоритмысжатия с потерями обеспечивают более эффективное сжатие, чем алгоритмы сжатиябез потерь (в противном случае их не стоило бы использовать вообще). Дляпримера можно сравнить предназначенный для хранения изображений формат спотерями JPEG с форматом без потерь GIF. Множество форматов потокового аудио ивидео, используемых в Internet для загрузки мультимедиа-материалов, являютсяалгоритмами сжатия с потерями.
В случаеэкспериментов с подбрасыванием монеты было очень легко определить наилучшийспособ хранения набора данных. Но для других данных эта задача становится болеесложной. При этом можно применить несколько алгоритмических подходов. Двакласса сжатия, которые будут рассмотрены в этой главе, представляют собойалгоритмы сжатия без потерь и называются кодированием с минимальнойизбыточностью (minimumredundancy coding) и сжатиемс применением словаря (dictionary compression).
Кодирование сминимальной избыточностью — это метод кодирования байтов (или, более строго,символов), при котором чаще встречающиеся байты кодируются меньшим количествомбитов, чем те, которые встречаются реже. Например, в тексте на английском языкебуквы Е, Т и А встречаются чаще, нежели буквы Q, X и Z. Поэтому, если быудалось закодировать буквы Е, Т и А меньшим количеством битов, чем 8 (какдолжно быть в соответствии со стандартом ASCII), а буквы Q, X и Z — большим,текст на английском языке удалось бы сохранить с использованием меньшегоколичества битов, чем при соблюдении стандарта ASCII.
Прииспользовании сжатия с применением словаря данные разбиваются на большиефрагменты (называемые лексемами), чем символы. Затем применяется алгоритмкодирования лексем определенным минимальным количеством битов. Например, слова«the», «and» и «to» будут встречаться чаще, чемтакие слова, как «electric», «ambiguous» и«irresistible», поэтому их нужно закодировать меньшим количествомбитов, чем требовалось бы при кодировании в соответствии со стандартом ASCII.
2. Сжатие с минимальной избыточностью
Теперь, когдав нашем распоряжении имеется класс потока битов, им можно воспользоваться при рассмотренииалгоритмов сжатия и восстановления данных. Мы начнем с исследования алгоритмовкодирования с минимальной избыточностью, а затем рассмотрим более сложноесжатие с применением словаря.
Мы приведемподробное описание трех алгоритмов кодирования с минимальной избыточностью:кодирование Шеннона-Фано (Shannon-Fano), кодирование Хаффмана (Haffman) исжатие с применением скошенного дерева (splay tree compression), однакорассмотрим реализации только последних двух алгоритмов (алгоритм кодированияХаффмана ни в чем не уступает, а кое в чем даже превосходит алгоритмкодирования Шеннона Фано). При использовании каждого изэтих алгоритмов входные данные анализируются как поток байтов, и различнымзначениям байтов тем или иным способом присваиваются различныепоследовательности битов.2.1.Кодирование Шеннона-Фано
Первыйалгоритм сжатия, который мы рассмотрим — кодирование Шеннона-Фано, названноетак по имени двух исследователей, которые одновременно и независимо друг отдруга разработали этот алгоритм: Клода Шеннона (Claude Shannon) и Р. М. Фано(R. М. Fano). Алгоритм анализирует входные данные и на их основе строитбинарное дерево минимального кодирования. Используя это дерево, затем можновыполнить повторное считывание входных данных и закодировать их.
Чтобыпроиллюстрировать работу алгоритма, выполним сжатие предложения «How muchwood 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.
2.2.Кодирование Хаффмана
Алгоритмкодирования Хаффмана очень похож на алгоритм сжатия Шеннона-Фано. Этот алгоритмбыл изобретен Девидом Хаффманом (David Huffman) в 1952 году («A method forthe 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='';
// Процедуры для работы сфайлом
// Первая — кодирование файла
procedureRunEncodeShan(FileName_: string);
// Вторая — декодирование файла
procedureRunDecodeShan(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;
 ProcedureCreate;//процера инициализации обьекта
 ProcedureInc(i: Byte);
 End;
//процедура инициализацииобъекта вызввается из
 Procedure TStat.Create;
 var
 i: Byte;
 Begin
 CountByte:=255;
 For i:=0 toCountByte 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-го элемента всжимаемом файле. Вызывается из
 ProcedureTStat.Inc(i: Byte);
 Begin
 massiv[i]^.SymbolStat:=massiv[i]^.SymbolStat+1;
 End;
Type
 //объект включающий всебя:
 //имя и путь кархивируемому файлу
 //размер архивируемогофайла
 //массив статистикичастот байтов
 //дерево частот байтов
 //функцию генерации поимени файла имени архива
 //функцию генерации поимени архива имени исходного файла
 //функцию дляопределения размера файла без заголовка
 //иными словамивозвращающую смещение в архивном файле
 //откуда начинаютсясжатые данные
 File_=Object
 Name: String;
 Size:Integer;
 Stat: TStat;
 Tree: TByte;
 FunctionArcName: String;
 FunctionDeArcName: String;
 FunctionFileSizeWOHead: Integer;
 End;
 // генерация по именифайла имени архива
FunctionFile_.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
 IfName_[i]='.'
 Then
 Begin
 Name_[i]:='.';
 //Name_[i]:='!';
 ArcName:=Name_+'.'+PostFix;
 End;
 End;
 // генерация по имениархива имени исходного файла
FunctionFile_.DeArcName: String;
 Var
 i: Integer;
 Name_:String;
 Begin
 Name_:=Name;
 ifpos(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;
FunctionFile_.FileSizeWOHead: Integer;
 Begin
 FileSizeWOHead:=FileSize(FileToRead)-4-1-
 (Stat.CountByte+1)*5;
 //размер исходного файлазаписывается в 4 байтах
 //количествооригинальных байт записывается в 1байте
 //количество байтов состатистикой — величина массива
 End;
 //процедура сортировкимассива с байтами (сортировка производится
 //по убыванию частотыбайта
procedureSortMassiv(var a: BytesWithStat; length_mass: byte);
 var
 i,j: Byte;
 b: TByte;
 Begin
 iflength_mass0
 Then
 for j:=0 tolength_mass-1 do
 Begin
 for i:=0 tolength_mass-1 do
 Begin
 Ifa[i]^.SymbolStat
 Then
 Begin
 b:=a[i];a[i]:=a[i+1]; a[i+1]:=b;
 End;
 Application.ProcessMessages;
 End;
 Application.ProcessMessages;
 End;
 End;
 {Процедура построениядрева частот Shennon}
procedureCreateTree(var Root: TByte;massiv: BytesWithStat;
 last: byte);
//процедуа делениягруппы
procedureDivGroup(i1, i2: byte);
{процедура созданиякодовых слов. Вызывается после того как отработалапроцедура деления массива на группы. В полученном первом массиве мы ко всем одовым словам добавляем символ '0' во втором символ единицы}
procedureCreateCodWord(i1, i2: byte;Value:string);
 var
 i:integer;
begin
 for i:=i1 toi2 do
 massiv[i]^.CodWord:=massiv[i]^.CodWord+Value;
end;
//Процедуа делениямассива
var
k, i: byte;
c, oldc, s,g1, g2 :Single;
begin
 //Пограничное условие,чтобы рекурсия у нас
 // не была бесконечной
 if (i1
 begin
 s := 0;
 for i := i1to 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) modcount; // остаток (последий буфер)разница
 //в байтах до 4096
 ////////////
 For i:=1 tocountbuf do
 Begin
 BlockRead(f,buf,count);
 for j:=1 tocount do
 Begin
 MainFile.Stat.inc(buf[j]);
 Application.ProcessMessages;
 End;
 Application.ProcessMessages;
 End;
 /////////////
 If lastbuf0//просчитываем статистику для оставшихся
 //байт
 Then
 Begin
 BlockRead(f,buf,lastbuf);
 for j:=1 tolastbuf do
 Begin
 MainFile.Stat.inc(buf[j]);
 Application.ProcessMessages;
 End;
 Application.ProcessMessages;
 End;
 CloseFile(f);
 Except
 ShowMessage('ошибка доступа к файлу!')
 End;
End;
//процедура записисжатого потока битов в архив
ProcedureWriteInFile(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
 Ifbuffer[(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;
//процедура дляокончательной записи остаточной цепочки битов в архив
ProcedureWriteInFile_(var buffer: String);
var
 a,k: byte;
Begin
 WriteInFile(buffer);
 Iflength(buffer)>=8
 Then
 ShowMessage('ошибка в вычислении буфера')
 Else
 IfLength(buffer)0
 Then
 Begin
 a:=$FF;
 for k:=1 toLength(buffer) do
 Ifbuffer[k]='0'
 Then
 a:=a xor (1shl (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;
//перевод массива изчетырех байт в целое число.
ProcedureByteToInteger(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 toMainFile.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;
 ProcedureCreateBuf;
 ProcedureInsertByte(a: Byte);
 ProcedureFlushBuf;
 End;
 /////////////////////////////
 Procedurebuffer_.CreateBuf;
 Begin
 ByteCount:=0;
 GeneralCount:=0;
 End;
 ////////////////////////////////////////
Procedurebuffer_.InsertByte(a: Byte); //в а передаём уже
// раскодированный символкотрый надо записать в файл
 Begin
 ifGeneralCount
 Then
 Begin
 inc(ByteCount);
 inc(GeneralCount);
 ArrOfByte[ByteCount]:=a;
 //////////////////////////
 ifByteCount=MaxCount
 Then
 Begin
 BlockWrite(FileToWrite,ArrOfByte,ByteCount);
 ByteCount:=0;
 End;
 End;
 End;
 ////////////////////////////
ProcedureBuffer_.FlushBuf; //сброс буфера
 Begin
 IfByteCount0
 Then
 BlockWrite(FileToWrite,ArrOfByte,ByteCount);
 End;
//создание деархивированного файла
ProcedureCreateDeArc;
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 в которой формируетсякодовое слово}
ProcedureSearchSymbol (Str:string);
var
v:integer;
SearchStr:String;//вспомогательнаяпеременная в которую
//загоняются кодовыеслова для сравнения их с Str1
a:byte;//переменная вкоторой будет находится найденный
//символ
begin
 Str1:=Str1+Str;//растимкодовое слово
 For v:=0 to MainFile.Stat.CountBytedo
 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.FileSizeWOHeaddiv count;
 LastBuf:=MainFile.FileSizeWOHeadmod count;
 MainBuffer.CreateBuf;
 For i:=1 toCountBuf do
 Begin
 BlockRead(FileToRead,buf,count);
 for j:=1 toCount 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;
 IfLastBuf0
 Then //аналогично вышесказанному
 Begin
 BlockRead(FileToRead,Buf,LastBuf);
 for j:=1 toLastBuf do
 Begin
 for k:=1 to 8do
 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;
//процедура чтениязаголовка архива
ProcedureReadHead;
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 toMainFile.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;
//процедура извлечения архива
ProcedureExtractFile;
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 to255 Do ArrOfStr[i]:='';
 For i:=0 toMainFile.Stat.CountByte do
 Begin
 ArrOfStr[MainFile.Stat.massiv[i]^.Symbol]:=
 MainFile.Stat.massiv[i]^.CodWord;
 Application.ProcessMessages;
 End;
 CountBuf:=MainFile.Sizediv Count;
 LastBuf:=MainFile.Sizemod Count;
 Buffer:='';
 /////////////
 CreateHead;
 /////////////
 for i:=1 tocountbuf do
 Begin
 BlockRead(FileToRead,buf,Count);
 //////////////////////
 For j:=1 tocount do
 Begin
 buffer:=buffer+ArrOfStr[buf[j]];
 IfLength(buffer)>8*count
 Then
 WriteInFile(buffer);
 Application.ProcessMessages;
 End;
 End;
 Iflastbuf0
 Then
 Begin
 BlockRead(FileToRead,buf,LastBuf);
 For j:=1 tolastbuf do
 Begin
 buffer:=buffer+ArrOfStr[buf[j]];
 IfLength(buffer)>8*count
 Then
 WriteInFile(buffer);
 Application.ProcessMessages;
 End;
 End;
 WriteInFile_(buffer);
 CloseFile(FileToRead);
 CloseFile(FileToWrite);
 Except
 ShowMessage('Ошибка создания архива');
 End;
End;
//главная процедура длясоздания архивного файла
ProcedureCreateFile;
var
 i: Byte;
Begin
 With MainFiledo
 Begin
 {сортировка массивабайтов с частотами}
 SortMassiv(Stat.massiv,stat.CountByte);
 {поиск числа задействованных байтовиз таблицы возмжных символов. В count_byte будем хранить количество этох самыхбайт }
 i:=0;//обнуляем счётчик
 While (i
 //меньше количествазадействовнных байт CountByte
 //и статистика байта(частота появления в файле)
 //не равна нулю делаем
 and(Stat.massiv[i]^.SymbolStat0) do
 Begin
 Inc(i); //увеличиваемсчётчик на единицу
 End;
 //////////////////////
 IfStat.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;
procedureRunEncodeShan(FileName_: string);
begin
 MainFile.Name:=FileName_;//передаём имя
 //архивируемого файла в программу
 StatFile(MainFile.Name);//запускем процедуру создания
 //статистики (частотыпоявления того или иного символа)для файла
 CreateFile; //вызовпроцедуры созданя архивного файла
end;
procedureRunDecodeShan(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;
// Процедуры для работы сфайлом
// Первая — кодирование файла
procedureRunEncodeHaff(FileName_: string);
// Вторая — декодирование файла
procedureRunDecodeHaff(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;
 ProcedureCreate;//процедура инициализации обьекта
 ProcedureInc(i: Byte);
 End;
// процедура инициализацииобъекта вызывается из процедуры StatFile
 Procedure TStat.Create; //(291)
 var
 i: Byte;
 Begin //создаём массив симолв(ASCII), обнуляем статистику
 //и ставим указатели вположение не определено
 CountByte:=255;
 For i:=0 toCountByte 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;
 FunctionArcName: String;
 FunctionDeArcName: String;
 FunctionFileSizeWOHead: Integer;
 End;
 // генерация по именифайла имени архива
FunctionFile_.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
 IfName_[i]='.'
 Then
 Begin
 Name_[i]:='.';
 //Name_[i]:='!';
 ArcName:=Name_+'.'+PostFix;
 End;
 End;
 // генерация по имениархива имени исходного файла
FunctionFile_.DeArcName: String;
 Var
 i: Integer;
 Name_:String;
 Begin
 Name_:=Name;
 ifpos(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;
FunctionFile_.FileSizeWOHead: Integer;
 Begin
 FileSizeWOHead:=FileSize(FileToRead)-4-1-
 (Stat.CountByte+1)*5;
 //размер исходного файлазаписывается в 4 байтах
 //количество оригинальныхбайт записывается в 1байте
 //количество байтов состатистикой — величина массива
 End;
 //процедура сортировкимассива с байтами (сортировка производится
 //по убыванию частотыбайта (743)
procedureSortMassiv(var a: BytesWithStat; LengthOfMass: byte);
 var
 i,j: Byte; //счётчики циклов
 b: TByte;
 Begin //сортировка перестановкой
 ifLengthOfMass0
 Then
 for j:=0 toLengthOfMass-1 do
 Begin
 for i:=0 toLengthOfMass-1 do
 Begin
 Ifa[i]^.SymbolStat
 Then
 Begin
 b:=a[i];a[i]:=a[i+1]; a[i+1]:=b;
 End;
 Application.ProcessMessages;
 End;
 Application.ProcessMessages;
 End;
 End;
 //процедура удалениядинамической структуры частотного дерева
 //из памяти
 ProcedureDeleteTree(Root: TByte);
 Begin
 Application.ProcessMessages;
 IfRootnil
 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: TByte;//узел
Begin
 //sort_mass(massiv,last);
 If last0 //если не 0 тоначинаем строить дерево
 Then
 Begin
 SortMassiv(massiv,last);//сортируем по убыванию
 //частоты появления символа
 new(Node);//создаёмоновый узел
 //присваиваем ему весдвух самых лёгких эементов
 //т.е. складываемстатистику этих элементов
 Node^.SymbolStat:=massiv[last-1]^.SymbolStat+ massiv[last]^.SymbolStat;
 Node^.left:=massiv[last-1];//от узладелаем ссылку на левую
 Node^.right:=massiv[last];//и правую ветки
 massiv[last-1]:=Node;// удаляем двапоследних элемента
 //из массива на местопредпоследнего из них ставим
 //сформированный узел
 ///////////////// проверяемне достигли ли корня
 if last=1//если =1 то да
 Then
 Begin
 Root:=Node;//устанавливаем корневой узел
 End
 Else
 Begin
 CreateTree(Root,massiv,last-1);//если нет то строим
 //древо дальше
 End;
 End
 Else//если значение lastв самом начале =0 т.е. файл
 //содержит один и тот жесимвол (если файл состоит или
 //из одного байта или изчередования одного итогоже символа)
 Root:=massiv[last];//товершина дерева будет от last
 Application.ProcessMessages;
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;//вызываемметод инициализации объекта
 //для архивируемогофайла (58)
 MainFile.Size:=FileSize(f);//методопределения размера
 // архивируемого файла.Стандартная функция FileSize
 //возвращает начение вбайтах
 ///////////////////////
 countbuf:=FileSize(f)div count;//столько целых буферов
 //по 4096 байт содержитсяв исходном файле
 lastbuf:=FileSize(f) modcount; // остаток от целочисленного
 // деления=(последийбуфер)разница в байтах до 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 lastbuf0//далее просчитываем статистику для оставшихся
 //байт
 Then
 Begin
 BlockRead(f,buf,lastbuf);
 for j:=1 tolastbuf 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) orFound(Tree^.right, i);
 End;
End;
//функция для определениястрокового представления сжатой последовательности
//битов для исходного байта i
FunctionHSymbolToCodWord(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
 ifFound(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 (с учетом
//того экстремальногослучая, когда исходный файл состоит всего из одного
//и того же символа)
FunctionSymbolToCodWord(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;
//процедура записисжатого потока битов в архив
ProcedureWriteInFile(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 8do//работаем с битами
 Begin
 Ifbuffer[(j-1)*8+k]='1'{находим в строке тот элементкоторый будем записывать ввиде последовательности бит(будем просматривать с (j-1) элемента строки bufferвосемь элментов за ним тем самымсформируется строка из восьми '0' и '1'. Эту строку мы будемпреобразовывать в байт, который должен будет содержать такуюжепоследовательность бит)}Then {Преобразование будем производить с помощью операции битовогосдвига влево shl и логической опереоции или (or). Делается это так поверяетсяусловие buffer[(j-1)*8+k]='1' если в выделенной строке из восьми символов (мыпросматриваем её по циклу от первого элемента до восьмого), элемент, индекс которогоравен счётчику цикла к, равен единице, то к соответствующему биту (номеркоторого в байте равен переменной цикла к) будет применена операция or (0 or1=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;
//процедура дляокончательной записи остаточной цепочки битов в архив
ProcedureWriteInFile_(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
 IfLength(buffer)0
 Then
 Begin
 a:=$FF;
 for k:=1 toLength(buffer) do
 Ifbuffer[k]='0'
 Then
 a:=a xor (1shl (8-k));
 BlockWrite(FileToWrite,a,1);
 End;
End;
Type
 Integer_=Array[1..4] of Byte;
//перевод числа типаInteger в массив из четырех байт.
ProcedureIntegerToByte(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.
ProcedureByteToInteger(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.CountBytedo
 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;
 ProcedureCreateBuf;//процедура инициализации
 ProcedureInsertByte(a: Byte);//процедура вставки
//разархивированныхбайтов в файл
 Procedure FlushBuf;
 End;
 /////////////////////////////
 Procedurebuffer_.CreateBuf;
 Begin
 ByteCount:=0;//иициализируем переменные
 GeneralCount:=0;
 End;
 ////////////////////////////////////////
Procedurebuffer_.InsertByte(a: Byte);
{В переменной а мыпередаём значение разархивированного байта, которое получили в вызывающейпроцедуре}
 Begin //до тех пор покаGeneralCount меньше
 //размера сжимаемогофайла деаем
 ifGeneralCount
 Then
 Begin
 inc(ByteCount);//увеличиваем соответствующие
 //счётчики на единицу
 inc(GeneralCount);
 ArrOfByte[ByteCount]:=a;//загоняемв массив ArrOfByte
//значение полученное впеременной а
 //////////////////////////
 if ByteCount=MaxCount //если ByteCount=MaxCount
//то записываемсодержимое массива в разархивируемый файл
 Then
 Begin
 BlockWrite(FileToWrite,ArrOfByte,ByteCount);
 ByteCount:=0;
 //Form1.ProgressBar1.Position:=form1.ProgressBar1.Position+1;
 End;
 End;
 End;
 ////////////////////////////
ProcedureBuffer_.FlushBuf;
//Процедура записиостаточной цепочки байт
 Begin
 If ByteCount0
 Then
 BlockWrite(FileToWrite,ArrOfByte,ByteCount);
 End;
//создание деархивированного файла
ProcedureCreateDeArc;
var
 i,j: Integer;
 k: Byte;
 //////////////
 Buf: Array[1..Count] of Byte;
 CountBuf,LastBuf: Integer;
 MainBuffer:buffer_;
 CurrentPoint: TByte;
Begin
//определяем сколькоцелых буферов по 4 кбайт в сжатом
//файле без заголовка
 CountBuf:=MainFile.FileSizeWOHeaddiv count;
//определяем сколькоостанеся байт не вошедших
//в целые буферы по 4 кбайтв сжатом файле без заголовка
 LastBuf:=MainFile.FileSizeWOHead modcount;
 MainBuffer.CreateBuf;//иициализируем переменные
 CurrentPoint:=MainFile.Tree;//присваиаем текущую
//позицию на кореньдерева
//начинаем расаковку
 For i:=1 to CountBuf do
 Begin//считываем изсжатого файла данные в буфер
 BlockRead(FileToRead,buf,count);
 for j:=1 toCount do //по байтноначинаем
 //просматривать буфер
 Begin
 for k:=1 to 8do//просматриваем биты от 1 до 8
 //выеленного байта
 Begin {Выделяем байт вмассиве. По циклу от 1 до 8просматриваем значения его бит с 7 до 0. Для этогоиспользуетсяоперация битового сдвига влево shl и логиеская операция and.
В цикле всё происходитследующим образом: Сначала просматриваетсястарший бит (8-к)=1 и производитсялогическая операция and, если бит равен 1 то (1 and 1)=1 и программа установиттекущую позицию поиска в дереве на правыйузел, если же бит равен 0то (0 and 1)=0 ипрограмма установит текущую позицию поиска вдереве на левый узел. так будет продолжатся до тех пор пока не выполнится условие, которое ознчает нахождение искомого символа ((CurrentPoint^.left=nil) or (CurrentPoint^.right=nil))
После этого будет вызванапроцедура вставки байта, после возвращения из которой мы текущую точку опятьустанавливаем на корень}
 If (Buf[j] and (1 shl(8-k)))0
 Then
 CurrentPoint:=CurrentPoint^.right
 Else
 CurrentPoint:=CurrentPoint^.left;
 if(CurrentPoint^.left=nil) or (CurrentPoint^.right=nil)
 Then
 Begin
 MainBuffer.InsertByte(CurrentPoint^.Symbol);
 CurrentPoint:=MainFile.Tree;
 End;
 Application.ProcessMessages;
 End;
 Application.ProcessMessages;
 End;
 End;
 If LastBuf0
 Then
 Begin//работа этогоблока программы аналогична предидущему
 BlockRead(FileToRead,Buf,LastBuf);
 for j:=1 toLastBuf do
 Begin
 for k:=1 to 8do
 Begin
 If (Buf[j]and (1 shl (8-k)))0
 Then
 CurrentPoint:=CurrentPoint^.right
 Else
 CurrentPoint:=CurrentPoint^.left;
 if(CurrentPoint^.left=nil) or (CurrentPoint^.right=nil)
 Then
 Begin
 MainBuffer.InsertByte(CurrentPoint^.Symbol);
 CurrentPoint:=MainFile.Tree;
 End;
 Application.ProcessMessages;
 End;
 Application.ProcessMessages;
 End;
 End;
 MainBuffer.FlushBuf;
End;
//процедура чтениязаголовка архива
ProcedureReadHead;
var
 b: Integer_;// исходный размерфайла
 SymbolSt:Integer;//статистика символа
 count_,SymbolId, i: Byte;//SymbolId=Symbol просточтобы
 // не путать глобальную переменную слокальной
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.CountBytedo
 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;
//процедура извлечения архива
ProcedureExtractFile;
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 DoArrOfStr[i]:='';
//Загоням в массив строккодовые слова соответсвующие
//своим символам
 For i:=0 toMainFile.Stat.CountByte do
 Begin
 ArrOfStr[MainFile.Stat.massiv[i]^.Symbol]:=
 MainFile.Stat.massiv[i]^.CodWord;
 Application.ProcessMessages;
 End;
//узнаём какое целоеколичество буферов по 4 кбайт будет содержатся в
//сжимаемом файле
 CountBuf:=MainFile.Sizediv Count;
//Сколько останется байтдля записи не вошедших в ранее
//определённое значениеCountBuf
 LastBuf:=MainFile.Sizemod Count;
 Buffer:='';//обнуляембуфер
 /////////////
 CreateHead; //вызываемпроцедуру создания заголовка файла
 /////////////
 //фрмируем буфер кодовых слов
 for i:=1 tocountbuf do
 Begin
//считываем из файла по 4кбайт
 BlockRead(FileToRead,buf,Count);
 //////////////////////
 For j:=1 tocount do
 Begin
//растим буфер из кодовыхслов
 buffer:=buffer+ArrOfStr[buf[j]];
//если длина bufferпревысит значеие 8*4096 (это означает
//превысит размервыходного буфера размер которого 4096байт)
//мы вызываем процедурузаписи в файл
 If Length(buffer)>8*count
 Then
 WriteInFile(buffer);
 Application.ProcessMessages;
 End;
 //ProgressBar1.Position:=100 div countbuf;
 End;
//Запись оставшейсяцепочки байт
 If lastbuf0
 Then
 Begin
//считываем в массив изфайла оставшиеся байты
 BlockRead(FileToRead,buf,LastBuf);
//растим buffer строку изкодовых слов
 For j:=1 to lastbuf do
 Begin
 buffer:=buffer+ArrOfStr[buf[j]];
 If Length(buffer)>8*count
//если его размерпревысит значение 8*4096 (а это может иметь
//место), то вызываемпроцедуру записи в файл
 Then
 WriteInFile(buffer);
 Application.ProcessMessages;
 End;
 End;
//выываем процедурузаписи оставшейся цепочки кодовых слов
 WriteInFile_(buffer);
 CloseFile(FileToRead);
 CloseFile(FileToWrite);
 Except
 ShowMessage('Ошибка создания архива');
 End;
End;
//главная процедура длясоздания архивного файла
ProcedureCreateFile; //(802)
var
 i: Byte;
Begin
 With MainFile do
 Begin
 {сортировка массивабайтов с частотами (192)}
 SortMassiv(Stat.massiv,stat.CountByte);
 {поиск числа задействованных байтовиз массива
 (ACSII) возмжныхсимволов. В CountByte будем хранить
 количество этох самыхсимволов }
 i:=0;//обнуляем счётчик
 While(i
 //меньше количествазадействовнных байт CountByte
 //и статистика байта(частота появления в файле)
 //не равна нулю делаем
 and(Stat.massiv[i]^.SymbolStat0) do
 Begin
 Inc(i); //увеличиваемсчётчик на единицу
 End;
 //////////////////////
 IfStat.massiv[i]^.SymbolStat=0 //если дошли до символа
 //с нулевой встречаемостью в файле то
 Then
 Dec(i); //уменьшаемсчётчик на единицу тоесть возвращаемся
 //назад это будетпоследний элемент
 //////////////////////
 Stat.CountByte:=i;{присваиваемзначение счётчика
CountByte. Это означает чтов архивируемом файле используется такое количество из 256возможных символов. Будет исползоватся дляпостроения древа частот}{создание дерева частот.Передаём в процедуру начальные параметрыTree=nil-эта переменная будет содержать послеработы процедуры древо ,Stat.massiv-массив с символами и соответствующей им статистикой, а так же указанием на правое и левой дерево,Stat. CountByte количество используемых символов в архивирумом файле (230)} CreateTree(Tree,Stat.massiv,Stat.CountByte); {запускаем в работу дерево с помощью его нахадимсоответствующие кодовые слова. Суть алгоритмавызываем функцию SymbolToCodWord(Tree:TByte(указательна корень дерева. Он у нас выработался врезультате работы процедуры CreateTree, Symbol:byte):
String функция вернёт намстроку содержащую кодовое слово ()}
for i:=0 toStat.CountByte do
Stat.massiv[i]^.CodWord:=SymbolToCodWord(Tree,stat.massiv[i]^.Symbol);
//пишем сам файл
 CreateArchiv;
//Удаляем уже ненужноедерево
 DeleteTree(Tree);
//Инициализируемстатистику файла
 MainFile.Stat.Create;
 End;
End;
//Основная процедурасжатия файла
procedureRunEncodeHaff(FileName_: string);
begin
 MainFile.Name:=FileName_;//передаём имя
//архивируемого файла в программу
 StatFile(MainFile.Name);//запускем процедуру создания
//статистики (частотыпоявления того или иного символа)
//для файла (строка 274)
 CreateFile; //вызовпроцедуры созданя архивного файла (737)
end;
//Основная процедураразархивирования файла
procedureRunDecodeHaff(FileName_: string);
begin
 MainFile.name:=FileName_;//передаём имя
 //архивируемого файла в программу
 ExtractFile;//Вызываемпроцедуру извлечения архива
end;
end.


Не сдавайте скачаную работу преподавателю!
Данный реферат Вы можете использовать для подготовки курсовых проектов.

Поделись с друзьями, за репост + 100 мильонов к студенческой карме :

Пишем реферат самостоятельно:
! Как писать рефераты
Практические рекомендации по написанию студенческих рефератов.
! План реферата Краткий список разделов, отражающий структура и порядок работы над будующим рефератом.
! Введение реферата Вводная часть работы, в которой отражается цель и обозначается список задач.
! Заключение реферата В заключении подводятся итоги, описывается была ли достигнута поставленная цель, каковы результаты.
! Оформление рефератов Методические рекомендации по грамотному оформлению работы по ГОСТ.

Читайте также:
Виды рефератов Какими бывают рефераты по своему назначению и структуре.

Сейчас смотрят :

Реферат Общественно политическая и культурная жизнь России в пореформенный период (60 - 80 г.г. XIX в.)
Реферат Последствия техногенного воздействия на биосферу
Реферат Андрей Федорович Плюснин (1827-1880) происходил из крестьян Забайкалья. В 1860 г на своем баркасе он пристал у селения Хабаровка и открыл торговлю, затем купил дом в виде сруба у поселенца Кудрявцева
Реферат Противоположность и единство конкуренции и монополии. Характеристика рынков несовершенной конку 2
Реферат Восприятие младшими школьниками пейзажной живописи "Малых голландцев"
Реферат Вопросы чести и морали в повести Пушкина "Капитанская дочка"
Реферат Договор аренды зданий и сооружений 2
Реферат «Личностно ориентированное обучение как условие развития творческого потенциала личности учащихся» содержани е
Реферат Компенсация реактивной мощности в сетях общего назначения
Реферат История Франции с XI по XV века
Реферат 1 вариант. I. Выберите правильный ответ
Реферат Неревматический миокардит. История болезни
Реферат Проект планировки сельского населенного пункта c. Новое Уярского района Красноярского края
Реферат Рынок ценных бумаг России
Реферат Трудовое поведение и трудовой коллектив