home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue41 / Alfresco / AAPQueue.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-12-09  |  10.4 KB  |  346 lines
  1. {*********************************************************}
  2. {* AAPQueue                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Extended priority queue                               *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAPQueue;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils,
  19.   Classes;
  20.  
  21. type
  22.   TaaItemPriorityCompare = function(const aItem1, aItem2 : pointer) : integer;
  23.     {-Function prototype to take two items and compare their
  24.       priorities: returns < 0 if the first item's priority is less
  25.       than the second's, 0 if they're equal, > 0 otherwise}
  26.  
  27. type
  28.   TaaPQHandle = pointer;
  29.  
  30.   TaaPriorityQueueEx = class
  31.     {-A priority queue that uses the heap algorithm and that allows
  32.       deletion and reprioritisation of arbitrary items}
  33.     private
  34.       pqCompare : TaaItemPriorityCompare;
  35.       pqHandles : pointer;
  36.       pqList    : TList;
  37.     protected
  38.       function pqGetCount : integer;
  39.  
  40.       procedure pqBubbleUp(aFromInx : integer; aHandle : pointer);
  41.       procedure pqTrickleDown(aFromInx : integer; aHandle : pointer);
  42.  
  43.       {$IFOPT D+}
  44.       procedure VerifyIndirection;
  45.       {$ENDIF}
  46.  
  47.     public
  48.       constructor Create(aCompareFn : TaaItemPriorityCompare);
  49.         {-Create the priority queue}
  50.       destructor Destroy; override;
  51.         {-Dispose of the priority queue - items remaining are NOT
  52.           freed}
  53.  
  54.       function Add(aItem : pointer) : TaaPQHandle;
  55.         {-Add an item to the priority queue; return handle}
  56.       procedure Delete(var aHandle : TaaPQHandle);
  57.         {-Delete an item referenced by its handle from the priority
  58.           queue; the handle is set to nil on return}
  59.       function Remove : pointer;
  60.         {-Remove and return the item with the largest priority}
  61.       procedure Replace(aHandle : TaaPQHandle; aItem : pointer);
  62.         {-Replace the item referenced by the handle in the priority
  63.           queue}
  64.  
  65.       property Count : integer read pqGetCount;
  66.         {-Count of items in the queue}
  67.  
  68.       property List : TList read pqList;
  69.   end;
  70.  
  71. implementation
  72.  
  73.  
  74. {===Linked list helper routines======================================}
  75. type
  76.   PllNode = ^TllNode;
  77.   TllNode = packed record
  78.     lliNext : PllNode;
  79.     lliPrev : PllNode;
  80.     lliItem : pointer;
  81.     lliInx  : integer;
  82.   end;
  83. {--------}
  84. function CreateLinkedList : PllNode;
  85. begin
  86.   Result := AllocMem(sizeof(TllNode));
  87.   Result^.lliNext := AllocMem(sizeof(TllNode));
  88.   Result^.lliNext^.lliPrev := Result;
  89. end;
  90. {--------}
  91. procedure DestroyLinkedList(aLinkedList : PllNode);
  92. var
  93.   Temp : PllNode;
  94. begin
  95.   while (aLinkedList <> nil) do begin
  96.     Temp := aLinkedList;
  97.     aLinkedList := aLinkedList^.lliNext;
  98.     FreeMem(Temp, sizeof(TllNode));
  99.   end;
  100. end;
  101. {--------}
  102. function AddLinkedListNode(aLinkedList : PllNode; aItem : pointer) : PllNode;
  103. begin
  104.   Result := AllocMem(sizeof(TllNode));
  105.   Result^.lliNext := aLinkedList^.lliNext;
  106.   Result^.lliPrev := aLinkedList;
  107.   aLinkedList^.lliNext^.lliPrev := Result;
  108.   aLinkedList^.lliNext := Result;
  109.   Result^.lliItem := aItem;
  110. end;
  111. {--------}
  112. procedure DeleteLinkedListNode(aLinkedList : PllNode; aNode : PllNode);
  113. begin
  114.   aNode^.lliPrev^.lliNext := aNode^.lliNext;
  115.   aNode^.lliNext^.lliPrev := aNode^.lliPrev;
  116.   FreeMem(aNode, sizeof(TllNode));
  117. end;
  118. {====================================================================}
  119.  
  120.  
  121. {===TaaPriorityQueueEx===============================================}
  122. constructor TaaPriorityQueueEx.Create(aCompareFn : TaaItemPriorityCompare);
  123. begin
  124.   inherited Create;
  125.   pqCompare := aCompareFn;
  126.   pqList := TList.Create;
  127.   pqHandles := CreateLinkedList;
  128. end;
  129. {--------}
  130. destructor TaaPriorityQueueEx.Destroy;
  131. begin
  132.   pqList.Free;
  133.   DestroyLinkedList(pqHandles);
  134.   inherited Destroy;
  135. end;
  136. {--------}
  137. function TaaPriorityQueueEx.Add(aItem : pointer) : TaaPQHandle;
  138. var
  139.   Handle : PllNode;
  140. begin
  141.   {add extra space at the end of the queue}
  142.   pqList.Count := pqList.Count + 1;
  143.   {create a new node for the linked list}
  144.   Handle := AddLinkedListNode(pqHandles, aItem);
  145.   {now bubble it up as far as it will go}
  146.   if (pqList.Count = 1) then begin
  147.     pqList[0] := Handle;
  148.     Handle^.lliInx := 0;
  149.   end
  150.   else
  151.     pqBubbleUp(pred(pqList.Count), Handle);
  152.   {return the handle}
  153.   Result := Handle;
  154.   {$IFOPT D+}
  155.   VerifyIndirection;
  156.   {$ENDIF}
  157. end;
  158. {--------}
  159. procedure TaaPriorityQueueEx.Delete(var aHandle : TaaPQHandle);
  160. var
  161.   Handle    : PllNode absolute aHandle;
  162.   NewHandle : PllNode;
  163.   HeapInx   : integer;
  164.   ParentInx    : integer;
  165.   ParentHandle : PllNode;
  166. begin
  167.   {delete the handle}
  168.   HeapInx := Handle^.lliInx;
  169.   DeleteLinkedListNode(pqHandles, Handle);
  170.   Handle := nil;
  171.   {check to see whether we deleted the last item, if so just shrink
  172.    the heap - the heap property will still apply}
  173.   if (HeapInx = pred(pqList.Count)) then
  174.     pqList.Count := pqList.Count - 1
  175.   else begin
  176.     {replace the heap element with the child at the lowest, rightmost
  177.      position, and shrink the list}
  178.     NewHandle := pqList.Last;
  179.     pqList[HeapInx] := NewHandle;
  180.     NewHandle^.lliInx := HeapInx;
  181.     pqList.Count := pqList.Count - 1;
  182.     {check to see whether we can bubble up}
  183.     if (HeapInx > 0) then begin
  184.       ParentInx := (HeapInx - 1) div 2;
  185.       ParentHandle := PllNode(pqList[ParentInx]);
  186.       if (pqCompare(NewHandle^.lliItem, ParentHandle^.lliItem) > 0) then begin
  187.         pqBubbleUp(HeapInx, NewHandle);
  188.         {$IFOPT D+}
  189.         VerifyIndirection;
  190.         {$ENDIF}
  191.         Exit;
  192.       end;
  193.     end;
  194.     {otherwise trickle down}
  195.     if (pqList.Count > 0) then
  196.       pqTrickleDown(HeapInx, pqList[HeapInx]);
  197.   end;
  198.   {$IFOPT D+}
  199.   VerifyIndirection;
  200.   {$ENDIF}
  201. end;
  202. {--------}
  203. procedure TaaPriorityQueueEx.pqBubbleUp(aFromInx : integer; aHandle : pointer);
  204. var
  205.   ParentInx    : integer;
  206.   ParentHandle : PllNode;
  207.   Handle       : PllNode absolute aHandle;
  208. begin
  209.   {while the handle under consideration is larger than its parent,
  210.    swap it with its parent and continue from its new position}
  211.   {Note: the parent for the child at index N is at (N-1) div 2}
  212.   if (aFromInx > 0) then begin
  213.     ParentInx := (aFromInx - 1) div 2;
  214.     ParentHandle := PllNode(pqList[ParentInx]);
  215.     {while our item has a parent, and it's greater than the parent...}
  216.     while (aFromInx > 0) and
  217.           (pqCompare(Handle^.lliItem, ParentHandle^.lliItem) > 0) do begin
  218.       {move our parent down the tree}
  219.       pqList[aFromInx] := ParentHandle;
  220.       ParentHandle^.lliInx := aFromInx;
  221.       aFromInx := ParentInx;
  222.       ParentInx := (aFromInx - 1) div 2;
  223.       ParentHandle := PllNode(pqList[ParentInx]);
  224.     end;
  225.   end;
  226.   {store our item in the correct place}
  227.   pqList[aFromInx] := Handle;
  228.   Handle^.lliInx := aFromInx;
  229. end;
  230. {--------}
  231. function TaaPriorityQueueEx.pqGetCount : integer;
  232. begin
  233.   Result := pqList.Count;
  234. end;
  235. {--------}
  236. procedure TaaPriorityQueueEx.pqTrickleDown(aFromInx : integer; aHandle : pointer);
  237. var
  238.   ListCount   : integer;
  239.   ChildInx    : integer;
  240.   ChildHandle : PllNode;
  241.   Handle      : PllNode absolute aHandle;
  242. begin
  243.   {while the item under consideration is smaller than one of its
  244.    children, swap it with the larger child and continue from its new
  245.    position}
  246.   {Note: the children for the parent at index N are at (2N+1) and
  247.          2N+2}
  248.   ListCount := pqList.Count;
  249.   {calculate the left child index}
  250.   ChildInx := succ(aFromInx * 2);
  251.   {while there is at least a left child...}
  252.   while (ChildInx < ListCount) do begin
  253.     {if there is a right child, calculate the index of the larger
  254.      child}
  255.     if (succ(ChildInx) < ListCount) and
  256.        (pqCompare(PllNode(pqList[ChildInx])^.lliItem,
  257.                   PllNode(pqList[succ(ChildInx)])^.lliItem) < 0) then
  258.       inc(ChildInx);
  259.     {if our item is greater or equal to the larger child, we're done}
  260.     ChildHandle := PllNode(pqList[ChildInx]);
  261.     if (pqCompare(Handle^.lliItem, ChildHandle^.lliItem) >= 0) then
  262.       Break;
  263.     {otherwise move the larger child up the tree, and move our item
  264.      down the tree and repeat}
  265.     pqList[aFromInx] := ChildHandle;
  266.     ChildHandle^.lliInx := aFromInx;
  267.     aFromInx := ChildInx;
  268.     ChildInx := succ(aFromInx * 2);
  269.   end;
  270.   {store our item in the correct place}
  271.   pqList[aFromInx] := Handle;
  272.   Handle^.lliInx := aFromInx;
  273. end;
  274. {--------}
  275. function TaaPriorityQueueEx.Remove : pointer;
  276. var
  277.   Handle : PllNode;
  278. begin
  279.   {return the item at the root}
  280.   Handle := pqList[0];
  281.   Result := Handle^.lliItem;
  282.   DeleteLinkedListNode(pqHandles, Handle);
  283.   {replace the root with the child at the lowest, rightmost position,
  284.    and shrink the list}
  285.   if (pqList.Count = 1) then
  286.     pqList.Count := 0
  287.   else begin
  288.     Handle := pqList.Last;
  289.     pqList[0] := Handle;
  290.     Handle^.lliInx := 0;
  291.     pqList.Count := pqList.Count - 1;
  292.     {now trickle down the root item as far as it will go}
  293.     if (pqList.Count > 1) then
  294.       pqTrickleDown(0, Handle);
  295.   end;
  296.   {$IFOPT D+}
  297.   VerifyIndirection;
  298.   {$ENDIF}
  299. end;
  300. {--------}
  301. procedure TaaPriorityQueueEx.Replace(aHandle : TaaPQHandle; aItem : pointer);
  302. var
  303.   Handle : PllNode absolute aHandle;
  304.   ParentInx    : integer;
  305.   ParentHandle : PllNode;
  306. begin
  307.   {first, replace the item}
  308.   Handle^.lliItem := aItem;
  309.   {check to see whether we can bubble up}
  310.   if (Handle^.lliInx > 0) then begin
  311.     ParentInx := (Handle^.lliInx - 1) div 2;
  312.     ParentHandle := PllNode(pqList[ParentInx]);
  313.     if (pqCompare(Handle^.lliItem, ParentHandle^.lliItem) > 0) then begin
  314.       pqBubbleUp(Handle^.lliInx, Handle);
  315.       {$IFOPT D+}
  316.       VerifyIndirection;
  317.       {$ENDIF}
  318.       Exit;
  319.     end;
  320.   end;
  321.   {otherwise trickle down}
  322.   pqTrickleDown(Handle^.lliInx, Handle);
  323.   {$IFOPT D+}
  324.   VerifyIndirection;
  325.   {$ENDIF}
  326. end;
  327. {--------}
  328. {$IFOPT D+}
  329. procedure TaaPriorityQueueEx.VerifyIndirection;
  330. var
  331.   i : integer;
  332.   Handle : PllNode;
  333. begin
  334.   for i := 0 to pred(pqList.Count) do begin
  335.     Handle := PllNode(pqList[i]);
  336.     if (Handle^.lliInx <> i) then begin
  337.       writeln('ERROR: Handle at ', i, ' doesn''t point to it');
  338.       readln;
  339.     end;
  340.   end;
  341. end;
  342. {$ENDIF}
  343. {====================================================================}
  344.  
  345. end.
  346.