(*   Practical Algorithm To Retrieve Information Coded In Alphanumeric
 *   ( PATRICIA ) originally invented by D R Morrison, and from:
 *
 *   R Sedgwick.  Algorithms.  Reading, MA: Addison-Wesley.
 *                1983.  First Ed.  pp  116, 219 / 23.
 *
 *
 *  "Patricia is the quintessential radix searching method:
 *   it manages to identify the bits which distinguish the search keys and
 *   build them into a data structure (with no surplus nodes) that quickly
 *   leads from any search key to the only key in the data structure that
 *   could be equal."  (Ibid, p 222)
 *
 *   Because of the structure of Patricia, it theoretically should be the
 *   ideal mechanism for setting up a tree of variable length strings to
 *   which the radix search path would become the bits identifying unique
 *   strings for data compression and the tree itself would become the
 *   sliding window or dictionary.  In theory this data structure would
 *   become the generaliztion of Storer's LRU, arithmetic coding such as
 *   the Q-coder of IBM, and methods such as LHARC's LZSS with Huffman.
 *   This is presented here to spur interest and research in compression.
 *
 *   The reader is further referred to the following BBS which specializes
 *   in data compression implementations in Ada, Assembler, BASIC,
 *   Modula-2, and Pascal ( with over 42 MB in 650 quality files):
 *
 *        CEC Services BBS  (303) 393 - 6715    [2400,8,N,1]
 *        8335 Fairmount Dr, # 1-206, Denver, CO  80231-1130
 *
 *   The following code was translated to TP 5.5 from Sedwick above.
 *)

{$N+}

(*
 *  {$E+}
 *)

PROGRAM Patricia ;

(*
 *   LABEL ;
 *)


TYPE

     Link = ^Node ;
     Node =
          RECORD
               key,
               info,
               b:   INTEGER ;
               l,
               r:   Link
          END ;

VAR
     head: Link ;
     i,
     j,
     k,
     x,
     maxb: INTEGER ;
     bits_pwr,
     bits_pws:
          LONGINT ;


FUNCTION

     Bits( x: LONGINT ;
           k,
           j: INTEGER  ): INTEGER ;

          (*   the leading n-bits of an m-bit number are extracted
           *   by shifting M right by m-n positions then doing a
           *   bitwise "and" with the mask [ ( 2^n) - 1]
           *)

     BEGIN

          CASE j OF
               0: bits_pwr :=           0 ; (*  [ 2^j] - 1  *)
               1: bits_pwr :=           1 ;
               2: bits_pwr :=           3 ;
               3: bits_pwr :=           7 ;
               4: bits_pwr :=          15 ;
               5: bits_pwr :=          31 ;
               6: bits_pwr :=          63 ;
               7: bits_pwr :=         127 ;
               8: bits_pwr :=         255 ;
               9: bits_pwr :=         511 ;
              10: bits_pwr :=        1023 ;
              11: bits_pwr :=        2047 ;
              12: bits_pwr :=        4095 ;
              13: bits_pwr :=        8191 ;
              14: bits_pwr :=       16383 ;
              15: bits_pwr :=       32767 ;
              16: bits_pwr :=       65535 ;
              17: bits_pwr :=      131071 ;
              18: bits_pwr :=      262143 ;
              19: bits_pwr :=      524287 ;
              20: bits_pwr :=     1048575 ;
              21: bits_pwr :=     2097151 ;
              22: bits_pwr :=     4194303 ;
              23: bits_pwr :=     8388607 ;
              24: bits_pwr :=    16777215 ;
              25: bits_pwr :=    33554431 ;
              26: bits_pwr :=    67108863 ;
              27: bits_pwr :=   134217727 ;
              28: bits_pwr :=   268435455 ;
              29: bits_pwr :=   536870911 ;
              30: bits_pwr :=  1073741823 ;
              31: bits_pwr :=  2147483647 ;
          END ;

          Bits := ( x SHR k) AND bits_pwr ;

          (*
           *  e g, the rightmost bit of X is Bits( X, 0, 1);
           *  and  Bits( 731, 4, 3) = ( 731 DIV 2^4) MOD 2^3 = 45 MOD 8
           *                       or ( 731 SHR   4) AND 7   = 5
           *)

     END ;



FUNCTION

     PatriciaSearch( v: LONGINT ;
                     x: Link    ): Link ;

     VAR
          f: Link ;

     BEGIN

          REPEAT

               f := x ;
               IF Bits( v, x^.b, 1) = 0 THEN
                    x := x^.l
               ELSE
                    x := x^.r ;

          UNTIL f^.b <= x^.b ;

          PatriciaSearch := x

     END ;



FUNCTION

     PatriciaInsert( v: LONGINT ;
                     x: Link     ): Link ;

     (*
      *  Note:  This code assumes that "head" is initialized with key
      *         field of 0, a bit index of "maxb" and both links upward
      *         self pointers.  (Ibid, p 222)
      *)


     VAR
          t,
          f: Link ;
          i: INTEGER ;

     BEGIN

          t := PatriciaSearch( v, x) ;
          i := maxb ;

          WHILE Bits( v, i, 1) = Bits( t^.key, i, 1) DO
                i := i - 1 ;

          REPEAT

               f := x ;
               IF Bits( v, x^.b, 1) = 0 THEN
                    x := x^.l
               ELSE
                    x := x^.r ;

          UNTIL ( x^.b <= i) OR ( f^.b <= x^.b) ;

          New( t) ;

          t^.key := v ;
          t^.b := i ;

          IF Bits( v, t^.b, 1) = 0 THEN
               BEGIN
                    t^.l := t ;
                    t^.r := x
               END
          ELSE
               BEGIN
                    t^.l := x ;
                    t^.r := t
               END ;

          IF Bits( v, f^.b, 1) = 0 THEN
               f^.l := t
          ELSE
               f^.r := t ;

          PatriciaInsert := t

     END ;


BEGIN

     maxb := 0 ;
     maxb := Bits( 1,0,1) ;
     Write( 'maxb = ', maxb) ;  (*  test Bits function  *)
     Write( ' ') ;

END.