A D T   H e a p

Include Datei



{---------------- ADT Heap ---- HMO, Juni 1988 / Dez. 1994 ------------------
 Der Anwender des ADT muß aus dem Hauptprogramm die folgenden anwender-
 spezifischen Deklarationen importieren:

 CONST     n_heap       = ...;     Integer, max. Heapgröße
 TYPE      inhalt_heap = ...;     Inhalt der Heapknoten incl. Bewertung

 FUNCTION  kleinergleich (VAR a,b: inhalt_heap): Boolean;
    Auf den Inhalten des Heaps wird ein "kleinergleich"-Vergleich realisiert.
    Wirkung:  bewertung(a) <= bewertung(b)

 FUNCTION  groessergleich (VAR a,b: inhalt_heap): Boolean;
    Auf den Inhalten des Heaps wird ein "groessergleich"-Vergleich realisiert.
    Wirkung:  bewertung(a) >= bewertung(b)
----------------------------------------------------------------------------}


TYPE  heap_art  = (undef_heap, min_heap, max_heap);
      heap_typ  = RECORD
                    last: Integer;
                    feld: ARRAY [1..n_heap] OF inhalt_heap;
                    art : heap_art
                  END;

{---------------- private --------------------------------------------------}

PROCEDURE  tausche_heap (VAR h: heap_typ; i,j: Integer);
VAR hilf: inhalt_heap;
BEGIN  hilf:=h.feld[i];  h.feld[i]:=h.feld[j];  h.feld[j]:=hilf  END;

FUNCTION   besser_heap (VAR h: heap_typ; a,b: inhalt_heap): Boolean;
{Das i-te Element des Heaps wird mit dem j-ten Element verglichen.
 Beim Minimum-Heap mit der Relation <= und
 beim Maximum-Heap mit der Relation >= }
BEGIN
  CASE h.art OF
    min_heap: besser_heap:=kleinergleich (a,b);
    max_heap: besser_heap:=groessergleich(a,b);
    ELSE      besser_heap:=FALSE
  END
END;


PROCEDURE  sift_heap (VAR h: heap_typ; element: Integer);
{Das Element des Heaps bei der Position "element", wird ggf. mit seinen
 Söhnen verglichen und vertauscht, solange bis es eine Position gefunden
 hat, die seiner Bewertung entspricht. }
VAR lsohn, rsohn, vergleich: Integer;
BEGIN
  lsohn:=element * 2;
  rsohn:=lsohn + 1;
  IF (lsohn<=h.last)                  {element kein Blatt}
  THEN BEGIN
    IF (rsohn<=h.last)                {zwei Söhne existieren}
    THEN BEGIN
      IF besser_heap(h,h.feld[lsohn],h.feld[rsohn])
         THEN vergleich:=lsohn        {der linke  Sohn ist besser}
         ELSE vergleich:=rsohn        {der rechte Sohn ist besser}
    END
    ELSE vergleich:=lsohn;
    IF besser_heap(h,h.feld[vergleich],h.feld[element])
    THEN BEGIN                        {der Sohn ist besser}
      tausche_heap(h,element,vergleich); {mit dem besseren Sohn vertauschen}
      sift_heap(h,vergleich)               {und weiter ...}
    END
  END
END;

{---------------- Implementation -------------------------------------------}


{1}
PROCEDURE  create_heap (VAR h: heap_typ; art: heap_art);
{Erzeugt einen leeren Heap "h", je nach "art" als Minimum- oder Maximum-Heap.}
BEGIN  h.last:=0; h.art :=art  END;


{2}
PROCEDURE  make_heap (VAR h: heap_typ; anz: Integer; art: heap_art);
{Im Objekt "h" ist die Komponente "h.feld" mit "anz" Elementen bereits gefüllt,
 allerdings noch ohne Heapstruktur. Anders ausgedrückt: es liegt ein Array mit
 "anz" belegten Elementen vor. Dies Array wird zu einem Heap transformiert; je
 nach "art" zu Minimum- oder Maximum-Heap.}
VAR index: Integer;
BEGIN
  h.last:=anz; h.art:=art;
  FOR index:=(anz DIV 2) DOWNTO  1  DO sift_heap (h,index)
END;


{3}
FUNCTION   count_heap (VAR h: heap_typ): Integer;
{Der Funktionswert ist die Anzahl der Elemente im Heap "h", 0 <= anzahl <= n.}
BEGIN
  IF h.art=undef_heap THEN count_heap:=0
                      ELSE count_heap:=h.last
END;


{4}
FUNCTION   empty_heap (VAR h: heap_typ): Boolean;
BEGIN  empty_heap:=(count_heap(h)=0)  END;


{5}
FUNCTION   full_heap (VAR h: heap_typ): Boolean;
BEGIN  full_heap:=(count_heap(h)=n_heap)  END;


{6}
PROCEDURE  in_heap (VAR h: heap_typ; VAR inh: inhalt_heap);
{Das Element "inh" wird, falls möglich, in den Heap "h" eingefügt. Auf den
 freien Platz hinter dem letzten Element des Heaps wird der Inhalt "inh"
 gesetzt. Dann wird das Element solange hochgeschaukelt, bis es eine Position
 gefunden hat, die seiner Bewertung entspricht.}
VAR index,
    vater : Integer;
    fertig: Boolean;
BEGIN
  IF NOT full_heap(h)
  THEN BEGIN
    index:=h.last+1;            {der erste freie Platz}
    h.last:=h.last+1;           {Anzahl der Elemente inkrementieren}
    h.feld[index]:=inh;         {Inhalt auf den ersten freien Platz setzen}
    fertig:=FALSE;
    WHILE (index>1) AND NOT fertig DO
    BEGIN
      vater:=index DIV 2;       {Vater des aktuellen Knotens}
      IF besser_heap(h,h.feld[vater],h.feld[index])
      THEN fertig:=TRUE         {fertig, falls Vater besser ist}
      ELSE BEGIN
        tausche_heap(h,index,vater); {mit dem Vater vertauschen}
        index:=vater            {weitermachen mit neuem Index}
      END
    END
  END
END;


{7}
PROCEDURE  best_heap (VAR h: heap_typ; VAR inh: inhalt_heap);
{Das oberste Element des Heaps "h", im Minimum-Heap das minimale und im
 Maximum-Heap das maximale Element, wird im Parameter "inh" abgeliefert.
 Der Heap bleibt unverändert.}
BEGIN  IF NOT empty_heap(h) THEN inh:=h.feld[1]  END;


{8}
PROCEDURE  delbest_heap (VAR h: heap_typ);
{Das beste Element des Heaps "h", also entweder Minimum oder Maximum, je
 nach Art des Heaps, wird unter Erhaltung der Heapstruktur entfernt.}
BEGIN
  IF NOT empty_heap(h)
  THEN BEGIN                  {nur wenn überhaupt Elemente im Heap}
    tausche_heap(h,1,h.last); {setze letztes Element an oberste Stelle}
    h.last:=h.last-1;         {dekrementiere Zahl der Elemente}
    sift_heap(h,1)            {das neue oberste Element einordnen}
  END
END;


{9}
PROCEDURE  clean_heap (VAR h: heap_typ; VAR b: inhalt_heap);
{Im Heap "h" werden alle Elemente mit einer Bewertung die schlechter
 oder gleich  "b" ist unter Erhaltung der Heapstruktur entfernt. }
VAR i : Integer;
BEGIN
  i:=1;
  WHILE i<=count_heap(h)
  DO BEGIN
    IF besser_heap(h,b,h.feld[i])
    THEN BEGIN tausche_heap(h,i,h.last); h.last:=h.last-1 END
    ELSE i:=i+1
  END;
  make_heap(h,count_heap(h),h.art)
END;




HTML-Texte: Heapoperationen Heapsort Priority Queue Branch & Bound ADT Heap HAUPTTEXT
Paket mit Pascal-Dateien laden: HeapPac.Zip   (39 K)

zur Informatik-Leitseite


© HMO, Neubearbeitung Januar 1998