home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 02 / avlb_els.inc < prev    next >
Encoding:
Text File  |  1979-12-31  |  12.4 KB  |  366 lines
  1. {===== MODUL AVLB-ELS === Einfuegen, Loeschen und Suchen in AVL-Baeumen =====}
  2. {----------------------------------------------------------------------------}
  3. { Der direkte linke Nachfolger des Knotens 'baum' tauscht mit 'baum' die
  4.   Position unter Beibehaltung der Ordnung im Baum und ohne die Kennzeichen
  5.   fuer die Ausgeglichenheit anzugleichen, da dies beim Loeschen anders
  6.   vorgeht als beim Einfuegen.                                                }
  7.  
  8. PROCEDURE rot_r (VAR baum: tree);
  9.  
  10. VAR ast: tree;
  11.  
  12. BEGIN
  13.   ast := baum^.links;
  14.   baum^.links := ast^.rechts;
  15.   ast^.rechts := baum;
  16.   baum := ast;
  17. END;
  18.  
  19. {----------------------------------------------------------------------------}
  20. { Wie 'rot_r' nur seitenverdreht.                                            }
  21.  
  22. PROCEDURE rot_l (VAR baum: tree);
  23.  
  24. VAR ast: tree;
  25.  
  26. BEGIN
  27.   ast := baum^.rechts;
  28.   baum^.rechts := ast^.links;
  29.   ast^.links := baum;
  30.   baum := ast;
  31. END;
  32.  
  33. {----------------------------------------------------------------------------}
  34. { Der direkte Nachfolger zweiten Grades des Knotens 'baum' ueber den Pfad
  35.   links, rechts wird an die Stelle des Knotens gesetzt. Der ehemalige Knoten
  36.   'baum' wird dann der linke Nachfolger des oben genannten. Die Anpassungen
  37.   fuer die Ausgeglichenheitskennzeichen werden weitestgehend vorgenommen.    }
  38.  
  39. PROCEDURE rot_lr (VAR baum: tree);
  40.  
  41. VAR ast1, ast2: tree;
  42.  
  43. BEGIN
  44.   ast1 := baum^.links;
  45.   ast2 := ast1^.rechts;
  46.   ast1^.rechts := ast2^.links;
  47.   ast2^.links := ast1;
  48.   baum^.links := ast2^.rechts;
  49.   ast2^.rechts := baum;
  50.   IF ast2^.schiefe=left THEN
  51.     baum^.schiefe := right
  52.   ELSE
  53.     baum^.schiefe := none;
  54.   IF ast2^.schiefe=right THEN
  55.     ast1^.schiefe := left
  56.   ELSE
  57.     ast1^.schiefe := none;
  58.   baum := ast2;
  59. END;
  60.  
  61. {----------------------------------------------------------------------------}
  62. { Wie 'rot_lr' nur seitenverdreht.                                           }
  63.  
  64. PROCEDURE rot_rl (VAR baum: tree);
  65.  
  66. VAR ast1, ast2: tree;
  67.  
  68. BEGIN
  69.   ast1 := baum^.rechts;
  70.   ast2 := ast1^.links;
  71.   ast1^.links := ast2^.rechts;
  72.   ast2^.rechts := ast1;
  73.   baum^.rechts := ast2^.links;
  74.   ast2^.links := baum;
  75.   IF ast2^.schiefe=right THEN
  76.     baum^.schiefe := left
  77.   ELSE
  78.     baum^.schiefe := none;
  79.   IF ast2^.schiefe=left THEN
  80.     ast1^.schiefe := right
  81.   ELSE
  82.     ast1^.schiefe := none;
  83.   baum := ast2
  84. END;
  85.  
  86. {============================================================================}
  87. { Im 'baum' wird nach dem 'stichwort' gesucht. Ist es noch nicht vorhanden,
  88.   wird dafuer ein neuer Knoten in den Baum eingefuegt. Ist der Baum AVL-ausge-
  89.   glichen, bleibt diese Ausgeglichenheit erhalten.                           }
  90.  
  91. PROCEDURE einfuegen (VAR baum: tree; stichwort: key; VAR gewachsen: BOOLEAN);
  92.  
  93.   {--------------------------------------------------------------------------}
  94.  
  95.   PROCEDURE erzeugen (VAR baum: tree; stichwort: key; VAR gewachsen: boolean);
  96.  
  97.   BEGIN
  98.     new (baum);
  99.     gewachsen := true;
  100.     restinfo (stichwort, baum^.info);
  101.     message (1);
  102.     WITH baum^ DO
  103.     BEGIN
  104.       links := nil;
  105.       rechts := nil;
  106.       schiefe := none;
  107.     END;
  108.   END;
  109.  
  110.   {--------------------------------------------------------------------------}
  111.   { Gehoert das 'stichwort' in den linken Teilbaum von 'baum', dann ist diese
  112.     Prozedur aufzurufen. Nach dem rekursiven Aufruf von 'einfuegen' wird der
  113.     Teilbaum ausgeglichen, was aber nur in einem bestimmten Fall noetig ist,
  114.     da der Teilbaum durch das Einfuegen unter Umstaenden nur schlechter oder
  115.     sogar besser ausgeglichen wird.                                          }
  116.  
  117.   PROCEDURE weiter_links (VAR baum: tree; stichwort: key;
  118.                           VAR gewachsen: BOOLEAN);
  119.  
  120.   BEGIN
  121.     einfuegen (baum^.links, stichwort, gewachsen);
  122.     IF gewachsen THEN
  123.       CASE baum^.schiefe OF
  124.          right: BEGIN
  125.                   baum^.schiefe := none;
  126.                   gewachsen := false;
  127.                 END;
  128.           none: baum^.schiefe := left;
  129.           left: BEGIN
  130.                   IF baum^.links^.schiefe = left THEN
  131.                     BEGIN
  132.                       rot_r (baum);
  133.                       baum^.rechts^.schiefe := none;
  134.                     END
  135.                   ELSE
  136.                     rot_lr (baum);
  137.                   baum^.schiefe := none;
  138.                   gewachsen := false;
  139.                 END;
  140.       END;
  141.   END;
  142.  
  143.   {--------------------------------------------------------------------------}
  144.   { Wie 'weiter_links' nur seitenverdreht.                                   }
  145.  
  146.   PROCEDURE weiter_rechts (VAR baum: tree; stichwort: key;
  147.                            VAR gewachsen: BOOLEAN);
  148.  
  149.   BEGIN
  150.     einfuegen (baum^.rechts, stichwort, gewachsen);
  151.     IF gewachsen THEN
  152.       CASE baum^.schiefe OF
  153.         right: BEGIN
  154.                  IF baum^.rechts^.schiefe=right THEN
  155.                    BEGIN
  156.                      rot_l (baum);
  157.                      baum^.links^.schiefe := none;
  158.                    END
  159.                  ELSE
  160.                    rot_rl (baum);
  161.                  baum^.schiefe := none;
  162.                  gewachsen := false;
  163.                END;
  164.          none: baum^. schiefe := right;
  165.          left: BEGIN
  166.                  baum^.schiefe := none;
  167.                  gewachsen := false;
  168.                END;
  169.       END;
  170.   END;
  171.  
  172.   {--------------------------------------------------------------------------}
  173.  
  174. BEGIN { einfuegen }
  175.   IF baum = nil THEN
  176.     erzeugen (baum, stichwort, gewachsen)
  177.   ELSE IF baum^.info.stichwort > stichwort THEN
  178.     weiter_links (baum, stichwort, gewachsen)
  179.   ELSE IF baum^.info.stichwort < stichwort THEN
  180.     weiter_rechts (baum, stichwort, gewachsen)
  181.   ELSE
  182.   BEGIN
  183.     gewachsen := false;
  184.     message(4);
  185.   END;
  186. END;
  187.  
  188. {============================================================================}
  189. { Im 'baum' wird nach dem 'stichwort' gesucht und der dazugehoerige Knoten
  190.   aus dem Baum entfernt. Eine vorhandene AVL-Ausgeglichenheit des Baumes
  191.   bleibt dabei erhalten.                                                     }
  192.  
  193. PROCEDURE loeschen (VAR baum: tree; stichwort: key; VAR geschrumpft: BOOLEAN);
  194.  
  195. VAR knoten: tree;                      { zeigt auf den freizugebenden Knoten }
  196.  
  197.   {--------------------------------------------------------------------------}
  198.   { Es wird ein AVL-Ausgleich vorgenommen, fuer den Fall, dass der rechte
  199.     Teilbaum von 'baum' geschrumpft ist. Dabei kann es sein, dass der Baum
  200.     nun besser ausgeglichen ist (vorher right), schlechter ausgeglichen ist
  201.     (vorher none) oder aber auch nicht mehr ausgeglichen ist, so dass eine
  202.     Rotation faellig wird, die je nach Situation eine andere Form hat.       }
  203.  
  204.   PROCEDURE ausgl_rechts (VAR baum: tree; VAR geschrumpft: BOOLEAN);
  205.  
  206.   BEGIN
  207.     CASE baum^.schiefe OF
  208.       left: CASE baum^.links^.schiefe OF
  209.               left: BEGIN
  210.                       rot_r (baum);
  211.                       baum^.schiefe := none;
  212.                       baum^.rechts^.schiefe := none;
  213.                     END;
  214.               none: BEGIN
  215.                       rot_r (baum);
  216.                       baum^.schiefe := right;
  217.                       baum^.rechts^.schiefe := left;
  218.                       geschrumpft := false;
  219.                     END;
  220.              right: BEGIN
  221.                       rot_lr (baum);
  222.                       baum^.schiefe := none;
  223.                     END;
  224.             END;
  225.       none: BEGIN
  226.               baum^.schiefe := left;
  227.               geschrumpft := false;
  228.             END;
  229.      right: baum^.schiefe := none;
  230.     END;
  231.   END;
  232.  
  233.   {--------------------------------------------------------------------------}
  234.   { Wie 'ausgl_rechts' nur seitenverdreht.                                   }
  235.  
  236.   PROCEDURE ausgl_links (VAR baum: tree; VAR geschrumpft: BOOLEAN);
  237.  
  238.   BEGIN
  239.     CASE baum^.schiefe OF
  240.       right: CASE baum^.rechts^.schiefe OF
  241.                right: BEGIN
  242.                         rot_l (baum);
  243.                         baum^.schiefe := none;
  244.                         baum^.links^.schiefe := none;
  245.                       END;
  246.                 none: BEGIN
  247.                         rot_l (baum);
  248.                         baum^.schiefe := left;
  249.                         baum^.links^.schiefe := right;
  250.                         geschrumpft := false;
  251.                       END;
  252.                 left: BEGIN
  253.                         rot_rl (baum);
  254.                         baum^.schiefe := none;
  255.                       END;
  256.              END;
  257.        none: BEGIN
  258.                baum^.schiefe := right;
  259.                geschrumpft := false;
  260.              END;
  261.        left: baum^.schiefe := none;
  262.     END;
  263.   END;
  264.  
  265.   {--------------------------------------------------------------------------}
  266.   { Diese Prozedur sucht in dem angegebenen Baum 'zweig' das kleinste Stich-
  267.     wort. Dessen Inhalt wird dann im zu loeschenden Knoten gespeichert. Damit
  268.     wird der eigene Knoten zum zu loeschenden.                               }
  269.  
  270.   PROCEDURE kleinsten_holen (VAR zweig: tree; VAR geschrumpft: BOOLEAN);
  271.  
  272.   BEGIN
  273.     IF zweig^.links = nil THEN
  274.       BEGIN                                             { Kleinster gefunden }
  275.         baum^.info := zweig^.info;                     { Kleinsten hochholen }
  276.         knoten := zweig;                              { Loeschmarke umsetzen }
  277.         zweig := zweig^.rechts;    { Knoten den Kleinsten aus Baum entfernen }
  278.         geschrumpft := true;        { bezogen auf den Vorgaenger von 'zweig' }
  279.       END
  280.     ELSE
  281.       BEGIN
  282.         kleinsten_holen (zweig^.links, geschrumpft);
  283.         IF geschrumpft THEN
  284.           ausgl_links (zweig, geschrumpft);
  285.       END;
  286.   END;
  287.  
  288.   {--------------------------------------------------------------------------}
  289.   { Der Knoten, auf den 'baum' zeigt, wird aus dem Baum entfernt und die
  290.     direkt nachfolgende Umgebung wird ausgeglichen. Das Ausgleichen des ge-
  291.     samten Baumes erfolgt auf dem Rueckweg durch die rekursiven Aufrufe von
  292.     'loeschen'.                                                              }
  293.  
  294.   PROCEDURE entfernen (VAR baum: tree; VAR geschrumpft: BOOLEAN);
  295.  
  296.   BEGIN
  297.     knoten := baum;
  298.     IF baum^.rechts = nil THEN
  299.       BEGIN                               { Wenn rechts kein Nachfolger ist, }
  300.         baum := baum^.links;             { kann der linke Teilbaum ohne Kon- }
  301.         geschrumpft := true;    { sequenzen an die Stelle des zu loeschenden }
  302.       END                                           { Knoten gesetzt werden. }
  303.     ELSE IF baum^.links = nil THEN
  304.       BEGIN                                    { Ebenso wird mit dem rechten }
  305.         baum := baum^.rechts;           { Teilbaum verfahren, wenn es keinen }
  306.         geschrumpft := true;                                  { linken gibt. }
  307.       END
  308.     ELSE
  309.     BEGIN
  310.            { Fuer den Fall, dass es beide direkten Nachfolger gibt, wird der
  311.            Knoten mit dem naechstgroesseren Stichwort an seine Stelle gelegt }
  312.       kleinsten_holen (baum^.rechts, geschrumpft);
  313.       IF geschrumpft THEN
  314.         ausgl_rechts (baum, geschrumpft);
  315.     END;
  316.     Dispose (knoten);
  317.   END;
  318.  
  319.   {--------------------------------------------------------------------------}
  320.  
  321. BEGIN { loeschen }
  322.   IF baum = nil THEN
  323.     BEGIN
  324.       message (0);
  325.       geschrumpft := false;
  326.     END
  327.   ELSE IF baum^.info.stichwort > stichwort THEN
  328.     BEGIN
  329.       loeschen (baum^.links, stichwort, geschrumpft);
  330.       IF geschrumpft THEN
  331.         ausgl_links (baum, geschrumpft);
  332.     END
  333.   ELSE IF baum^.info.stichwort < stichwort THEN
  334.     BEGIN
  335.       loeschen (baum^.rechts, stichwort, geschrumpft);
  336.       IF geschrumpft THEN
  337.         ausgl_rechts (baum, geschrumpft);
  338.     END
  339.   ELSE
  340.   BEGIN
  341.     entfernen (baum, geschrumpft);
  342.     message (2);
  343.   END;
  344. END;
  345.  
  346. {----------------------------------------------------------------------------}
  347. { Im 'baum' wird nach dem 'stichwort' gesucht und eine entsprechende Meldung
  348.   ausgegeben. Anstelle der Meldung ist die betreffende Operation auszufuehren,
  349.   z. B. werden die zum Stichwort gehoerenden Informationen ausgegeben oder
  350.   geaendert, je nach Anwendung.                                              }
  351.  
  352. PROCEDURE suchen (baum: tree; stichwort: key);
  353.  
  354. BEGIN
  355.   IF baum = nil THEN
  356.     message (0)
  357.   ELSE IF baum^.info.stichwort > stichwort THEN
  358.     suchen (baum^.links, stichwort)
  359.   ELSE IF baum^.info.stichwort < stichwort THEN
  360.     suchen(baum^.rechts, stichwort)
  361.   ELSE
  362.     message (3);
  363. END;
  364.  
  365. {========================= ENDE DES MODULS AVLB-ELS =========================}
  366.