Snippets

Stefan Glienke IntroSort

Updated by Stefan Glienke
View revision

File IntroSort.pas Modified

  • Ignore whitespace
  • Hide word diff 
 unit IntroSort;
 
-{$O+,W-}
-
 interface
 
 uses
 var
   temp: T;
 begin
+{$IF CompilerVersion >= 28} // XE7 and higher
   case GetTypeKind(T) of
 {$IFDEF AUTOREFCOUNT}
     tkClass,
     left := right;
     right := temp;
   end;
+{$ELSE}
+  temp := left;
+  left := right;
+  right := temp;
+{$IFEND}
 end;
 
 class procedure TArray.SortTwoItems<T>(const comparer: IComparer<T>;
   var left, right: T);
 begin
   if comparer.Compare(left, right) > 0 then
-    Swap(left, right);
+    Swap<T>(left, right);
 end;
 
 class procedure TArray.SortThreeItems<T>(const comparer: IComparer<T>;
   var left, mid, right: T);
 begin
   if comparer.Compare(left, mid) > 0 then
-    Swap(left, mid);
+    Swap<T>(left, mid);
   if comparer.Compare(left, right) > 0 then
-    Swap(left, right);
+    Swap<T>(left, right);
   if comparer.Compare(mid, right) > 0 then
-    Swap(mid, right);
+    Swap<T>(mid, right);
 end;
 
 class procedure TArray.DownHeap<T>(var values: array of T;
     DownHeap<T>(values, comparer, left, count, i);
   for i := count downto 2 do
   begin
-    Swap(values[left], values[left + i - 1]);
+    Swap<T>(values[left], values[left + i - 1]);
     DownHeap<T>(values, comparer, left, i - 1, 1);
   end;
 end;
   pivotIndex := right;
 
   pivot := values[mid];
-  Swap(values[mid], values[right]);
+  Swap<T>(values[mid], values[right]);
 
   while left < right do
   begin
     if left >= right then
       Break;
 
-    Swap(values[left], values[right]);
+    Swap<T>(values[left], values[right]);
   end;
 
-  Swap(values[left], values[pivotIndex]);
+  Swap<T>(values[left], values[pivotIndex]);
   Result := left;
 end;
Updated by Stefan Glienke
View revision

File IntroSort.pas Modified

  • Ignore whitespace
  • Hide word diff 
 unit IntroSort;
 
+{$O+,W-}
+
 interface
 
 uses
     const IntrosortSizeThreshold = 16;
     class function GetDepthLimit(count: Integer): Integer; static;
 
-    class procedure SortTwoItems<T>(const comparer: IComparer<T>; left, right: Pointer); static; inline;
-    class procedure SortThreeItems<T>(const comparer: IComparer<T>; left, mid, right: Pointer); static; inline;
+    class procedure Swap<T>(var left, right: T); static; inline;
+
+    class procedure SortTwoItems<T>(const comparer: IComparer<T>; var left, right: T); static;
+    class procedure SortThreeItems<T>(const comparer: IComparer<T>; var left, mid, right: T); static;
 
     class procedure InsertionSort<T>(var values: array of T; const comparer: IComparer<T>; left, right: Integer); static;
 
 
     class function QuickSortPartition<T>(var values: array of T; const comparer: IComparer<T>; left, right: Integer): Integer; static;
 
-    class procedure IntroSort<T>(var values: array of T; const comparer: IComparer<T>; left, right, depthLimit: Integer); overload; static;
+    class procedure IntroSort<T>(var values: array of T; const comparer: IComparer<T>; left, right, depthLimit: Integer); static;
   public
     class procedure Sort<T>(var values: array of T); overload; static;
     class procedure Sort<T>(var values: array of T; const comparer: IComparer<T>); overload; static;
     class procedure Sort<T>(var values: array of T; const comparer: IComparer<T>; index, count: Integer); overload; static;
   end;
 
+procedure SwapPtr(var left, right); inline;
+
 implementation
 
 uses
   RTLConsts,
   SysUtils;
 
+procedure SwapPtr(var left, right);
+var
+  temp: Pointer;
+begin
+  temp := Pointer(left);
+  Pointer(left) := Pointer(right);
+  Pointer(right) := temp;
+end;
+
 { TArray }
 
 class function TArray.GetDepthLimit(count: Integer): Integer;
   Result := Result * 2;
 end;
 
-class procedure TArray.SortTwoItems<T>(const comparer: IComparer<T>; left,
-  right: Pointer);
-type
-  PT = ^T;
+class procedure TArray.Swap<T>(var left, right: T);
 var
   temp: T;
 begin
-  if comparer.Compare(PT(left)^, PT(right)^) > 0 then
-  begin
-    temp := PT(left)^;
-    PT(left)^ := PT(right)^;
-    PT(right)^ := temp;
+  case GetTypeKind(T) of
+{$IFDEF AUTOREFCOUNT}
+    tkClass,
+{$ENDIF AUTOREFCOUNT}
+    tkInterface,
+    tkDynArray,
+    tkUString:
+      SwapPtr(left, right);
+  else
+    temp := left;
+    left := right;
+    right := temp;
   end;
 end;
 
-class procedure TArray.SortThreeItems<T>(const comparer: IComparer<T>; left,
-  mid, right: Pointer);
-type
-  PT = ^T;
-var
-  temp: T;
+class procedure TArray.SortTwoItems<T>(const comparer: IComparer<T>;
+  var left, right: T);
 begin
-  if comparer.Compare(PT(left)^, PT(mid)^) > 0 then
-  begin
-    temp := PT(left)^;
-    PT(left)^ := PT(mid)^;
-    PT(mid)^ := temp;
-  end;
-  if comparer.Compare(PT(left)^, PT(right)^) > 0 then
-  begin
-    temp := PT(left)^;
-    PT(left)^ := PT(right)^;
-    PT(right)^ := temp;
-  end;
-  if comparer.Compare(PT(mid)^, PT(right)^) > 0 then
-  begin
-    temp := PT(mid)^;
-    PT(mid)^ := PT(right)^;
-    PT(right)^ := temp;
-  end;
+  if comparer.Compare(left, right) > 0 then
+    Swap(left, right);
+end;
+
+class procedure TArray.SortThreeItems<T>(const comparer: IComparer<T>;
+  var left, mid, right: T);
+begin
+  if comparer.Compare(left, mid) > 0 then
+    Swap(left, mid);
+  if comparer.Compare(left, right) > 0 then
+    Swap(left, right);
+  if comparer.Compare(mid, right) > 0 then
+    Swap(mid, right);
 end;
 
 class procedure TArray.DownHeap<T>(var values: array of T;
   const comparer: IComparer<T>; left, right: Integer);
 var
   count, i: Integer;
-  temp: T;
 begin
   count := right - left + 1;
   for i := count div 2 downto 1 do
     DownHeap<T>(values, comparer, left, count, i);
   for i := count downto 2 do
   begin
-    temp := values[left];
-    values[left] := values[left + i - 1];
-    values[left + i - 1] := temp;
+    Swap(values[left], values[left + i - 1]);
     DownHeap<T>(values, comparer, left, i - 1, 1);
   end;
 end;
   const comparer: IComparer<T>; left, right: Integer): Integer;
 var
   mid, pivotIndex: Integer;
-  pivot, temp: T;
+  pivot: T;
 begin
   mid := left + (right - left) div 2;
 
-  SortThreeItems<T>(comparer, @values[left], @values[mid], @values[right]);
+  SortThreeItems<T>(comparer, values[left], values[mid], values[right]);
 
   Dec(right);
   pivotIndex := right;
 
   pivot := values[mid];
-  values[mid] := values[right];
-  values[right] := pivot;
+  Swap(values[mid], values[right]);
 
   while left < right do
   begin
     if left >= right then
       Break;
 
-    temp := values[left];
-    values[left] := values[right];
-    values[right] := temp;
+    Swap(values[left], values[right]);
   end;
 
-  pivot := values[left];
-  values[left] := values[pivotIndex];
-  values[pivotIndex] := pivot;
+  Swap(values[left], values[pivotIndex]);
   Result := left;
 end;
 
       Exit;
     if count = 2 then
     begin
-      SortTwoItems<T>(comparer, @values[left], @values[right]);
+      SortTwoItems<T>(comparer, values[left], values[right]);
       Exit;
     end;
     if count = 3 then
     begin
-      SortThreeItems<T>(comparer, @values[left], @values[right - 1], @values[right]);
+      SortThreeItems<T>(comparer, values[left], values[right - 1], values[right]);
       Exit;
     end;
     if count <= IntrosortSizeThreshold then
Updated by Stefan Glienke
View revision

File IntroSort.pas Modified

  • Ignore whitespace
  • Hide word diff 
   TArray = record
   private
     const IntrosortSizeThreshold = 16;
-    class function FloorLog2(n: Integer): Integer; static;
+    class function GetDepthLimit(count: Integer): Integer; static;
 
     class procedure SortTwoItems<T>(const comparer: IComparer<T>; left, right: Pointer); static; inline;
     class procedure SortThreeItems<T>(const comparer: IComparer<T>; left, mid, right: Pointer); static; inline;
     class function QuickSortPartition<T>(var values: array of T; const comparer: IComparer<T>; left, right: Integer): Integer; static;
 
     class procedure IntroSort<T>(var values: array of T; const comparer: IComparer<T>; left, right, depthLimit: Integer); overload; static;
-    class procedure IntroSort<T>(var values: array of T; const comparer: IComparer<T>; index, count: Integer); overload; static;
   public
     class procedure Sort<T>(var values: array of T); overload; static;
     class procedure Sort<T>(var values: array of T; const comparer: IComparer<T>); overload; static;
 
 { TArray }
 
-class function TArray.FloorLog2(n: Integer): Integer;
+class function TArray.GetDepthLimit(count: Integer): Integer;
 begin
   Result := 0;
-  while n >= 1 do
+  while count > 0 do
   begin
     Inc(Result);
-    n := n div 2;
+    count := count div 2;
   end;
+  Result := Result * 2;
 end;
 
 class procedure TArray.SortTwoItems<T>(const comparer: IComparer<T>; left,
   end;
 end;
 
-class procedure TArray.IntroSort<T>(var values: array of T;
-  const comparer: IComparer<T>; index, count: Integer);
-begin
-  IntroSort<T>(values, comparer, index, count + index - 1, 2 * FloorLog2(count));
-end;
-
 class procedure TArray.Sort<T>(var values: array of T);
 begin
-  IntroSort<T>(values, TComparer<T>.Default, Low(Values), Length(Values));
+  IntroSort<T>(values, TComparer<T>.Default, Low(values), High(values), GetDepthLimit(Length(values)));
 end;
 
 class procedure TArray.Sort<T>(var values: array of T;
   const comparer: IComparer<T>);
 begin
-  IntroSort<T>(values, comparer, Low(Values), Length(Values));
+  IntroSort<T>(values, comparer, Low(values), High(values), GetDepthLimit(Length(values)));
 end;
 
 class procedure TArray.Sort<T>(var values: array of T;
     raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
   if count <= 1 then
     Exit;
-  IntroSort<T>(values, comparer, index, count);
+  IntroSort<T>(values, comparer, index, index + count - 1, GetDepthLimit(count));
 end;
 
 end.
Updated by Stefan Glienke
View revision

File IntroSort.pas Modified

  • Ignore whitespace
  • Hide word diff 
   while right > left do
   begin
     count := right - left + 1;
+    if count = 1 then
+      Exit;
+    if count = 2 then
+    begin
+      SortTwoItems<T>(comparer, @values[left], @values[right]);
+      Exit;
+    end;
+    if count = 3 then
+    begin
+      SortThreeItems<T>(comparer, @values[left], @values[right - 1], @values[right]);
+      Exit;
+    end;
     if count <= IntrosortSizeThreshold then
     begin
-      if count = 1 then
-        Exit;
-      if count = 2 then
-      begin
-        SortTwoItems<T>(comparer, @values[left], @values[right]);
-        Exit;
-      end;
-      if count = 3 then
-      begin
-        SortThreeItems<T>(comparer, @values[left], @values[right - 1], @values[right]);
-        Exit;
-      end;
       InsertionSort<T>(values, comparer, left, right);
       Exit;
     end;
 class procedure TArray.IntroSort<T>(var values: array of T;
   const comparer: IComparer<T>; index, count: Integer);
 begin
-  if count < 2 then
-    Exit;
-
   IntroSort<T>(values, comparer, index, count + index - 1, 2 * FloorLog2(count));
 end;
Updated by Stefan Glienke
View revision

File IntroSort.pas Modified

  • Ignore whitespace
  • Hide word diff 
 
 class procedure TArray.Sort<T>(var values: array of T);
 begin
-  IntroSort<T>(values, TComparer<T>.Default, Low(Values), High(Values));
+  IntroSort<T>(values, TComparer<T>.Default, Low(Values), Length(Values));
 end;
 
 class procedure TArray.Sort<T>(var values: array of T;
   const comparer: IComparer<T>);
 begin
-  IntroSort<T>(values, comparer, Low(Values), High(Values));
+  IntroSort<T>(values, comparer, Low(Values), Length(Values));
 end;
 
 class procedure TArray.Sort<T>(var values: array of T;
  2. 1
  3. 2
HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.