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

Unit sorter;
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
 ³ This unit provides a tool for sorting arrays                             ³
 ³ The array may be of any data type! all you have to do is to provide      ³
 ³ a 'key function' by which the array elements are compared                ³
 ³ such key functions are provided for the standard data types              ³
 ³ You may write your own key functions in order to sort complex data types ³
 ³ such as records, to reverse the sort order or to create multipile sort   ³
 ³ keys for record elements.                                                ³
 ³ Note: the key function must be compiled with $F+ (far calls on)          ³
 ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
 ³ Written by: Erez Amir CompuServe ID: 100274,701    Fax. (+9723)517-1077  ³
 ³ May be used freely, as long as this notice is kept!                      ³
 ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
 ³           M O D I F I C A T I O N    H I S T O R Y                       ³
 ³                                                                          ³
 ³ Ver   Date        By             what                                    ³
 ³ ---   ------      -------------- -------------------------------         ³
 ³ 1.0   Sep-94      Erez Amir      Written, Debugged                       ³
 ³ Add your update details here...                                          ³
 ³                                                                          ³
 ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
 ³ Examples:                                                                ³
 ³    /* Simple char array */                                               ³
 ³    Var a:array[1..m] of char                                             ³
 ³ ->   Sort(a,n,SizeOf(a[1]),CharComp);                                    ³
 ³                                                                          ³
 ³    Type MyRec=Record Month,Day:integer end;                              ³
 ³         MyRecPtr=^MyRec;                                                 ³
 ³    Var MyArray: array[1..100] of MyRec;                                  ³
 ³    /* have to write your oun key */                                      ³
 ³     Function MyComp(p1,p2:Pointer):Boolean;                              ³
 ³       Var                                                                ³
 ³         v1:MyRecPtr absolute p1;                                         ³
 ³         v2:MyRecPtr absolute p2;                                         ³
 ³       Begin                                                              ³
 ³         MyComp:=(V1^.Month>V2^.Month) or                                 ³
 ³                 (V1^.Month=V2^.Month) and (V1^.Day=V2^.day);             ³
 ³       End;                                                               ³
 ³ ->   Sort(MyArray,100,SizeOf(MyRec),MyComp);                             ³
 ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Interface
Type
  CompFunc=Function(V1,V2:Pointer):Boolean;

Procedure Sort(Var Struct;      { array of any Type }
               Num,             { Number of elements }
               Size:Integer;    { Size of each element ( byte ) }
               Comp:CompFunc);

{ Basic type compare functions }
Function IntComp(I1,I2:Pointer):Boolean;   far;
Function RealComp(r1,r2:Pointer):Boolean;  far;
Function ByteComp(b1,b2:Pointer):Boolean;  far;
Function CharComp(c1,c2:Pointer):Boolean;  far;
Function StringComp(s1,s2:Pointer):Boolean;far;

Implementation

Procedure Sort{...};

  var
    Temp:Pointer;
    StructBase:Array[0..0] of Byte Absolute Struct;

  Function VLoc(n:integer):Pointer;
    { Note that no range check is performed! }
    Begin
      {$R-}
      VLoc:=Addr(structBase[n*Size]);
      {$R+}
    End;

  Procedure Swap(n1,n2:Integer);
    { swap two elements }
    Begin
      Move(VLoc(n1)^,Temp^,Size);
      Move(VLoc(n2)^,VLoc(n1)^,Size);
      Move(Temp^,VLoc(n2)^,Size);
    End;

  { Quick sort routine }
  Procedure Qsort(l,r:Integer);
    Var
      i,j:Integer;
      Pivot:Pointer;
    Begin
      i:=l;
      j:=r;
      GetMem(Pivot,Size);  { Hopefully, the midpoint}
      Move(Vloc((L+r) div 2)^,Pivot^,Size);
      Repeat
        while Comp(Pivot,Vloc(i)) do inc(i);
        while Comp(Vloc(J),pivot) do Dec(j);
        if i<=j then
          Begin
            Swap(i,j);
            Inc(i);
            Dec(j);
          End;
      until i>j;
      if j>l then Qsort(l,j); { recoursive call }
      if i<r then Qsort(i,r);
      FreeMem(Pivot,Size);
    End;
  begin
    GetMem(Temp,Size);   { Temp is used for swap }
    if num>1 then
      Qsort(0,Num-1);
    FreeMem(Temp,Size);
  end;

Function IntComp(I1,I2:Pointer):Boolean;
  Type
    IntPtr=^Integer;
  Var
    v1:IntPtr absolute I1;
    v2:IntPtr absolute I2;
  Begin
    IntComp:=V1^>V2^;
  End;
Function RealComp(r1,r2:Pointer):Boolean;
  Type
    RealPtr=^Real;
  Var
    v1:RealPtr absolute r1;
    v2:RealPtr absolute r2;
  Begin
    RealComp:=V1^>V2^;
  End;
Function ByteComp(b1,b2:Pointer):Boolean;
  Type
    BytePtr=^Byte;
  Var
    v1:BytePtr absolute b1;
    v2:BytePtr absolute b2;
  Begin
    ByteComp:=V1^>V2^;
  End;
Function CharComp(c1,c2:Pointer):Boolean;
  Begin
    CharComp:=ByteComp(c1,c2); { Byte and char are the same! }
  End;
Function StringComp(s1,s2:Pointer):Boolean;
  Type
    StringPtr=^String;
  Var
    v1:StringPtr absolute s1;
    v2:StringPtr absolute s2;
  Begin
    StringComp:=V1^>V2^;
  End;

end.

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