{----------------------------------------------------------------------}
{ MARKOV1 --- first order markov chain model                           }
{ the procedures in this unit serve the determination of byte          }
{ probabilities with first order markov chain dependencies. the        }
{ algorithms of the module INDEP are just distributed over 256         }
{ subcases.                                                            }
{----------------------------------------------------------------------}
{ Obviously one must use position trees and position sets for higher   }
{ order markov chains in order to avoid storing combinations that      }
{ never appear.                                                        }
{----------------------------------------------------------------------}
{ (c) Enter AG, Zrich, 1990           Creation: H. Thomas  May 1991   }
{----------------------------------------------------------------------}
{ $i switches.inc }
unit markov1;

interface

{----------------------------------------------------------------------}
{ init:   initializes machine from gathered statistics.                }
{----------------------------------------------------------------------}
procedure modelinit;

{----------------------------------------------------------------------}
{ prob:   returns the probability that the next character is           }
{         less than ch (scaled by the scaling factor)                  }
{----------------------------------------------------------------------}
function modelprob(ch: char): word;

{----------------------------------------------------------------------}
{ scale:  returns the the scaling factor for the cumulative            }
{         probabilities.                                               }
{----------------------------------------------------------------------}
function modelscale: word;

{----------------------------------------------------------------------}
{ update: adapts statistics                                            }
{----------------------------------------------------------------------}
procedure modelupdate(ch: char);

{----------------------------------------------------------------------}
{ term:   closes everything down properly                              }
{----------------------------------------------------------------------}
procedure modelterm;

{----------------------------------------------------------------------}
implementation

const
  nul = chr(0);
  first = chr($0A);
  last = chr($FF);
  maxfactor = $4000;

type
  pprobentry = ^tprobentry;
  tprobentry = record
    cumprob: array[char] of word;
    sfactor: word;
  end;
var
  condprob: array[char] of pprobentry;
  prevchar: char;

{----------------------------------------------------------------------}
{ init:   initializes machine with uniform distribution                }
{----------------------------------------------------------------------}
procedure modelinit;
var
  c1, c2: char;
begin { init }
  for c1 := nul to last do begin
    new(condprob[c1]);
    with condprob[c1]^ do begin
      cumprob[nul] := 0;
      for c2 := succ(nul) to last do cumprob[c2] := succ(cumprob[pred(c2)]);
      sfactor := succ(cumprob[last]);
    end;
  end;
  prevchar := first; { start somehow }
end; { init }

{----------------------------------------------------------------------}
{ prob:   returns the probability that the next character is           }
{         less than ch (scaled by the scaling factor)                  }
{----------------------------------------------------------------------}
function modelprob(ch: char): word;
begin { prob }
  modelprob := condprob[prevchar]^.cumprob[ch];
end; { prob }

{----------------------------------------------------------------------}
{ scale:  returns the the scaling factor for the cumulative            }
{         probabilities.                                               }
{----------------------------------------------------------------------}
function modelscale: word;
begin { scale }
  modelscale := condprob[prevchar]^.sfactor;
end; { scale }

{----------------------------------------------------------------------}
{ update: adapts statistics                                            }
{----------------------------------------------------------------------}
procedure modelupdate(ch: char);
var
  c: char;
begin { update }
  with condprob[prevchar]^ do begin
    { increment probability of ch }
    for c := succ(ch) to last do inc(cumprob[c]);
    inc(sfactor);
    { in case of sfactor overflow rescale }
    if sfactor > maxfactor then begin
      for c := succ(nul) to last do begin
        cumprob[c] := cumprob[c] div 2;
        { garantee that no probability is less than 1/maxfactor }
        if cumprob[c] <= cumprob[pred(c)]
        then cumprob[c] := succ(cumprob[pred(c)]);
      end;
      sfactor := sfactor div 2;
      if sfactor <= cumprob[last]
      then sfactor := succ(cumprob[last]);
    end;
  end;
  { set the new prevchar }
  prevchar := ch;
end; { update }

{----------------------------------------------------------------------}
{ term:   closes everything down properly                              }
{----------------------------------------------------------------------}
procedure modelterm;
var
  c: char;
begin { term }
  { release heap space }
  for c := nul to last do dispose(condprob[c]);
end; { term }

{----------------------------------------------------------------------}
end. { markov1 }