{ Реализация базового объекта для сжатия буфера методом Хаффмана
   1) Подсчет частот вхождений.
   2) Построение дерева.
   3) Вычисление кодов.
   4) Кодировка буфера.
   5) Декодировка буфера.

ВНИМАНИЕ! Вы должны написать собственный вариант кода для всех методов,
ссылающихся на HuffBase... Например, см. метод tHuffman.CountBytes.
}
{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 1999

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

(c) Copyright Александров О.Е., 1999

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit Huffman0;

INTERFACE
  USES HufTypes;

const
  cMinBufSize=4096;

type
  { Объект, осуществляющий кодировку/декодировку буфера методом Хаффмана,
  типы данных см. HufTypes.pas }
  tHuffman=object
    public
      constructor Init;
{----- ОСНОВНЫЕ ФУНКЦИИ --------------- }
      {Строит дерево для буфера Buffer}
      procedure Build(const Buffer; Size:tBufferIndex);
  {!!! процедуры с названием "ИмяA" делают то же самое, что и
  процедуры с названием "Имя", но с дополнительной проверкой размеров массивов}
      procedure BuildA(const Buffer:array of tByte; Size:tBufferIndex);

      {БЕЗ ПОСТРОЕНИЯ ДЕРЕВА! Надо предварительно вызвать Build(InBuf, Size).
      Кодирует буфер InBuf и записывает в OutBuf,
	Size - размер данных в исходном буфере InBuf (tByte),
	OutSize - размер данных в сжатом буфере OutBuf (tByte)}
{      procedure Encode(const InitialBuf;
			     InitialSize:tBufferIndex;
		       var   CompressedBuf;
		       var   Compressed_Size:tBufferIndex);}
      procedure Encode(const InitialBuf;
				InitialBufSize:tBufferIndex;
			  var   CompressedBuf;
				CompressedBufMaxSize:tBufferIndex;
			   var  Compressed_Size:tBufferIndex);
      procedure EncodeA(const InitialBuf:array of tByte;
			      InitialSize:tBufferIndex;
			var   CompressedBuf:array of tByte;
			var   Compressed_Size:tBufferIndex);

      { Определяет оптимальный размер (макс. относительное сжатие)
      кодируемого буфера. Методом перебора от SizeMin до SizeMax с шагом
      SizeStep. Возвращает оптимальный размер для кодирования.}
      function FindOptimalSize(const Buf;
			       Size:tBufferIndex):tBufferIndex;
      procedure OptimalSizeMinSet(SizeMin:tBufferIndex);
      procedure OptimalSizeStepSet(SizeStep:tBufferIndex);
      procedure EncodeOptimal(
		       var InitialBuf;
			   InitialSize:tBufferIndex;
		       var RestSize:tBufferIndex;
		       var CompressedBuf;
			   CompressedBufMaxSize:tBufferIndex;
		       var Compressed_Size:tBufferIndex);

      { Справочные функции по кодированным данным.
      Правильно работают только после вызова Build.}
      function MinCodeSize:tCodeLength; { минимальная длина кода }
      function MaxCodeSize:tCodeLength; { максимальная длина кода }
      function CompressedSize:tBufferIndex; { размер данных после сжатия }
      { вычисление размер данных после сжатия по текущим данным
      (длины кодов и частоты)}
      function CalculateCompressedSize:tBufferIndex;

      {Размер (число узлов) дерева для декодировки}
      function SizeOfTreeInNodes:tBaseNodeIndex;
      { Размер упакованого дерева (в байтах) }
      function SizeOfPackedTreeInBytes:word;

      { Записывает упакованные минимальные данные по дереву для декодировки
      в PackedTree }
      procedure SaveTree(var PackedTree);
      procedure SaveTreeA(var PackedTree:array of Byte);

      { Читает упакованные минимальные данные по дереву для декодировки
      из PackedTree }
      procedure LoadTree(const PackedTree);
      procedure LoadTreeA(const PackedTree:array of byte);

      {БЕЗ ПОСТРОЕНИЯ ДЕРЕВА! Надо предварительно вызвать LoadTree}
      { Декодирует буфер InBuf и записывает в OutBuf.
      Size - размер данных в исходном (несжатом) состоянии}
      procedure Decode(const CompressedBuf;
		       var   DecompressedBuf;
			     DecompressedSize:tBufferIndex);
      procedure DecodeA(const CompressedBuf:array of tByte;
			var   DecompressedBuf:array of tByte;
			      DecompressedSize:tBufferIndex);

    private
{----- ДАННЫЕ --------------- }
      { данные для построения дерева}
      HuffmanData:tHuffmanFullTreeData;
      { размер упакованного буфера }
      prCompressedSize:tBufferIndex;
      prSizeMin,prSizeStep:tBufferIndex;

{----- ВНУТРЕННИЕ ФУНКЦИИ --------------- }
     {Очищает ВСЕ данные и подготавливает их для построения дерева}
      procedure Clear;
     {Очищает данные исходной таблицы перед загрузкой дерева }
      procedure ClearBaseNodes;

     {Считает частоты вхождений байт в буфере Buffer}
      procedure CountBytes(const Buffer; Size:tBufferIndex);

     {Cтроит дерево }
      procedure BuildTree;

     {Вычисляет коды по построенному дереву}
      procedure DefineCodes; { прямым ходом (используя NodesData.NextNode)}
      procedure DefineCodesR; { рекурсивным обходом дерева }

      { Возвращает указатель на начало дерева без начальной таблицы
      = @Nodes[cBaseNodeCount] }
      function TreePtr:tPTreeData;

  end;

IMPLEMENTATION
  USES xStrings, HuffSupp, HuffBase;









(*******************************************************************)
(*** ОСНОВНЫЕ ПРОЦЕДУРЫ ********************)

{ Считает количество байт с различными значениями в массиве Buffer и
заносит результат в NodesData}
procedure tHuffman.CountBytes(const Buffer; Size:tBufferIndex);
begin
{ Вызов  HuffBase.CountBytes обращается к процедуре с недоступным вам
исходным кодом.}
  HuffBase.CountBytes(Buffer, Size, HuffmanData.NodesData); {- это работающий вариант процедуры }

{ !!! Комментарий к процедуре.

ВХОД в процедуру:
  Buffer -> указывает на массив байтов;
  Size   =  числу байтов в массиве.

  Счетчики частот вхождений
    HuffmanData.NodesData[i].Counter=0;
    i=[0..255];

ВЫХОД из процедуры:
  Buffer - не изменяется;
  Size - не изменяется.

  Счетчики частот вхождений
    HuffmanData.NodesData[i].Counter = числу байт со значением i в
				       массиве Buffer;
    i=[0..255];
------------------------------------------------------------------

Процедура должна просмотреть массив байтов

  Buffer:array[0..Size-1] of tByte;

и сосчитать сколько раз в нем встречаются различные значения байта, например,
сколько там 1, 2, 3 и т.д.

  Например, обращение к i-тому байту массива Buffer:

     b:=tBuffer(Buffer)[i];

- присваивает переменной b значение i-того байта массива Buffer. Здесь
конструкция tBuffer(Buffer) преобразует нетипизованную переменную Buffer к
типу tBuffer, определенному так

     tBufferIndex=0..cMaxBufferLength;
     tBuffer=array[tBufferIndex] of tByte;

  Просмотр буфера Buffer можно организовать в цикле:

     for i:=0 to Size-1 do begin
       ...операции с tBuffer(Buffer)[i]...
     end;

  Для хранения данных о количестве различных значений байтов в буфере
используется структура HuffmanData.NodesData, определенная так
HuffmanData.NodesData это массив

     tNodesData=array[tNodeIndex] of tNodeData;

  где

     tNodeData=record
       Counter:tFriquency; - !!! счетчик числа вхождений байта
       NextNode:tNodeReference; - ссылка на следущий узел дерева (здесь не используется)
     end;

  где

    tBufferIndex=0..cMaxBufferLength;
    tFriquency=tBufferIndex;

  Для хранения информации о количестве байт значения которых равно i,
используется HuffmanData.NodesData[i].Counter.

  При входе в процедуру tHuffman.CountBytes все счетчики Counter массива
HuffmanData.NodesData обнулены.

  При просмотре массива Buffer мы должны увеличивать соответствующий
счетчик. Т.е., например, обнаружив в массиве Buffer байт равный 2,
мы должны увеличить на единицу HuffmanData.NodesData[2].Counter:

    HuffmanData.NodesData[2].Counter:=HuffmanData.NodesData[2].Counter+1;

также и для других значений.
}
end;

{ Строит двоичное дерево по текущим частотам в NodesData.}
procedure tHuffman.BuildTree;
begin
{ Вызов HuffBase.BuildTree обращается к процедуре с недоступным вам
исходным кодом.}
  HuffBase.BuildTree(HuffmanData.BaseTree.Nodes,
		     HuffmanData.NodesData,
		     HuffmanData.BaseTree.TreeIndexes);

(* !!! Комментарий к процедуре.

ВХОД в процедуру:

  HuffmanData.BaseTree.Nodes - массив узлов для построения двоичного дерева,
    определен так:
      tNodes=array[tNodeIndex] of tNode;
    где
      tNodeIndex=0..(cMaxNodeCount-1); { 0..511 }
      tNode=record
	UpperNodes:tUpNodesReference;
      end;
      tUpNodesReference=record
	case byte of
	  0:(Left, {левый предыдущий узел, если =-1, то нет преддыдущего}
	     Right:tNodeReference); {правый предыдущий узел, если =-1, то нет преддыдущего}
	  1:(Refs:array[0..1] of tNodeReference);
      end;
  В МОМЕНТ ВЫЗОВА
  содержит заполненные пустыми ссылками (-1) данные.

  HuffmanData.NodesData - массив доп. данных для узлов,
    определен так:
      tNodesData=array[tNodeIndex] of tNodeData;
    где
      tNodeData=record
	Counter:tFriquency; - !!! счетчик числа вхождений байта
	NextNode:tNodeReference; - ссылка на следущий узел дерева (здесь не используется)
      end;
      tBufferIndex=0..cMaxBufferLength;
      tFriquency=tBufferIndex;
  В МОМЕНТ ВЫЗОВА
  HuffmanData.NodesData[i].Counter = числу байт со значением i в
				       массиве Buffer для i=[0..255];

  HuffmanData.BaseTree.TreeIndexes - данные по основным узлам дерева
    определен так:
      tTreeIndexes=record
	Root:tIndex; { номер корневого узла дерева }
	MinCode,MaxCode:tBaseNodeIndex; {номер узлов с кодом минимальной и максимальной длины }
      end;
    где
      tNodeIndex=0..(cMaxNodeCount-1); { 0..511 }
      tBaseNodeIndex=0..(cBaseNodeCount-1); { 0..255 }
  В МОМЕНТ ВЫЗОВА
   не определено.

ВЫХОД из процедуры:
  HuffmanData.BaseTree.Nodes - изменяется:
    HuffmanData.BaseTree.Nodes[i].Left  = номер предыдущего левого узла;
				 .Right = номер предыдущего правого узла;
  для узлов включенных в дерево.

  HuffmanData.NodesData - изменяется:
    HuffmanData.NodesData[i].NextNode = номер следующего узла.
  для узлов включенных в дерево.

  HuffmanData.BaseTree.TreeIndexes
    .Root = номер корневого узла дерева;
    .MinCode = номер узла с кодом минимальной;
    .MaxCode = номер узла с кодом максимальной длины;
------------------------------------------------------------------
*)
end;

{ Вычисляет коды для байтов рекурсивным обходом дерева
(от корня к исходным узлам) }
procedure tHuffman.DefineCodesR;
begin
  HuffBase.DefineCodes(HuffmanData.BaseTree.Nodes,
		       HuffmanData.Codes,
		       HuffmanData.BaseTree.TreeIndexes.Root);
end;

{ Кодирует буфер InBuf в OutBuf по готовому дереву, возвращает размер кода
в OutSize. Размер, зарезервированный под OutBuf, должен быть не меньше
CompressedSize для данного буфера, практически лучше иметь буфер
CompressedBuf размера InitialSize. }
procedure tHuffman.Encode(const InitialBuf;
				InitialBufSize:tBufferIndex;
			  var   CompressedBuf;
				CompressedBufMaxSize:tBufferIndex;
			  var   Compressed_Size:tBufferIndex);
begin
  HuffBase.Encode(InitialBuf,    InitialBufSize,
		  CompressedBuf, CompressedBufMaxSize,
		  Compressed_Size,
		  HuffmanData.Codes);
end;

{ Декодирует буфер InBuf в OutBuf. Size - размер исходного (несжатого) буфера.
Размер, зарезервированный под OutBuf, должен быть не меньше Size }
procedure tHuffman.Decode(const CompressedBuf;
			  var   DecompressedBuf;
				DecompressedSize:tBufferIndex);
begin
  HuffBase.Decode(CompressedBuf, DecompressedBuf, DecompressedSize,
		  HuffmanData.BaseTree.Nodes,
		  HuffmanData.BaseTree.TreeIndexes.Root);
end;
(*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
(*** ОСНОВНЫЕ ПРОЦЕДУРЫ ********************)
(*******************************************************************)










(*******************************************************************)
(*** ВСПОМОГАТЕЛЬНЫЕ ПРОЦЕДУРЫ **********************)

{ Строит дерево метода Хаффмана для массива Buffer, размер массива Size и
вычисляет коды Хаффмана. }
procedure tHuffman.Build(const Buffer; Size:tBufferIndex);
begin
  Clear;                   { очистить структуру данных дерева }
  CountBytes(Buffer,Size); { подсчитать байты в Buffer }
  BuildTree;               { построить дерево }
  DefineCodesR;            { вычислить коды символов - рекурсивный проход }
{  DefineCodes; }           { вычислить коды символов - прямой проход }
  prCompressedSize:=CalculateCompressedSize;
end;

{ Строит дерево метода Хаффмана для массива Buffer, размер массива Size }
procedure tHuffman.BuildA(const Buffer:array of tByte; Size:tBufferIndex);
begin
  {!!! процедуры с названием "ИмяA" делают то же самое, что и
  процедуры с названием "Имя", но с дополнительной проверкой размеров массивов}
  {$IfOpt R+}
    if Succ(High(Buffer))<Size then
      RunError(201);
  {$EndIf}
  Build(Buffer,Size);
end;

{Очищает структуру дерева перед началом построения }
procedure tHuffman.Clear;
  const cNodeData0:tNodeData=(Counter:0; NextNode:-1);
begin
  { Очистка основных данных дерева }
  ClearNodes(HuffmanData.BaseTree.Nodes);
  { Инициализация вспомогательных индексов }
  ClearTreeIndexes(HuffmanData.BaseTree.TreeIndexes);
  { Очистка доп. данных дерева }
  ClearNodesData(HuffmanData.NodesData);
end;

{Очищает структуру дерева перед началом загрузки дерева }
procedure tHuffman.ClearBaseNodes;
begin
  { Очистка только начальных узлов дерева }
  ClearNodesEx(HuffmanData.BaseTree.Nodes,Succ(High(tBaseNodeIndex)));
end;

{ Вычисляет коды для байтов прямым проходом (от исходного узла к корню) }
procedure tHuffman.DefineCodes;
begin
  HuffBase.DefineCodesDirect(
    HuffmanData.BaseTree.Nodes,
    HuffmanData.NodesData,
    HuffmanData.Codes,
    HuffmanData.BaseTree.TreeIndexes.Root
  );
end;

{ НЕcтроит дерево, ТОЛЬКО кодирует буфер InBuf в OutBuf, возвращает размер
кода OutSize. Размер, зарезервированный под OutBuf,
должен быть не меньше CompressedSize }
procedure tHuffman.EncodeA(const InitialBuf:array of tByte;
				 InitialSize:tBufferIndex;
			   var   CompressedBuf:array of tByte;
			   var   Compressed_Size:tBufferIndex);
begin
  {$IfOpt R+}
    if Succ(High(InitialBuf))<InitialSize then
      RunError(201);
    if Succ(High(CompressedBuf))<Compressed_Size then
      RunError(201);
  {$EndIf}
  Encode(InitialBuf,InitialSize,
	 CompressedBuf, High(CompressedBuf), Compressed_Size);
end;

{ Декодирует буфер InBuf в OutBuf. Size - размер исходного (несжатого) буфера.
Размер, зарезервированный под OutBuf, должен быть не меньше Size }
procedure tHuffman.DecodeA(const CompressedBuf:array of tByte;
			   var   DecompressedBuf:array of tByte;
				 DecompressedSize:tBufferIndex);
begin
  {$IfOpt R+}
    if Succ(High(DecompressedBuf))<DecompressedSize then
      RunError(201);
  {$EndIf}
  Decode(CompressedBuf, DecompressedBuf, DecompressedSize);
end;

{ размер дерева в узлах }
function tHuffman.SizeOfTreeInNodes;
begin
  SizeOfTreeInNodes:=HuffSupp.SizeOfTreeInNodes(HuffmanData.BaseTree.TreeIndexes);
end;

{ Сохраняет минимальные данные по дереву в упакованном виде, необходимые для декодировки
в массив TreeNodes. Возвращает размер Size - количество узлов в дереве.. }
procedure tHuffman.SaveTree;
begin
  if SizeOfTreeInNodes>0 then begin
    { См. tPackedTree в uMiscFun.pas }
    tPackedTree(PackedTree).PackA(TreePtr^, SizeOfTreeInNodes);
  end else begin
    RunError(201);
  end;
end;

procedure tHuffman.SaveTreeA;
begin
  {$IfOpt R+}
  if SizeOfPackedTreeInBytes>Succ(High(PackedTree)) then
    RunError(201);
  {$EndIf}
  SaveTree(PackedTree);
end;

{ Загружает минимальные данные по дереву, необходимые для декодировки
из массива TreeNodes. Size - количество узлов в дереве. }
procedure tHuffman.LoadTree;
  {$IfOpt R+}
  var i:tNodeIndex;
  {$EndIf}
begin
  ClearBaseNodes;
  { См. tPackedTree в uMiscFun.pas }
  tPackedTree(PackedTree).UnPackA(TreePtr^);
  HuffmanData.BaseTree.TreeIndexes.Root:=tPackedTree(PackedTree).SizeInNodes+Pred(cBaseNodeCount);
  {$IfOpt R+}
    for i:=cBaseNodeCount to HuffmanData.BaseTree.TreeIndexes.Root do begin
      if (HuffmanData.BaseTree.Nodes[i].UpperNodes.Left<0)
	 or (HuffmanData.BaseTree.Nodes[i].UpperNodes.Right<0)
	 or (HuffmanData.BaseTree.Nodes[i].UpperNodes.Right>cMaxNodeCount)
	 or (HuffmanData.BaseTree.Nodes[i].UpperNodes.Left>cMaxNodeCount)
	 then
	RunError(201);
    end;
  {$EndIf}
end;

procedure tHuffman.LoadTreeA;
begin
 {$IfOpt R+}
  if tPackedTree(Addr(PackedTree)^).SizeInBytes<Succ(High(PackedTree)) then
    RunError(201);
  {$EndIf}
  LoadTree(PackedTree);
end;

function tHuffman.MinCodeSize:tCodeLength;
begin
  MinCodeSize:=HuffmanData.Codes[HuffmanData.BaseTree.TreeIndexes.MinCode].Length;
end;

function tHuffman.MaxCodeSize:tCodeLength;
begin
  MaxCodeSize:=HuffmanData.Codes[HuffmanData.BaseTree.TreeIndexes.MaxCode].Length;
end;

{ Вычисляет размер сжатого буфера }
function tHuffman.CompressedSize:tBufferIndex;
begin
  CompressedSize:=prCompressedSize;
end;

function tHuffman.CalculateCompressedSize:tBufferIndex;
begin
  CalculateCompressedSize:=HuffSupp.CompressedSize(HuffmanData.NodesData,
					  HuffmanData.Codes);
end;

{ Размер упакованого дерева (в байтах) }
function tHuffman.SizeOfPackedTreeInBytes;
begin
  SizeOfPackedTreeInBytes:=HuffSupp.SizeOfPackedTreeInBytes(HuffmanData.BaseTree.TreeIndexes);
end;

function tHuffman.TreePtr:tPTreeData;
begin
  TreePtr:=tPTreeData(@HuffmanData.BaseTree.Nodes[cBaseNodeCount]);
end;

function tHuffman.FindOptimalSize;
begin
  FindOptimalSize:=
  HuffBase.FindOptimalSize(
     Buf,
     prSizeMin,Size,prSizeStep,
     HuffmanData.BaseTree.Nodes,
     HuffmanData.NodesData,
     HuffmanData.Codes
  );
end;

constructor tHuffman.Init;
begin
{  Inherited Init;}
  OptimalSizeMinSet(cMinBufSize);
  OptimalSizeStepSet(1024);
end;

procedure tHuffman.OptimalSizeMinSet(SizeMin:tBufferIndex);
begin
  prSizeMin:=SizeMin;
end;

procedure tHuffman.OptimalSizeStepSet(SizeStep:tBufferIndex);
begin
  prSizeStep:=SizeStep;
end;

procedure tHuffman.EncodeOptimal(
		       var InitialBuf;
			   InitialSize:tBufferIndex;
		       var RestSize:tBufferIndex;
		       var CompressedBuf;
			   CompressedBufMaxSize:tBufferIndex;
		       var Compressed_Size:tBufferIndex);
  var
    osz:tBufferIndex;
begin
  osz:=FindOptimalSize(InitialBuf,InitialSize);
  Encode(InitialBuf,osz, CompressedBuf, CompressedBufMaxSize, Compressed_Size);
  if osz<InitialSize then begin
    RestSize:=InitialSize-osz;
    System.Move(tBuffer(InitialBuf)[osz],InitialBuf,RestSize);
  end else begin
    RestSize:=0;
  end;
end;

END.