Lösung zu Blatt 8 --- Allgemeine Informatik II (WS 1999)

10. Heapsort

MODULE Heap;

   IMPORT Objects;

   TYPE
      CompareProc = PROCEDURE (object1, object2: Objects.Object) : INTEGER;

   TYPE
      Node = POINTER TO NodeRec;
      NodeRec =
	 RECORD
	    object: Objects.Object;
	    left, right: Node;
	 END;
      BinaryHeap = POINTER TO BinaryHeapRec;
      BinaryHeapRec =
	 RECORD
	    (Objects.ObjectRec)
	    root: Node;
	    compare: CompareProc;
	    nofelements: INTEGER;
	 END;
   
   VAR 
      myheap: BinaryHeap;
      input: INTEGER;

   PROCEDURE Swap(VAR a, b: Objects.Object);
      VAR tmp: Objects.Object;
   BEGIN
      tmp := a;
      a := b;
      b := tmp;
   END Swap;

   PROCEDURE CreateHeap(VAR heap: BinaryHeap; compare: CompareProc);
   BEGIN
      NEW(heap);
      heap.root := NIL;
      heap.compare := compare;
      heap.nofelements := 0;
   END CreateHeap;

   PROCEDURE SecondHighestSet(s: INTEGER): BOOLEAN;
      (* Soll nur fuer positive Zahlen funktionieren *)
   BEGIN
      ASSERT (s > 0);
      IF s < 2 THEN RETURN FALSE
      ELSIF s = 3 THEN RETURN TRUE
      ELSE RETURN SecondHighestSet(s DIV 2); END;
   END SecondHighestSet;

   PROCEDURE RemoveBranch(s: INTEGER; left: BOOLEAN): INTEGER;
      VAR res, save: INTEGER;
   BEGIN
      ASSERT (s > 0);
      res := 1;
      save := s;
      IF ~left THEN INC(s, s DIV 2); END;
      WHILE s > 1 DO
	 res := res * 2;
	 s := s DIV 2;
      END;
      res := res DIV 2;
      RETURN save - res;
   END RemoveBranch;

   PROCEDURE Insert(heap: BinaryHeap; object: Objects.Object);
      VAR
	 node, ptr: Node;
	 nr: INTEGER;
   BEGIN
      NEW(node);
      node.object := object; node.left := NIL; node.right := NIL;
      IF (heap.root = NIL) OR (heap.nofelements = 0) THEN
	 heap.root := node;
	 heap.nofelements := 1;
	 RETURN
      END;
      ptr := heap.root;
      nr := heap.nofelements + 1;
      WHILE ptr.right # NIL DO
	 IF SecondHighestSet(nr) THEN
	    ptr := ptr.right;
	    nr := RemoveBranch(nr, FALSE);
	 ELSE
	    ptr := ptr.left;
	    nr := RemoveBranch(nr, TRUE);
	 END;
      END;
      IF ptr.left = NIL THEN
	 ptr.left := node;
      ELSE
	 ptr.right := node;
      END;
      INC(heap.nofelements);
   END Insert;

   PROCEDURE BuildSubHeap(heap: BinaryHeap; node: Node);
      (* Gehe in die unterste Ebene und dann wieder nach oben *)
   BEGIN
      IF node = NIL THEN RETURN END;
      BuildSubHeap(heap, node.left);
      BuildSubHeap(heap, node.right);
      IF (node.left # NIL) & (heap.compare(node.left.object, node.object) < 0)
	 THEN
	 Swap(node.left.object, node.object);
	 BuildSubHeap(heap, node.left);
      END;
      IF (node.right # NIL) & (heap.compare(node.right.object, node.object) < 0)
	 THEN
	 Swap(node.right.object, node.object);
	 BuildSubHeap(heap, node.right);
      END;
   END BuildSubHeap;

   PROCEDURE BuildHeap(heap: BinaryHeap);
   BEGIN
      BuildSubHeap(heap, heap.root);
   END BuildHeap;

   PROCEDURE SinkTop(heap: BinaryHeap; node: Node);
      (* Repair SubHeap. Only local top might be wrong *)
      VAR
	 smallest: INTEGER; (* 0 top, 1 left, 2 right *)
   BEGIN
      IF node = NIL THEN RETURN END;
      smallest := 0;
      IF (node.left # NIL) &
	 (heap.compare(node.left.object, node.object) < 0 )THEN
	 smallest := 1;
      END;
      IF (node.right # NIL) &
	 (((heap.compare(node.right.object, node.object) <= 0)
	 & (smallest = 0)) OR ((smallest = 1) &
	 (heap.compare(node.right.object, node.left.object) <= 0))) THEN
	 smallest := 2;
      END;
      CASE smallest OF
	 | 0: RETURN;
	 | 1: Swap(node.object, node.left.object);
	      SinkTop(heap, node.left);
	      RETURN;
	 | 2: Swap(node.object, node.right.object);
	      SinkTop(heap, node.right);
	      RETURN;
      END;
   END SinkTop;

   PROCEDURE RemoveTopAndRepair(heap: BinaryHeap; VAR object: Objects.Object);
      VAR
	 node, ptr, prev: Node;
	 nr: INTEGER;
	 lor: BOOLEAN;
   BEGIN
      ASSERT(heap.nofelements > 0);
      object := heap.root.object;
      IF heap.nofelements = 1 THEN 
	 heap.root := NIL;
	 heap.nofelements := 0;
	 RETURN;
      END;
      lor := TRUE;
      ptr := heap.root;
      nr := heap.nofelements;
      WHILE nr > 1 DO
	 prev := ptr;
	 IF SecondHighestSet(nr) THEN
	    lor := FALSE;
	    ptr := ptr.right;
	    IF nr > 3 THEN
	       nr := RemoveBranch(nr, FALSE);
	    ELSE
	       nr := 1;
	    END;
	 ELSE
	    lor := TRUE;
	    ptr := ptr.left;
	    IF nr > 3 THEN
	       nr := RemoveBranch(nr, TRUE);
	    ELSE
	       nr := 1;
	    END;
	 END;
      END;
      heap.root.object := ptr.object;
      IF lor THEN
	 prev.left := NIL;
      ELSE
	 prev.right := NIL;
      END;
      DEC(heap.nofelements);
      SinkTop(heap, heap.root);
   END RemoveTopAndRepair;

   PROCEDURE HeapSize(heap: BinaryHeap): INTEGER;
   BEGIN
      RETURN heap.nofelements
   END HeapSize;

END Heap.