Universität Ulm, Fakultät für Mathematik und Wirtschaftswissenschaften, SAI

# 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.
```

Ingo Melzer, 08. Juli 1999