(****************************************************************)
(*  Copyright (c) 1989 by Edwin T. Floyd                        *)
(*                                                              *)
(*  Generalized Pairing Heap unit (partial implementation)      *)
(*                                                              *)
(*  By: Edwin T. Floyd [76067,747]                              *)
(*      #9 Adams Park Court                                     *)
(*      Columbus, GA 31909                                      *)
(*      (404) 322-0076 (home)                                   *)
(*      (404) 576-3305 (work)                                   *)
(*                                                              *)
(****************************************************************)
{$A+,B-,D+,E-,F+,I-,L+,N-,O-,R-,S-,V+}
Unit PairHeap;
Interface
Type
  HeapEntryPtr = ^HeapEntry;
  HeapEntry = Object { Header on each heap record }
    Offspring : HeapEntryPtr; { Ordered half-tree }
    Sibling : HeapEntryPtr;   { Unordered half-tree }
  End;

  Heap = Object { Generalized pairing heap }
    HeapTop : HeapEntryPtr;  { Current top of heap }
    HeapCount : LongInt;     { Number of records in heap }

    { Methods }
    Constructor Init;        { Initialize Heap }
    Destructor Done; Virtual;{ Dummy virtural destructor }

    Function Less(Var x, y : HeapEntry) : Boolean; Virtual;
    { Override with your own compare function; returns TRUE if x < y }

    Function Empty : Boolean;
    { Returns TRUE if heap is empty }

    Function EntryCount : LongInt;
    { Returns number of records on heap }

    Procedure Insert(Var Entry : HeapEntry);
    { Insert record in heap }

    Function LowEntry : Pointer;
    { Return pointer to smallest record on heap, or NIL if heap is empty }

    Function DeleteLowEntry : Pointer;
    { Like LowEntry, but also deletes smallest record from heap }
  End;

  TopSoMany = Object(Heap)
  { This heap keeps only the top N (specified in Init) entries. }
    MinEntry : HeapEntryPtr;    { Pointer to current lowest entry on heap }
    DiscardPile : HeapEntryPtr; { Chain of discarded entries }
    MaxEntryCount : LongInt;    { Maximum number of entries permitted on heap }
    DiscardCount : LongInt;     { Number of entries on the discard pile }

    Constructor Init(Max : LongInt);
    { Initialize control block, specify the maximum number of entries to keep }

    Procedure Insert(Var Entry : HeapEntry);
    { Insert an entry }

    Function GetDiscard : Pointer;
    { Remove an entry from the discard pile; returns a pointer to the entry
      or Nil if discard pile is empty. }
  End;

Implementation

Constructor Heap.Init;
{ Initialize heap control area }
Begin
  HeapTop := Nil;
  HeapCount := 0;
End;

Destructor Heap.Done; Begin End;
{ Dummy destructor }

Function Heap.Less(Var x, y : HeapEntry) : Boolean;
Begin
  WriteLn('PAIRHEAP: You must override Heap.Less');
  Halt(1);
End;

Function Heap.Empty : Boolean;
{ Returns true if heap is empty }
Begin
  Empty := HeapTop = Nil;
End;

Function Heap.EntryCount : LongInt;
{ Returns the number of elements in the heap }
Begin
  EntryCount := HeapCount;
End;

Procedure Heap.Insert(Var Entry : HeapEntry);
{ Insert record in heap }
Begin
  With Entry Do Begin
    Sibling := HeapTop;
    Offspring := Nil;
    HeapTop := @Entry;
    Inc(HeapCount);
  End;
End;

Procedure SortHeapTop(Var Control : Heap);
{ Locate the smallest record in the heap and point HeapTop to it }
Var
  x, z : HeapEntryPtr;

  Procedure SortPair; { x given }
  { y := Sibling(x); z := sibling(y); x := Lowest(x, y); Offspring(x) := y }
  Var
    y : HeapEntryPtr;
  Begin { SortPair}
    With x^ Do Begin
      y := Sibling;
      Sibling := Nil;
    End;
    If y = Nil Then z := Nil Else Begin
      With y^ Do Begin
        z := Sibling;
        Sibling := Nil;
      End;
      If Control.Less(x^, y^) Then Begin
        y^.Sibling := x^.Offspring;
        x^.Offspring := y;
      End Else Begin
        x^.Sibling := y^.Offspring;
        y^.Offspring := x;
        x := y;
      End;
    End;
  End;  { SortPair }

Begin { SortHeapTop }
  With Control Do Begin
    If HeapTop <> Nil Then Repeat
      x := HeapTop;
      SortPair;
      HeapTop := x;
      With HeapTop^ Do While z <> Nil Do Begin
        x := z;
        SortPair;
        x^.Sibling := Sibling;
        Sibling := x;
      End;
    Until HeapTop^.Sibling = Nil;
  End;
End;  { SortHeapTop }

Function Heap.LowEntry : Pointer;
{ Return pointer to smallest heap record }
Begin
  SortHeapTop(Self);
  LowEntry := HeapTop;
End;

Function Heap.DeleteLowEntry : Pointer;
{ Remove smallest heap record and return a pointer to it }
Begin
  DeleteLowEntry := LowEntry;
  If HeapTop <> Nil Then Begin
    HeapTop := HeapTop^.Offspring;
    Dec(HeapCount);
  End;
End;

Constructor TopSoMany.Init(Max : LongInt);
Begin
  If Max < 1 Then Begin
    WriteLn('TopSoMany.Init Max must be > 0');
    Halt(1);
  End;
  Heap.Init;
  MinEntry := Nil;
  DiscardPile := Nil;
  MaxEntryCount := Max;
  DiscardCount := 0;
End;

Procedure TopSoMany.Insert(Var Entry : HeapEntry);
Begin
  If HeapCount < MaxEntryCount Then Begin
    If (MinEntry = Nil) Or Less(Entry, MinEntry^) Then MinEntry := @Entry;
    Heap.Insert(Entry);
  End Else Begin
    If Less(MinEntry^, Entry) Then Begin
      MinEntry := DeleteLowEntry;
      MinEntry^.Sibling := DiscardPile;
      DiscardPile := MinEntry;
      Heap.Insert(Entry);
      MinEntry := LowEntry;
    End Else Begin
      Entry.Sibling := DiscardPile;
      DiscardPile := @Entry;
    End;
    Inc(DiscardCount);
  End;
End;

Function TopSoMany.GetDiscard : Pointer;
Begin
  GetDiscard := DiscardPile;
  If DiscardPile <> Nil Then Begin
    DiscardPile := DiscardPile^.Sibling;
    Dec(DiscardCount);
  End;
End;

End.