Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BUFFR2.ZIP/BGENHEAP.PAS

Pascal/Delphi Source File | 1993-01-04 | 6.2 KB | 218 lines

Unit BGenHeap; {BufferedArray-Based Generic Heaps}
{$R-,O+,S-}
{$B-}
    {*MUST* ensure Short-Circuit Boolean Evaluation!}

{Introduces the Generic Heap variant of the BufferedArray Object}

{ BGenericHeaps are indexed 1..MaxElements, rather then 0..MaxElements-1 }

{ BGenericHeaps are bigger than their MaxArray based cousins, but otherwise }
{ completely interchangeable.  NOTE: Even though Copy is implemented, I do  }
{ NOT anticipate it often being possible to use it!                         }

INTERFACE

Uses BuffAray,SrtFuncs,FlexPntr,Crt;

Type
  BGenericHeap = Object (BufferedArray)

                Greater : SortFunc;

                Procedure Init (MaxElements : LongInt; ElementSize : Word;
                                MaxBuffSize : LongInt; FileName : String;
                                GreaterFunc : SortFunc);

                { Accept, Retrieve, and Swap are only redefined to      }
                { implement the 1..MaxElement indexing needed for Heaps }

                Procedure Accept (Var El; Index : LongInt; Size : Word);

                Procedure Retrieve (Var El; Index : LongInt; Size : Word);

                Procedure Swap (I,J : LongInt);

                Procedure SiftDown (I,J : LongInt);

                                   { While I can think of No reason to  }
                                   { Use SiftDown externally, there may }
                                   { be a reason, so I have exported it }

                Procedure SiftUp (Var El; Index : LongInt; Size : Word);

                                 { SiftUp can be used in place of Accept }
                                 { In order to Create/Maintain a Heap as }
                                 { a Heap while adding elements, thus    }
                                 { allowing the use of Sort instead of   }
                                 { HeapSort which structures a Heap by   }
                                 { using BuildHeap.                      }

                Procedure BuildHeap;

                                 { Creates the Heap structure from }
                                 { the ground up.                  }

                Procedure Sort;

                          { Sorts a Heap into Ascending order    }
                          { Assumes HEAP is built or maintained. }

                Procedure ChangeSort (NewSort : SortFunc);

                          { Permits the changing of sorting methods   }
                          { such as might be required for sorting     }
                          { records by a different field, for example }

                { NOTE: This will require use of HeapSort to re-sort, }
                {       or BuildHeap to establish Priority Queue.     }

                Procedure HeapSort;

                          { Sorts a Heap into Ascending order     }
                          { Assumes nothing about Heap structure. }

                Procedure Copy (From : BGenericHeap);

                          { Target Heap *MUST* be initialized  }
                          { to EXACTLY same parameters as From }
                          { with exception of FileName.        }

             End;


IMPLEMENTATION

Procedure BGenericHeap.Init;
Begin
  Greater := GreaterFunc;
  BufferedArray.Init (MaxElements,ElementSize,MaxBuffSize,FileName)
End;

Procedure BGenericHeap.Accept (Var El; Index : LongInt; Size : Word);
Begin
  BufferedArray.Accept (El,Index-1,Size)
End;

Procedure BGenericHeap.Retrieve (Var El; Index : LongInt; Size : Word);
Begin
  BufferedArray.Retrieve (El,Index-1,Size);
End;

Procedure BGenericHeap.Swap (I,J : LongInt);
Begin
  BufferedArray.Swap (I-1,J-1)
End;

Procedure BGenericHeap.SiftDown (I,J : LongInt);
Var
  K     : LongInt;
  T1,T2 : FlexPtr;
Begin
  If I <= J Div 2  {J = "HeapLength"}
    Then
      Begin
        GetMem (T1,SizeOf(FlexCount)+ElemSize);
        GetMem (T2,SizeOf(FlexCount)+ElemSize);
        If (1+2*I) > J
          Then
            K := 2*I
          Else
            Begin
              Retrieve (T1^.Flex,2*I,ElemSize);
              Retrieve (T2^.Flex,1+2*I,ElemSize);
              If (Greater (T1^.Flex,T2^.Flex))
                Then
                  K := 2*I
                Else
                  K := 1+2*I
            End;
        Retrieve (T1^.Flex,K,ElemSize);
        Retrieve (T2^.Flex,I,ElemSize);
        If (Greater (T1^.Flex,T2^.Flex))
          Then
            Begin
              Swap (K,I);
              SiftDown (K,J)
            End;
        FreeMem (T1,SizeOf(FlexCount)+ElemSize);
        FreeMem (T2,SizeOf(FlexCount)+ElemSize)
      End
End;

Procedure BGenericHeap.SiftUp (Var El; Index : LongInt; Size : Word);
Var
  J,K   : LongInt;
  T1,T2 : FlexPtr;
Begin
  Accept (El,Index,Size);
  If Index >= 2 Then
    Begin
      GetMem (T1,SizeOf(FlexCount)+ElemSize);
      GetMem (T2,SizeOf(FlexCount)+ElemSize);
      K := Index;
      J := K Div 2;
      Retrieve (T1^.Flex,K,ElemSize);
      Retrieve (T2^.Flex,J,ElemSize);
      While ((J > 0) and (Greater (T1^.Flex,T2^.Flex))) do
        Begin
          Swap (K,J);
          K := J;
          J := K Div 2;
          If J > 0
            Then
              Begin
                Retrieve (T1^.Flex,K,ElemSize);
                Retrieve (T2^.Flex,J,ElemSize)
              End
        End;
      FreeMem (T1,SizeOf(FlexCount)+ElemSize);
      FreeMem (T2,SizeOf(FlexCount)+ElemSize)
    End
End;

Procedure BGenericHeap.BuildHeap;
Var
  I: LongInt;
Begin
  For I := MaxSize Div 2 DownTo 1 do SiftDown (I,MaxSize)
End;

Procedure BGenericHeap.ChangeSort (NewSort : SortFunc);
Begin
  Greater := NewSort
End;

Procedure BGenericHeap.Sort;  {Assumes HEAP is built or maintained}
Var
  I : LongInt;
Begin
  For I := MaxSize DownTo 2 do
    Begin
      Swap (1,I);

      {DELETE FOR PRODUCTION CODE}

      GoToXY (20,15);
      Write (MaxSize-I+1);

      SiftDown (1,I-1)
    End
End;

Procedure BGenericHeap.HeapSort;
Var
  I : LongInt;
Begin
  BuildHeap;
  Sort
End;

Procedure BGenericHeap.Copy;
Begin
  Greater := From.Greater;
  BufferedArray.Copy (From)
End;

BEGIN
END.