[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]

    { This unit will sort ANY type of data into ANY type of order. As an added
    bonus, there are a routine to search through a sorted list of ANY type...
    Credits go to Bj”rn Felten for his QSort unit, which inspired me to write this
    routine }

    Unit SortSrch;

    interface

    Type
        CompFunc = Function(Item1, Item2: Integer): Integer;
        SwapProc = Procedure(Item1, Item2: Integer);
        CompOneFunc = Function(Item: Integer): Integer;

    Procedure QuickSort(First, Last: Integer; Comp: CompFunc; Swap: SwapProc);
    Function BinarySearch(First, Last: Integer; CompOne: CompOneFunc): Integer;

    implementation

    Procedure Partition(First, Last: Integer; Var SplitIndex: Integer;
              Comp: CompFunc; Swap: SwapProc);

      Var
        Up, Down, Middle: Integer;

      Begin
        Middle := ((Last - First) DIV 2 ) + First;
        Up := First;
        Down := Last;
        Repeat
          While (Comp(Up, Middle) <= 0) And (Up < Last) Do Inc(Up);
          While (Comp(Down, Middle) > 0) And (Down > First) Do Dec(Down);
          If Up < Down Then
             Swap(Up, Down);
        Until Up >= Down;
        SplitIndex := Down;
        Swap(Middle, SplitIndex);
      End;

    Procedure QuickSort(First, Last: Integer; Comp: CompFunc; Swap: SwapProc);

      Var
        SplitIndex: Integer;

      Begin
        If First < Last Then
          Begin
            Partition(First, Last, SplitIndex, Comp, Swap);
            QuickSort(First, SplitIndex - 1, Comp, Swap);
            QuickSort(SplitIndex + 1, Last, Comp, Swap);
          End;
      End;

    Function BinarySearch(First, Last: Integer; CompOne: CompOneFunc): Integer;

      Var
        Middle, Jfr: Integer;

      Begin
        Repeat
          Middle := ((Last - First) DIV 2 ) + First;
          Jfr := CompOne(Middle);
          If Jfr = 0 Then
            Begin
              BinarySearch := Middle;
              Exit;
            End
          Else If Jfr > 0 Then
            First := Middle
          Else
            Last := Middle;
        Until First = Last;
        BinarySearch := -1;
      End;

    end.

[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]