stpqueue.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StPQueue.pas 4.03                           *}
{*********************************************************}
{* SysTools: Priority Queue Classes                      *}
{*********************************************************}

{$I StDefine.inc}

{Notes:
   Based on the double-ended heap (deap) described in Horowitz and Sahni,
   Data Structures and Algorithms in C.

   The deap was first reported in:
     Svante Carlsson, "The Deap - a double-ended heap to implement double-
     ended priority queues", Information Processing Letters, 26,
     pp. 33-36, 1987.

   A deap is a complete binary tree. The root node holds no data. Its
   left subtree is a min heap. Its right subtree is a max heap. If the right
   subtree is not empty, let i be any node in the left subtree. Let j be
   the node at the corresponding position in the right subtree. If such a
   j does not exist, let j be the node in the right subtree at the position
   corresponding to i's parent. The deap has the property that the data in
   node i is less than or equal to the data in node j.

   Insertion is an O(log2(n)) operation. Deletion of the min or max node
   is also an O(log2(n)) operation.

   Data elements in the deap are pointers, which can point to any record
   structure or class, or can contain any data type of 4 bytes or less.
   The deap needs an ordering relationship, so it is essential to assign
   to the Compare property inherited from the TStContainer class.

   STPQUEUE uses the DisposeData procedure of TStContainer to determine
   how to free elements in the collection. By default, it does nothing.

   In 16-bit programs the deap is limited to 16380 elements. In 32-bit
   programs the limit is set by memory usage or performance.
}

unit StPQueue;

interface

uses
  Windows, SysUtils, Classes,
  StConst, StBase;

type
  {first actual element is at index 2}
  {.Z+}
  TStPQData = array[2..(StMaxBlockSize div SizeOf(Pointer))+1] of Pointer;
  PStPQData = ^TStPQData;
  {.Z-}

  TStPQueue = class(TStContainer)
    {.Z+}
    protected {private}
      pqData     : PStPQData;         {data - the complete binary tree}
      pqCapacity : Integer;           {max elements currently possible}
      pqDelta    : Integer;           {delta elements to grow when needed}

      procedure ForEachPointer(Action : TIteratePointerFunc; OtherData : Pointer);
        override;
      function StoresPointers : Boolean;
        override;

      procedure Expand(Need : Integer);
      procedure InsertMin(I : Integer; Data : Pointer);
      procedure InsertMax(I : Integer; Data : Pointer);
      procedure ModifiedInsert(I : Integer; Data : Pointer);

    {.Z-}
    public
      constructor Create(InitCapacity, Delta : Integer);
        virtual;
        {-Initialize an empty PQueue of given capacity. If it overflows
          grow the PQueue by Delta elements}
      destructor Destroy;
        override;
        {-Free a PQueue}

      procedure LoadFromStream(S : TStream);
        override;
        {-Create a PQueue and its data from a stream}
      procedure StoreToStream(S : TStream);
        override;
        {-Write a PQueue and its data to a stream}

      procedure Clear;
        override;
        {-Remove all data from container but leave it instantiated and
          with its current capacity}

      procedure Insert(Data : Pointer);
        {-Add a new node}
      function DeleteMin : Pointer;
        {-Remove the minimum node and return its Pointer}
      function DeleteMax : Pointer;
        {-Remove the maximum node and return its Pointer}

      procedure Assign(Source : TPersistent);
        override;
        {-Assign another container's contents to this one. Only SysTools
          containers that store pointers are allowed.}
      procedure Join(Q : TStPQueue);
        {-Add PQueue Q into this one and dispose Q}

      function Iterate(Action : TIteratePointerFunc;
        OtherData : Pointer) : Pointer;
        {-Call Action for all the nodes or until Action returns false. Note
          that the nodes are visited in no particular order.}

      function Test : Boolean;
        {-Determine whether deap properties are currently valid (for debugging)}
  end;

  {.Z+}
  TStPQueueClass = class of TStPQueue;
  {.Z-}


implementation

{$IFDEF ThreadSafe}
var
  ClassCritSect : TRTLCriticalSection;
{$ENDIF}

type
  TStoreInfo = record
    Wtr : TWriter;
    SDP : TStoreDataProc;
  end;

function AssignData(Container : TStContainer;
                    Data, OtherData : Pointer) : Boolean; far;
begin
  TStPQueue(OtherData).Insert(Data);
  AssignData := True;
end;

function DestroyNode(Container : TStContainer;
  Data, OtherData : Pointer) : Boolean; far;
begin
  if Assigned(Data) then
    Container.DoDisposeData(Data);
  DestroyNode := True;
end;

procedure EnterClassCS;
begin
{$IFDEF ThreadSafe}
  EnterCriticalSection(ClassCritSect);
{$ENDIF}
end;

function JoinData(Container : TStContainer;
  Data, OtherData : Pointer) : Boolean; far;
begin
  TStPQueue(OtherData).Insert(Data);
  JoinData := True;
end;

procedure LeaveClassCS;
begin
{$IFDEF ThreadSafe}
  LeaveCriticalSection(ClassCritSect);
{$ENDIF}
end;

function log2(I : Integer) : Integer;
  {-Return the Integer below log2(I)}
begin
  Result := 0;
  while (I > 1) do begin
    Inc(Result);
    I := I shr 1;
  end;
end;

function StoreNode(Container : TStContainer;
  Data, OtherData : Pointer) : Boolean; far;
begin
  StoreNode := True;
  with TStoreInfo(OtherData^) do
    SDP(Wtr, Data);
end;

procedure TStPQueue.Assign(Source : TPersistent);
begin
  {$IFDEF ThreadSafe}
  EnterCS;
  try
  {$ENDIF}
    if not AssignPointers(Source, AssignData) then
      inherited Assign(Source);
  {$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
  {$ENDIF}
end;

procedure TStPQueue.Clear;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if conNodeProt = 0 then
      ForEachPointer(StPQueue.DestroyNode, nil);
    FCount := 0;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

constructor TStPQueue.Create(InitCapacity, Delta : Integer);
begin
  if (InitCapacity < 2) or (Delta < 1) then
    RaiseContainerError(stscBadSize);

  FCount := 0;
  {ensure that Expand creates initial capacity InitCapacity}
  pqCapacity := -Delta;
  pqDelta := Delta;
  pqData := nil;

  CreateContainer(TStNode, 0);

  Expand(InitCapacity);
end;

function TStPQueue.DeleteMin : Pointer;
var
  I, j, n : Integer;
  Temp    : Pointer;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (FCount < 1) then begin
      {deap is empty}
      DeleteMin := nil;
      exit;
    end;

    {return min element}
    DeleteMin := pqData^[2];

    {save last element and reset (helps debugging)}
    Temp := pqData^[FCount+1];
    pqData^[FCount+1] := nil;
    {decrement count, n is index of new last element}
    n := FCount;
    dec(FCount);

    if (FCount > 0) then begin
      {move empty min-root down to an appropriate leaf}
      I := 2;
      while (I shl 1 <= n) do begin
        {find child with smaller key}
        j := I shl 1;
        if (j+1 <= n) then
          if (DoCompare(pqData^[j], pqData^[j+1]) > 0) then
            Inc(j);
        pqData^[I] := pqData^[j];
        I := j;
      end;

      {insert the old last element at the given leaf position}
      ModifiedInsert(I, Temp);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStPQueue.DeleteMax : Pointer;
var
  I, j, n : Integer;
  Temp    : Pointer;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (FCount < 1) then begin
      {deap is empty}
      DeleteMax := nil;
      exit;
    end;

    {return max element}
    if (FCount = 1) then
      DeleteMax := pqData^[2]
    else
      DeleteMax := pqData^[3];

    {save last element and reset (helps debugging)}
    Temp := pqData^[FCount+1];
    pqData^[FCount+1] := nil;
    {decrement count, n is index of new last element}
    n := FCount;
    dec(FCount);

    if (FCount > 0) then begin
      {move empty max-root down to an appropriate leaf}
      I := 3;
      while (I shl 1 <= n) do begin
        {find child with larger key}
        j := I shl 1;
        if (j+1 <= n) then
          if (DoCompare(pqData^[j], pqData^[j+1]) < 0) then
            Inc(j);
        pqData^[I] := pqData^[j];
        I := j;
      end;

      {insert the old last element at the given leaf position}
      ModifiedInsert(I, Temp);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

destructor TStPQueue.Destroy;
begin
  if (pqData <> nil) then begin
    Clear;
    FreeMem(pqData, pqCapacity*SizeOf(Pointer));
  end;