home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GENERI.ZIP / GENLIST.ARC / LGENHEAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-23  |  4.1 KB  |  167 lines
  1. Unit LGenHeap; {Generic Fully Dynamic Doubly-Linked Heap}
  2. {$R-,O+}
  3. {$B-}
  4.     {*MUST* ensure Short-Circuit Boolean Evaluation!}
  5.  
  6. {Introduces the Heap variant of the List Object}
  7.  
  8. INTERFACE
  9.  
  10. Uses GenList,NodeSort,DoubLink,FlexPntr;
  11.  
  12.  
  13. Type
  14.   L_Heap = Object (List)
  15.  
  16.                 Greater : NodeSortFunc;
  17.  
  18.                 Procedure Init (SortBy : NodeSortFunc; Size : Word);
  19.  
  20.                                    { Size refers to ElementSize! }
  21.  
  22.                 Procedure SiftDown (I,J : LongInt);
  23.  
  24.                                    { While I can think of No reason to  }
  25.                                    { Use SiftDown externally, there may }
  26.                                    { be a reason, so I have exported it }
  27.  
  28.                 Procedure SiftUp (Var Elem; Size : Word);
  29.  
  30.                                  { SiftUp can be used in place of Append }
  31.                                  { In order to Create/Maintain a Heap as }
  32.                                  { a Heap while adding elements, thus    }
  33.                                  { allowing the use of Sort instead of   }
  34.                                  { HeapSort which structures a Heap by   }
  35.                                  { using BuildHeap.                      }
  36.  
  37.                 Procedure BuildHeap;
  38.  
  39.                                  { Creates the Heap structure from }
  40.                                  { the ground up.                  }
  41.  
  42.                 Procedure ChangeSort (NewSort : NodeSortFunc);
  43.  
  44.                           { Permits redefinition of collating sequence }
  45.                           { for already established Heaps.             }
  46.  
  47.                 Procedure Sort;
  48.  
  49.                           { Sorts a Heap into Ascending order    }
  50.                           { Assumes HEAP is built or maintained. }
  51.  
  52.                 Procedure HeapSort;
  53.  
  54.                           { Sorts a Heap into Ascending order     }
  55.                           { Assumes nothing about Heap structure. }
  56.  
  57.                 Procedure Copy (H : L_Heap)
  58.  
  59.              End;
  60.  
  61.  
  62. IMPLEMENTATION
  63.  
  64. Procedure Swap (Var D1,D2 : D_Node);
  65. {Performance Improvement: Swap Pointers -- Problems with Head and Tail
  66.                                            and with referencing items
  67.                                            to be swapped!}
  68. Var
  69.   Temp : D_Node;
  70. Begin
  71.   Temp.Create;
  72.   Temp.Copy (D1);
  73.   D1.Copy (D2);
  74.   D2.Copy (Temp);
  75.   Temp.Destroy
  76. End;
  77.  
  78. Procedure L_Heap.Init (SortBy : NodeSortFunc; Size : Word);
  79. Begin
  80.   List.Init (Size);
  81.   Greater := SortBy
  82. End;
  83.  
  84. Procedure L_Heap.SiftDown (I,J : LongInt);
  85. Var
  86.   K : LongInt;
  87. Begin
  88.   If I <= J Div 2  {J = "HeapLength"}
  89.     Then
  90.       Begin
  91.         If (1+2*I) > J
  92.           Then
  93.             K := 2*I
  94.           Else
  95.             If Greater (Node_N(2*I)^,Node_N(1+2*I)^)
  96.               Then
  97.                 K := 2*I
  98.               Else
  99.                 K := 1+2*I;
  100.         If Greater (Node_N(K)^,Node_N(I)^)
  101.           Then
  102.             Begin
  103.               Swap (Node_N(K)^,Node_N(I)^);
  104.               SiftDown (K,J)
  105.             End
  106.       End
  107. End;
  108.  
  109. Procedure L_Heap.SiftUp (Var Elem; Size : Word);
  110. Var
  111.   J,K : LongInt;
  112. Begin
  113.   Append (Elem,Size);
  114.   If CurrentLength >= 2 Then
  115.     Begin
  116.       K := CurrentLength;
  117.       J := K Div 2;
  118.       While ((J > 0) and (Greater (Node_N(K)^,Node_N(J)^))) do
  119.         Begin
  120.           Swap (Node_N(K)^,Node_N(J)^);
  121.           K := J;
  122.           J := K Div 2
  123.         End
  124.     End
  125. End;
  126.  
  127. Procedure L_Heap.BuildHeap;
  128. Var
  129.   I: LongInt;
  130. Begin
  131.   For I := CurrentLength Div 2 DownTo 1 do SiftDown (I,CurrentLength)
  132. End;
  133.  
  134. Procedure L_Heap.ChangeSort (NewSort : NodeSortFunc);
  135. Begin
  136.   Greater := NewSort
  137. End;
  138.  
  139. Procedure L_Heap.Sort;  {Assumes HEAP is built or maintained}
  140. Var
  141.   I : LongInt;
  142. Begin
  143.   For I := CurrentLength DownTo 2 do
  144.     Begin
  145.       ReWind;            { At least we CAN speed up access to Node 1! }
  146.       Swap (Node_N(1)^,Node_N(I)^);
  147.       SiftDown (1,I-1)
  148.     End
  149. End;
  150.  
  151. Procedure L_Heap.HeapSort;
  152. Var
  153.   I : LongInt;
  154. Begin
  155.   BuildHeap;
  156.   Sort
  157. End;
  158.  
  159. Procedure L_Heap.Copy (H : L_Heap);
  160. Begin
  161.   Greater := H.Greater;
  162.   List.Copy (H)
  163. End;
  164.  
  165. BEGIN
  166. END.
  167.