```Contributor: KAI ROHRBACHER

{
Hello Thomas,

On 26.06.94 you wrote in area PASCAL to subject "Arithmetic compression":
TW> But where can we get a discription of this compression method ??
Michael  Barnsley, Lyman Hurd, "Fractal Image Compression", AK Peters,
1993
Mark Nelson, "The Data Compression Book", M&T Books, 1991
Ian  Witten,  Radford  Neal,  John Cleary, "Arithmetic Coding for Data
Compression", CACM, Vol. 30, No.6, 1987

Below  is a small source from the 1st book, translated into Pascal and
adopted  to  work  on  the uppercase alphabet to demonstrate the basic
principles.
For  a  simple  explanation, the program uses the letters of the input
string  to "drive" the starting point through the real interval 0.0 ..
1.0
By  this process, every possible input string stops at a unique point,
that  is:  a  point  (better: a small interval section) represents the
whole  string.  To  _decode_  it, you have to reverse the process: you
start  at  the  given  end point and apply the reverse transformation,
noting  which intervals you are touching at your voyage throughout the
computation.
Due  to the restricted arithmetic resolution of any computer language,
the  max.  length of a string will be restricted, too (try it out with
TYPE   REAL=EXTENDED,  for  example);  this  happens  when  the  value
"underflows" the computers precision. }

{\$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P+,Q-,R+,S+,T-,V+,X+,Y+}
{\$M 16384,0,655360}
PROGRAM arithmeticCompression;
USES CRT;
CONST charSet:STRING='ABCDEFGHIJKLMNOPQRSTUVWXYZ ';
size=27; {=Length(charSet)}
p:ARRAY[1..size] OF REAL=  (* found empirically *)
(
6.1858296469E-02,
1.1055412402E-02,
2.6991022453E-02,
2.6030374520E-02,
9.2418577127E-02,
2.1864028512E-02,
1.4977615842E-02,
2.8410764564E-02,
5.5247871050E-02,
1.3985123226E-03,
3.8001321554E-03,
3.2593032914E-02,
2.1919756707E-02,
5.2434924064E-02,
5.7837905257E-02,
2.0364674693E-02,
1.0031075103E-03,
4.9730779744E-02,
4.8056280170E-02,
7.2072478498E-02,
2.0948493879E-02,
8.2477728625E-03,
1.0299101184E-02,
4.7873173243E-03,
1.3613601926E-02,
2.7067980437E-03,
2.3933136781E-01
);
VAR   psum:ARRAY[1..size] OF REAL;

FUNCTION Encode(CONST s:STRING):REAL;
VAR i,po:INTEGER;
offset,len:REAL;
BEGIN
offset:=0.0;
len:=1.0;
FOR i:=1 TO Length(s) DO
BEGIN
po:=POS(s[i],charSet);
IF po<>0
THEN BEGIN
offset:=offset+len*psum[po];
len:=len*p[po]
END
ELSE BEGIN
WRITELN('only input chars ',charSet,' allowed!');
Halt(1)
END;
END;
Encode:=offset+len/2;
END;

FUNCTION Decode(x:REAL; n:BYTE):STRING;
VAR i,j:INTEGER;
s:STRING;
BEGIN
IF (x<0.0) OR (x>1.0)
THEN BEGIN
WRITELN('must lie in the range [0..1]');
Halt(1)
END;
FOR i:=1 TO n DO
BEGIN
j:=size;
WHILE x```