rsvk/Component/GroupAriModelUnit.pas

unit GroupAriModelUnit;
{-------------------------------------------------------------------------------
Group Arithmetic Model Unit
---------------------------
reSource v2.6
Copyright (C) 1998-2001 Victor Kasenda / gruv
http://go.to/gruv
email: vickas@singnet.com.sg

  The Arithmetic model for the structured arithmetic encoder and decoder.

  Desc:
  There are 9 groups.
  Each group handles a group of characters. Each group size is different.
  The EOF symbol is in the last group.

  Each group is a TGroupAriModel and handles a range of characters.
  The range is between ch_lo and ch_hi inclusive.
  Within each group the symbol may be mapped to another value. This value
  is called the group symbol.

  The main group handles the probability that each group would appear. It is
  also a TGroupAriModel class.

  There are therefore 3 levels of symbols:
  symbol, group number, group symbol

-------------------------------------------------------------------------------}


(**) interface (**)

const
  NUM_GROUPS = 9;
type
  TGroupIntArray = array[0..NUM_GROUPS-1] of integer;
const
  ROOT_LIMIT = 4096;
  ROOT_INCREMENT = 32;
  GROUP_INCREMENT = 1;

  // leaf group info
                             {0  1  2-3 4-7 8-15 16-31 32-63 64-127 128-256}
  grpStart: TGroupIntArray = (0, 1,   2,  4,   8,   16,   32,    64,    128);
  grpLast : TGroupIntArray = (0, 1,   3,  7,  15,   31,   63,   127,    257);
  grpLimit: TGroupIntArray = (0, 0, 256,256, 128, 1024, 2048,  4096,   8192);

  {0: Run MTF_0
   1: Run MTF_0
   2: MTF_1
   3: MTF_2
   ...
   256: MTF_255
   257: EOF
  }

  {grpStart: TGroupIntArray = (0, 1,   2,  4,   6,   8,   76,    136,    196);
  grpLast : TGroupIntArray = (0, 1,   3,  5,  7,   75,   135,   195,    257);
  grpLimit: TGroupIntArray = (0, 0, 256,256, 256, 1024, 1024,  1024,   1024);}


const
  EOF_SYMBOL = 257;
  MAX_SYMBOL_COUNT = 300;

  // constants used for encoding/decoding
  CODE_VALUE_BITS = 16;
  TOP_VALUE = (1 SHL CODE_VALUE_BITS) -1;

  FIRST_QTR = (TOP_VALUE DIV 4) + 1;
  HALF = 2 * FIRST_QTR;
  THIRD_QTR = 3 * FIRST_QTR;


type
  TCumFreq = array[0..MAX_SYMBOL_COUNT] of integer;

  TGroupAriModel = class
  private
  protected
    num_chars, num_symbols: integer;    // number of members and symbols in the group
    max_freq: integer;                  // max count before scaling
    increment: integer;                 // increment the frequancy for each occurence
    char_to_index: array[0..MAX_SYMBOL_COUNT] of integer;
    index_to_char: array[0..MAX_SYMBOL_COUNT] of integer;

    procedure StartModel;
  public
    ch_lo, ch_hi: integer;              // range of chars the group handles
    freq: array[0..MAX_SYMBOL_COUNT] of integer;
    cum_freq: TCumFreq;

    constructor Create(new_ch_lo, new_ch_hi, new_max_freq, new_increment: integer);
    procedure UpdateModel(Symbol: integer);

    function SymbolToIndex(const symbol: integer): integer;
    function IndexToSymbol(const index: integer): integer;
    function IndexToChar(const index: integer): byte;
  end;


  THeadAriModel = class
  private
    symbol_to_group_num: array[0..MAX_SYMBOL_COUNT] of integer;

  public
    MainAriModel: TGroupAriModel;                            // main AriModel
    AriModelList: array[0..NUM_GROUPS-1] of TGroupAriModel;  // AriModel for each group

    constructor Create;
    destructor Destroy; override;

    function GetGroupNum(const symbol: integer): integer;
    procedure GetSymbolInfo(const symbol: integer;
                            var AriModel: TGroupAriModel;
                            var symbol_index: integer);

    procedure GetGroupSymbolInfo(const group_symbol, group_num: integer;
                                 var AriModel: TGroupAriModel;
                                 var symbol_index: integer);

    function HasResidue(group_num: integer): boolean;
    function SymbolToGroupSymbol(symbol: integer; group_num: integer): integer;
    function GroupSymbolToSymbol(group_symbol: integer; group_num: integer): integer;
  end;

(**) implementation (**)

(*******************************************************************************
  THeadAriModel
*******************************************************************************)

constructor THeadAriModel.Create;
var
  i, j: integer;
begin
  inherited Create;

  // create the main group that handles the frequancies of the groups appearing
  MainAriModel := TGroupAriModel.Create(0, NUM_GROUPS-1, ROOT_LIMIT, ROOT_INCREMENT);

  // create the arithmetic model for the various groups
  AriModelList[0] := nil;
  AriModelList[1] := nil;
  for i := 2 to 8 do
    AriModelList[i] := TGroupAriModel.Create(grpStart[i], grpLast[i], grpLimit[i], GROUP_INCREMENT);

  // init the symbol_to_group_num mapping array
  for i := 0 to 8 do
    for j := grpStart[i] to grpLast[i] do
      symbol_to_group_num[j] := i;
end;

destructor THeadAriModel.Destroy;
var
  i: integer;
begin
  for i := 2 to 8 do
    AriModelList[i].Free;
  inherited Destroy;
end;

{-------------------------------------------------------------------------------
  GetGroupNum
  -----------
  returns a group number/root symbol
  Get the root symbol's info using GetRootSymbolInfo
-------------------------------------------------------------------------------}
function THeadAriModel.GetGroupNum(const symbol: integer): integer;
begin
  result := symbol_to_group_num[symbol];
end;

{-------------------------------------------------------------------------------
  GetRootSymbolInfo
  -----------------
  returns the root symbol information
-------------------------------------------------------------------------------}
procedure THeadAriModel.GetSymbolInfo(const symbol: integer;
                                      var AriModel: TGroupAriModel;
                                      var symbol_index: integer);
begin
  AriModel := MainAriModel;
  symbol_index := AriModel.SymbolToIndex(symbol);
end;

{-------------------------------------------------------------------------------
  GetGroupSymbolInfo
  -----------------
  returns the leaf symbol info from a leaf symbol
  Obtain leaf_symbol using SymbolToGroupSymbol
-------------------------------------------------------------------------------}
procedure THeadAriModel.GetGroupSymbolInfo(const group_symbol, group_num: integer;
                                           var AriModel: TGroupAriModel;
                                           var symbol_index: integer);
begin
  AriModel := AriModelList[group_num];
  symbol_index := AriModel.SymbolToIndex(group_symbol);
end;


{-------------------------------------------------------------------------------
  HasResidue
  ----------
  returns true if the group has members.
-------------------------------------------------------------------------------}
function THeadAriModel.HasResidue(group_num: integer): boolean;
begin
  HasResidue := (group_num > 1);
end;

function THeadAriModel.SymbolToGroupSymbol(symbol: integer; group_num: integer): integer;
begin
  result := symbol - AriModelList[group_num].ch_lo;
end;

function THeadAriModel.GroupSymbolToSymbol(group_symbol: integer; group_num: integer): integer;
begin
  result := AriModelList[group_num].ch_lo + group_symbol;
end;


(*******************************************************************************
  TGroupAriModel
*******************************************************************************)

Constructor TGroupAriModel.Create;
begin
  inherited Create;

  ch_lo := new_ch_lo;
  ch_hi := new_ch_hi;
  num_chars := ch_hi - ch_lo + 1;
  num_symbols := num_chars + 1;
  max_freq := new_max_freq;
  increment := new_increment;

  StartModel;
end;

function TGroupAriModel.SymbolToIndex(const symbol: integer): integer;
begin
  result := char_to_index[symbol];
end;

function TGroupAriModel.IndexToSymbol(const index: integer): integer;
begin
  result := index_to_char[index];
end;

function TGroupAriModel.IndexToChar(const index: integer): byte;
var
  r: integer;
begin
  r := IndexToSymbol(index);
  if (r <= 255) then
    result := r
  else
    result := 0;
end;

{-------------------------------------------------------------------------------
  StartModel
  ----------
  initialises variables

  Notes:
  The index corresponds to the frequancy. They start from 1.
  freq[0] is just a dummy value.
-------------------------------------------------------------------------------}
procedure TGroupAriModel.StartModel;
var
  i: integer;
begin
  for i := 0 to num_chars-1 do
  begin
    char_to_index[i] := i + 1;
    index_to_char[i+1] := i;
  end;

  // initialise frequancies and the cum_freq
  for i := 0 to num_symbols do
  begin
    freq[i] := 1;
    cum_freq[i] := num_symbols-i;
  end;

  // the frequancy for 0 and 1 cannot be equal (see UpdateModel)
  freq[0] := 0;
end;

{-------------------------------------------------------------------------------
  UpdateModel
  -----------
  updates the model for the Symbol

  Desc:
  Keeps the symbols in sorted order according to frequancy. This allows
  the more frequantly appearing symbols to be found and encoded faster.

  Notes:
  The cumulative frequancy is stored upside down. The total is in cum_freq[0].
  The moost frequantly upated symbols are stored to the front.
-------------------------------------------------------------------------------}
procedure TGroupAriModel.UpdateModel(Symbol: integer);
var
  i, cum: integer;
  ch_i, ch_symbol: integer;
begin

  // scale down if over the max_freq count
  if (cum_freq[0] >= max_freq) then
  begin
    cum := 0;
    for i := num_symbols downto 0 do
    begin
      freq[i] := (freq[i] + 1) div 2;
      cum_freq[i] := cum;
      inc(cum, freq[i]);
    end;
  end;

  // search for the next position to place the symbol
  // the next position is the position where freq[i-1] > freq[i] 
  i := symbol;
  while (freq[i] = freq[i-1]) do dec(i);

  // update the translation tables if the symbol has moved
  if (i < symbol) then
  begin
    ch_i := index_to_char[i];
    ch_symbol := index_to_char[symbol];
    index_to_char[i] := ch_symbol;

    index_to_char[symbol] := ch_i;
    char_to_index[ch_i] := symbol;
    char_to_index[ch_symbol] := i;
  end;

  // increment the frequancy count for the symbol
  // update the cumulative frequancy for the other symbols in front of it
  inc(freq[i], increment);
  while (i > 0) do
  begin
    dec(i);
    inc(cum_freq[i], increment);
  end;

end;


end.