home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / binbaum.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  9.5 KB  |  286 lines
  1. {========================== PROGRAMM BINAERE BAEUME =========================}
  2. { Dieses ist das Rahmenprogramm zur Demonstration der Einfuege-, Loesch-
  3.   und Suchprozeduren in binaeren Baeumen. Dabei wird der Baum nach jeder
  4.   Aenderung graphisch und sequentiell dargestellt, soweit es die Bedingungen
  5.   (Bildschirmformat, Aufloesung) erlauben. Es stehen zwei getrennte Moduln
  6.   zur Verfuegung, die die Prozeduren zum Loeschen, Einfuegen und Suchen ent-
  7.   halten. Das eine benutzt Rekursion ausschliesslich 'herabsteigend', also
  8.   ohne VAR-Parameter, so dass sie auch mit Turbo-Pascal unter CP/M 80
  9.   lauffaehig sind. Das zweite Modul ist rekursiv implementiert, ist also unter
  10.   einigen Pascal-Compilern nicht lauffaehig. Dafuer bietet es immer
  11.   AVL-ausgeglichene Baeume. Zu beachten sind einige Anpassungen an das
  12.   jeweils gewaehlte Modul, die alle im Programmtext gekennzeichnet sind.     }
  13.  
  14. {$S+}           { schaltet bei Pascal MT+ die Erzeugung rekursiven Codes ein }
  15.  
  16. PROGRAM binaere_baeume (INPUT, OUTPUT);
  17.  
  18. CONST dc2 = 18;                { ASCII 18, loescht vom Cursor bis Zeilenende }
  19.       ff = 12;                            { ASCII 12, loescht den Bildschirm }
  20.  
  21. TYPE key = CHAR;
  22.      side = (left, none, right);
  23.      information = RECORD
  24.                      stichwort: key                { nach Bedarf erweiterbar }
  25.                    END;
  26.      tree = ^node;
  27.      node = RECORD
  28.               info: information;
  29.               links, rechts: tree;
  30.             { schiefe: side }                                 { nur fuer AVL }
  31.             END;
  32.  
  33. VAR baum: tree;
  34.     stichwort: key;
  35.     befehl: CHAR;
  36.     neuinfo: information;
  37. {   dummy: BOOLAEN; }                                         { nur fuer AVL }
  38.     @SFP: EXTERNAL INTEGER;                   { Stackadresse fuer Pascal MT+ }
  39.  
  40. {----------------------------------------------------------------------------}
  41. { Der jetzt folgende Teil ist Implementationsabhaengig und je nach Compiler/
  42.   Hardware anzupassen. Die hier angegebenen Prozeduren gelten fuer Pascal
  43.   MT+.                                                                       }
  44. {----------------------------------------------------------------------------}
  45. { BDOS-Funktionsaufruf:                                                      }
  46.  
  47. EXTERNAL FUNCTION @BDOS (func: INTEGER; parm: WORD): INTEGER;
  48.  
  49. {----------------------------------------------------------------------------}
  50. { Cursor an Position Spalte x und Zeile y setzen. Die linke obere Ecke ent-
  51.   spricht der Koordinate 1,1                                                 }
  52.  
  53. PROCEDURE GotoXY (x, y: INTEGER);
  54.  
  55. VAR dummy: INTEGER;
  56.  
  57. BEGIN
  58.   dummy := @BDOS (6, wrd(31));
  59.   dummy := @BDOS (6, wrd(x));
  60.   dummy := @BDOS (6, wrd(y));
  61. END;
  62.  
  63. {----------------------------------------------------------------------------}
  64. { ein Zeichen von der Tastatur lesen und auf den Bildschirm 'echoen'. Dabei
  65.   ist kein RETURN/ENTER nach dem Zeichen notwendig!                          }
  66.  
  67. PROCEDURE GetChar (VAR c: CHAR);
  68.  
  69. BEGIN
  70.   REPEAT
  71.     c := Chr (@BDOS (6, wrd($FF)));
  72.   UNTIL c <> Chr(0);
  73.   Write (c);
  74. END;
  75.  
  76. {----------------------------------------------------------------------------}
  77. { Die Zeilen 'von' bis 'bis' des Bildschirms loeschen:                       }
  78.  
  79. PROCEDURE ClrLines (von, bis: INTEGER);
  80.  
  81. VAR l: INTEGER;
  82.  
  83. BEGIN
  84.   GotoXY (1, von);
  85.   FOR l := von TO bis DO
  86.     WriteLn (chr (dc2));
  87.   GotoXY (1, von);
  88. END;
  89.  
  90. {----------------------------------------------------------------------------}
  91. { gesamten Bildschirm loeschen:                                              }
  92.  
  93. PROCEDURE ClrScr;
  94.  
  95. BEGIN Write (Chr (ff)) END;
  96.  
  97. {----------------------------------------------------------------------------}
  98. {               Ende des implementatiosabhaengigen Teiles                    }
  99. {----------------------------------------------------------------------------}
  100.  
  101. PROCEDURE message (number: INTEGER);
  102.  
  103. BEGIN
  104.   GotoXY (1, 24); Write ('Stichwort ');
  105.   CASE number OF
  106.     0: Write ('wurde nicht gefunden.');
  107.     1: Write ('wird eingetragen.');
  108.     2: Write ('wird geloescht.');
  109.     3: Write ('wurde gefunden.');
  110.     4: Write ('ist vorhanden.')
  111.   END;
  112.   Write ('          ');
  113. END;
  114.  
  115. {----------------------------------------------------------------------------}
  116.  
  117. PROCEDURE lese_info (VAR info: information);
  118.  
  119. BEGIN
  120.   { normalerweise steht hier die Routine zum Lesen des kompletten
  121.     Datensatzes ohne das Stichwort. In diesem Beispiel gibt es aber nur
  122.     das Stichwort als einzige Information.                                   }
  123. END;
  124.  
  125. {----------------------------------------------------------------------------}
  126. { Information des Knotens ausgeben. Hier gleichzeitig das Stichwort.         }
  127.  
  128. PROCEDURE schr_info (info: information);
  129.  
  130. BEGIN
  131.   Write (info.stichwort);
  132. END;
  133.  
  134. {----------------------------------------------------------------------------}
  135. { Im Normalfall weitere Informationen zum zu speichernden Stichwort einlesen
  136.   (s. 'lese_info'):                                                          }
  137.  
  138. PROCEDURE restinfo (stichwort: key; VAR info: information);
  139.  
  140. BEGIN
  141.   info.stichwort := stichwort;
  142.   lese_info (info);
  143. END;
  144.  
  145. {----------------------------------------------------------------------------}
  146. { Der Baum wird graphisch auf dem Bildschirm dargestellt. Je nach Rechner
  147.   sind die Graphikzeichen zu aendern. Auf eine naehere Erklaerung der Arbeits-
  148.   weise dieser Prozedur wird verzichtet, sie dient nur der Verdeutlichung
  149.   der Vorgaenge bei den Baumoperationen.                                     }
  150.  
  151. PROCEDURE schr_baum (baum: tree; dichte, x, y: INTEGER);
  152.  
  153. {          CPC                                           IBM-PC }
  154. CONST pu = 241;  { Pfeil nach unten                         193 }
  155.       wl = 154;  { waagerechte Linie                        196 }
  156.       sl = 149;  { senkrechte Linie                         179 }
  157.       sa = 148;  { senkrechte Linie, oben abgebrochen       179 }
  158.       ru = 150;  { Winkel von rechts nach unten             218 }
  159.       lu = 156;  { Winkel von links nach unten              191 }
  160.       ro = 147;  { Winkel von rechts nach oben              192 }
  161.       lo = 153;  { Winkel von links nach oben               217 }
  162.  
  163. VAR dx, xi: INTEGER;
  164.  
  165. BEGIN
  166.   GotoXY (x, y);   Write (Chr (pu));
  167.   GotoXY (x, y+1); Write (baum^.info.stichwort);
  168. { nur bei AVL-Baeumen Kommentar-Klammern entfernen !
  169.   GotoXY (x, y+2);
  170.   CASE baum^.schiefe OF
  171.     right: Write ('\');
  172.      none: Write ('|');
  173.      left: Write('/');
  174.   END;
  175. }
  176.   dx := 20 DIV dichte;
  177.   IF dx = 0 THEN
  178.   BEGIN
  179.     GotoXY (x, y-1); Write (Chr (sl));
  180.   END;
  181.   IF (baum^.links <> nil) AND (dichte < 32) THEN                { linker Ast }
  182.   BEGIN
  183.     FOR xi := x-dx+1 TO x-2 DO
  184.     BEGIN
  185.       GotoXY (xi, y+2); Write (Chr (wl));
  186.     END;
  187.     GotoXY (x-1, y+2); Write (Chr (lo));
  188.     GotoXY (x-1, y+1); Write (Chr (sa));
  189.     GotoXY (x-dx, y+2); Write (Chr (ru));
  190.     schr_baum (baum^.links, 2*dichte, x-dx, y+3);              { linker Sohn }
  191.   END;
  192.   IF (baum^.rechts <> nil) AND (dichte < 32) THEN              { rechter Ast }
  193.   BEGIN
  194.     FOR xi := x+2 TO x+dx-1 DO
  195.     BEGIN
  196.       GotoXY (xi, y+2); Write(Chr (wl));
  197.     END;
  198.     GotoXY (x+1, y+2); Write (Chr (ro));
  199.     GotoXY (x+1, y+1); Write (Chr (sa));
  200.     GotoXY (x+dx, y+2); Write (Chr (lu));
  201.     schr_baum (baum^.rechts, 2*dichte, x+dx, y+3);            { rechter Sohn }
  202.   END;
  203. END;
  204.  
  205. {----------------------------------------------------------------------------}
  206.  
  207. PROCEDURE preorder (baum: tree);
  208.  
  209. BEGIN
  210.   IF baum <> nil THEN
  211.   BEGIN
  212.     schr_info (baum^.info);
  213.     preorder (baum^.links);
  214.     preorder (baum^.rechts);
  215.   END;
  216. END;
  217.  
  218.  
  219. PROCEDURE inorder (baum: tree);
  220.  
  221. BEGIN
  222.   IF baum <> nil THEN
  223.   BEGIN
  224.     inorder (baum^.links);
  225.     schr_info (baum^.info);
  226.     inorder (baum^.rechts);
  227.   END;
  228. END;
  229.  
  230.  
  231. PROCEDURE postorder (baum: tree);
  232.  
  233. BEGIN
  234.   IF baum <> nil THEN
  235.   BEGIN
  236.     postorder (baum^.links);
  237.     postorder (baum^.rechts);
  238.     schr_info (baum^.info);
  239.   END;
  240. END;
  241.  
  242. {----------------------------------------------------------------------------}
  243. { An dieser Stelle muss das gewuenschte Modul zum Einfuegen, Loeschen und
  244.   Suchen eingefuegt werden, was z. B. so funktionieren koennte:              }
  245.  
  246. {$I baum-els.inc} { bzw. $I avlb-els.inc}
  247.  
  248. {----------------------------------------------------------------------------}
  249.  
  250. BEGIN { binaere_baeume }
  251.   @SFP := @SFP-4096+128;       { Stack auf 4096 Bytes setzen fuer Pascal MT+ }
  252.   ClrScr;
  253.   GotoXY (1, 19); Write ('*** binaere Baeume: ');
  254.   Write ('(+) einfuegen, (-) loeschen, (?) suchen, (#) beenden');
  255.   baum := nil;                                  { Anfangs ist der Baum leer. }
  256.   REPEAT
  257.     GotoXY (1, 23); Write ('Befehl:      ');
  258.     GotoXY (9, 23); GetChar (befehl);
  259.     IF befehl IN ['+', '-', '?'] THEN
  260.       GetChar(stichwort);
  261.     CASE befehl OF
  262.       '+': einfuegen (baum, stichwort{, dummy});             { dummy bei AVL }
  263.       '-': loeschen (baum, stichwort{, dummy});              { dummy bei AVL }
  264.       '?': suchen (baum, stichwort);
  265.     END;
  266.     IF befehl IN ['+', '-'] THEN
  267.     BEGIN
  268.       ClrLines (1, 18);
  269.       IF baum <> nil THEN
  270.         schr_baum (baum, 1, 40, 1);
  271.       GotoXY (1, 20);
  272.       Write ('Preorder:  ');
  273.       preorder (baum);
  274.       WriteLn (Chr (dc2));
  275.       Write ('Inorder:   ');
  276.       inorder (baum);
  277.       WriteLn (Chr (dc2));
  278.       Write ('Postorder: ');
  279.       postorder (baum);
  280.       WriteLn (Chr (dc2));
  281.     END;
  282.   UNTIL befehl = '#';
  283. END.
  284.  
  285. {==================== ENDE DES PROGRAMMS BINAERE BAEUME =====================}
  286.