home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / modula2 / optimalt.mod < prev    next >
Encoding:
Text File  |  1987-01-08  |  7.4 KB  |  305 lines
  1. (* Find the optimally structured binary search tree for n keys.
  2.    Known are the search frequencies of the keys, b[i] for key[i],
  3.    and the frequencies of searches with arguments that are not
  4.    keys (represented in the tree).  a[i] is the frequency of an
  5.    argument lying between key[i-1] and key[i].  Use Knuth's
  6.    algorithm, "Acta informatica" 1, 1, 14-25 (1971).  The
  7.    following example uses Modula keywords as keys. *)
  8.  
  9. MODULE optimaltree;
  10.  
  11. FROM InOut     IMPORT Read, Write, WriteLn, WriteString, WriteCard, OpenInput, Done;
  12. FROM RealInOut IMPORT WriteReal;
  13. FROM Storage   IMPORT ALLOCATE, DEALLOCATE;
  14. IMPORT Terminal;
  15.  
  16. CONST n = 29;       (* # of keys *)
  17.       kln = 9;     (* max key length *)
  18.  
  19. TYPE index = [0..n];
  20.      alfa = ARRAY [0..kln] OF CHAR;
  21.  
  22. VAR ch,tch: CHAR;
  23.     k1,k2,i,j,k: CARDINAL;
  24.     id,buf: alfa;
  25.     key: ARRAY [1..n] OF alfa;
  26.     a: ARRAY index OF CARDINAL;
  27.     b: ARRAY index OF CARDINAL;
  28.     p,w: ARRAY index,index OF CARDINAL;
  29.     r: ARRAY index,index OF index;
  30.     suma,sumb: CARDINAL;
  31.  
  32. PROCEDURE balltree(i,j: index): CARDINAL;
  33. VAR k,tmp: CARDINAL;
  34.  
  35. BEGIN
  36.   k := (i+j+1) DIV 2;
  37.   r[i,j] := k;
  38.   IF i >= j THEN
  39.     tmp := b[k]
  40.   ELSE
  41.     tmp := balltree(i,k-1) + balltree(k,j) + w[i,j]
  42.   END;
  43.   RETURN tmp
  44. END balltree;
  45.  
  46. PROCEDURE copystring(VAR from,to: alfa);
  47. VAR i: CARDINAL;
  48.  
  49. BEGIN
  50.   FOR i := 0 TO kln DO
  51.     to[i] := from[i]
  52.   END
  53. END copystring;
  54.  
  55. PROCEDURE compalfa(a,b:alfa):INTEGER;
  56. VAR i,j: INTEGER;
  57.  
  58. BEGIN
  59.   i := 0;
  60.   j := 0;
  61.   LOOP
  62.     IF CAP(a[i]) < CAP(b[i]) THEN
  63.       j := -1; EXIT
  64.     ELSIF CAP(a[i]) > CAP(b[i]) THEN
  65.       j := 1; EXIT
  66.     ELSE
  67.       INC(i)
  68.     END;
  69.     IF i > kln THEN EXIT END
  70.   END;
  71.   RETURN j;
  72. END compalfa;
  73.  
  74. PROCEDURE opttree;
  75. VAR x,min: CARDINAL;
  76.     i,j,k,h,m: index;
  77.  
  78. BEGIN
  79.   j := 0;
  80.   FOR i := 0 TO n DO p[i,i] := w[i,i] END;    (* width of tree h = 0 *)
  81.   FOR i := 0 TO n-1 DO
  82.     INC(j);
  83.     p[i,j] := p[i,i] + p[j,j];
  84.     r[i,j] := j
  85.   END;
  86.   FOR h := 2 TO n DO
  87.     FOR i := 0 TO n-h DO
  88.       j := i + h;
  89.       m := r[i,j-1];
  90.       min := p[i,m-1] + p[m,j];
  91.       FOR k := m+1 TO r[i+1,j] DO
  92.         x := p[i,k-1] + p[k,j];
  93.         IF x < min THEN
  94.           m := k;
  95.           min := x
  96.         END
  97.       END;
  98.       p[i,j] := min + w[i,j];
  99.       r[i,j] := m
  100.     END
  101.   END
  102. END opttree;
  103.  
  104. PROCEDURE printtree;
  105. CONST lw = 120;
  106.  
  107. TYPE ref = POINTER TO node;
  108.      lineposition = [0..lw];
  109.      node = RECORD
  110.               key: alfa;
  111.               pos: lineposition;
  112.               left,right,link: ref
  113.             END;
  114.             
  115. VAR q,q1,q2,root,current,next: ref;
  116.     i,k: CARDINAL;
  117.     u,u1,u2,u3,u4: lineposition;
  118.  
  119.   PROCEDURE tree(i,j: index): ref;
  120.   VAR p: ref;
  121.  
  122.   BEGIN
  123.     IF i = j THEN
  124.       p := NIL
  125.     ELSE
  126.       NEW(p);
  127.       p^.left := tree(i,r[i,j]-1);
  128.       p^.pos := TRUNC((FLOAT(lw)-FLOAT(kln))*FLOAT(k)/FLOAT(n-1)) + (kln DIV 2);
  129.       INC(k);
  130.       p^.key := key[r[i,j]];
  131.       p^.right := tree(r[i,j],j)
  132.     END;
  133.     RETURN p
  134.   END tree;
  135.  
  136. BEGIN
  137.   k := 0; root := tree(0,n);
  138.   current := root;
  139.   root^.link := NIL;
  140.   next := NIL;
  141.   WHILE current # NIL DO
  142.     FOR i := 1 TO 3 DO
  143.        q := current;
  144.       REPEAT u := 0;
  145.         u1 := q^.pos;
  146.         REPEAT
  147.           Write(' ');
  148.           INC(u)
  149.         UNTIL u = u1;
  150.         Write(':'); INC(u);
  151.         q := q^.link
  152.       UNTIL q = NIL;
  153.       WriteLn;
  154.     END;
  155.         (* now print master line; descending from nodes on current list collect
  156.            their descendants and form next list *)
  157.     q := current; u := 0;
  158.     REPEAT
  159.       copystring(q^.key,buf);
  160.           (* center key about pos *)
  161.       i := kln;
  162.       WHILE buf[i] = ' ' DO DEC(i) END;
  163.       u2 := q^.pos - ((i-1) DIV 2);
  164.       u3 := u2 + i + 1;
  165.       q1 := q^.left; q2 := q^.right;
  166.       IF q1 = NIL THEN
  167.         u1 := u2
  168.       ELSE
  169.         u1 := q1^.pos;
  170.         q1^.link := next;
  171.         next := q1
  172.       END;
  173.       IF q2 = NIL THEN
  174.         u4 := u3
  175.       ELSE
  176.         u4 := q2^.pos + 1;
  177.         q2^.link := next;
  178.         next := q2
  179.       END;
  180.       i := 0;
  181.       WHILE u < u1 DO Write(' '); INC(u); END;
  182.       WHILE u < u2 DO Write('-'); INC(u); END;
  183.       WHILE u < u3 DO Write(buf[i]); INC(i); INC(u); END;
  184.       WHILE u < u4 DO Write('-'); INC(u); END;
  185.       q := q^.link
  186.     UNTIL q = NIL;
  187.     WriteLn;
  188.         (* now invert next list AND make it current list *)
  189.     current := NIL;
  190.     WHILE next # NIL DO
  191.       q := next;
  192.       next := q^.link;
  193.       q^.link := current;
  194.       current := q
  195.     END
  196.   END
  197. END printtree;
  198.  
  199. BEGIN    (* initialize table of keys and counters *)
  200.   OpenInput('MOD');
  201.   key[ 1] := "ARRAY     ";     key[ 2] := "BEGIN     ";     key[ 3] := "BY        ";
  202.   key[ 4] := "CASE      ";     key[ 5] := "CONST     ";     key[ 6] := "DIV       ";
  203.   key[ 7] := "DO        ";     key[ 8] := "ELSE      ";     key[ 9] := "END       ";
  204.   key[10] := "FOR       ";     key[11] := "FROM      ";     key[12] := "IF        ";
  205.   key[13] := "IMPORT    ";     key[14] := "IN        ";     key[15] := "MOD       ";
  206.   key[16] := "MODULE    ";     key[17] := "NIL       ";     key[18] := "OF        ";
  207.   key[19] := "PROCEDURE ";     key[20] := "RECORD    ";     key[21] := "REPEAT    ";
  208.   key[22] := "SET       ";     key[23] := "THEN      ";     key[24] := "TO        ";
  209.   key[25] := "TYPE      ";     key[26] := "UNTIL     ";     key[27] := "VAR       ";
  210.   key[28] := "WHILE     ";     key[29] := "WITH      ";
  211.   FOR i := 1 TO n DO
  212.     a[i] := 0;
  213.     b[i] := 0
  214.   END;
  215.   FOR i := 1 TO n DO
  216.     FOR j := 1 TO n DO
  217.       w[i,j] := 0
  218.     END
  219.   END;
  220.   b[0] := 0;
  221.   k2 := kln;
  222.       (* scan input text and determine a and b *)
  223.   LOOP
  224.     Read(ch);
  225.     IF NOT Done THEN EXIT END;
  226.     IF (CAP(ch) >= 'A') AND (CAP(ch) <= 'Z') THEN
  227.       k1 := 0;
  228.       REPEAT
  229.         IF k1 <= kln THEN
  230.           buf[k1] := ch;
  231.           INC(k1);
  232.         END;
  233.         Read(ch)
  234.       UNTIL NOT (((CAP(ch) >= 'A')AND(CAP(ch) <= 'Z')) OR ((ch >= '0')AND(ch <= '9')));
  235.       DEC(k1);
  236.       IF k1 >= k2 THEN
  237.         k2 := k1
  238.       ELSE
  239.         REPEAT
  240.           buf[k2] := ' ';
  241.           DEC(k2)
  242.         UNTIL k2 = k1
  243.       END;
  244.       copystring(buf,id);
  245.       i := 1; j := n;
  246.       REPEAT
  247.         k := (i+j) DIV 2;
  248.         IF compalfa(key[k],id) <= 0 THEN i := k+1 END;
  249.         IF compalfa(key[k],id) >= 0 THEN j := k-1 END
  250.       UNTIL i > j;
  251.       IF compalfa(key[k],id) = 0 THEN
  252.         INC(a[k])
  253.       ELSE
  254.         k := (i+j) DIV 2;
  255.         INC(b[k])
  256.       END
  257.     ELSIF ch = '"' THEN
  258.       REPEAT Read(ch) UNTIL ch = '"'
  259.     END
  260.   END;
  261.   WriteString(' keys and frequencies of occurrence: ');
  262.   WriteLn;
  263.   suma := 0; sumb := 0;
  264.   FOR i := 1 TO n DO
  265.     suma := suma + a[i];
  266.     sumb := sumb + b[i];
  267.     WriteCard(b[i-1],6); WriteCard(a[i],6);
  268.     Write(' '); WriteString(key[i]);
  269.     WriteLn
  270.   END;
  271.   
  272.   WriteCard(b[n],6); WriteLn;
  273.   WriteString('  ------  ------'); WriteLn;
  274.   WriteCard(suma,6); WriteCard(sumb,6);
  275.   WriteLn;
  276.  
  277.       (* compute w from a and b *)
  278.   FOR i := 0 TO n DO
  279.     w[i,i] := b[i];
  280.     FOR j := i+1 TO n DO w[i,j] := w[i,j-1] + a[j] + b[j] END
  281.   END;
  282.   WriteLn;
  283.   WriteString(' average path length of balanced tree = ');
  284.   WriteReal(FLOAT(balltree(0,n))/FLOAT(w[0,n]),6);
  285.   printtree;
  286.   WriteLn;
  287.   
  288.   opttree;
  289.   WriteLn;
  290.   WriteString(' average path length of optimal tree = ');
  291.   WriteReal(FLOAT(p[0,n])/FLOAT(w[0,n]),6);
  292.   printtree;
  293.   WriteLn;
  294.   
  295.       (* now considering keys only, setting b = 0 *)
  296.   FOR i := 0 TO n DO
  297.     w[i,i] := 0;
  298.     FOR j := i+1 TO n DO w[i,j] := w[i,j-1] + a[j] END
  299.   END;
  300.   opttree;
  301.   WriteLn;
  302.   WriteString(' optimal tree considering keys only ');
  303.   printtree;
  304. END optimaltree.
  305.