Snippets

Stefan Glienke IntroSort

Updated by Stefan Glienke
View revision

File IntroSort.pas Modified

  • Ignore whitespace
  • Hide word diff 
     const IntrosortSizeThreshold = 16;
     class function FloorLog2(n: Integer): Integer; static;
 
-    class procedure Swap<T>(var values: array of T; left, right: Integer); static;
-    class procedure SortThreeItems<T>(var values: array of T; const comparer: IComparer<T>; left, mid, right: 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 InsertionSort<T>(var values: array of T; const comparer: IComparer<T>; left, right: Integer); static;
 
   end;
 end;
 
-class procedure TArray.Swap<T>(var values: array of T; left, right: Integer);
+class procedure TArray.SortTwoItems<T>(const comparer: IComparer<T>; left,
+  right: Pointer);
+type
+  PT = ^T;
 var
   temp: T;
 begin
-  temp := values[left];
-  values[left] := values[right];
-  values[right] := temp;
+  if comparer.Compare(PT(left)^, PT(right)^) > 0 then
+  begin
+    temp := PT(left)^;
+    PT(left)^ := PT(right)^;
+    PT(right)^ := temp;
+  end;
 end;
 
-class procedure TArray.SortThreeItems<T>(var values: array of T;
-  const comparer: IComparer<T>; left, mid, right: Integer);
+class procedure TArray.SortThreeItems<T>(const comparer: IComparer<T>; left,
+  mid, right: Pointer);
+type
+  PT = ^T;
 var
   temp: T;
 begin
-  if comparer.Compare(values[left], values[mid]) > 0 then
+  if comparer.Compare(PT(left)^, PT(mid)^) > 0 then
   begin
-    temp := values[left];
-    values[left] := values[mid];
-    values[mid] := temp;
+    temp := PT(left)^;
+    PT(left)^ := PT(mid)^;
+    PT(mid)^ := temp;
   end;
-  if comparer.Compare(values[left], values[right]) > 0 then
+  if comparer.Compare(PT(left)^, PT(right)^) > 0 then
   begin
-    temp := values[left];
-    values[left] := values[right];
-    values[right] := temp;
+    temp := PT(left)^;
+    PT(left)^ := PT(right)^;
+    PT(right)^ := temp;
   end;
-  if comparer.Compare(values[mid], values[right]) > 0 then
+  if comparer.Compare(PT(mid)^, PT(right)^) > 0 then
   begin
-    temp := values[mid];
-    values[mid] := values[right];
-    values[right] := temp;
+    temp := PT(mid)^;
+    PT(mid)^ := PT(right)^;
+    PT(right)^ := temp;
   end;
 end;
 
   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
-    Swap<T>(values, left, left + i - 1);
+    temp := values[left];
+    values[left] := values[left + i - 1];
+    values[left + i - 1] := temp;
     DownHeap<T>(values, comparer, left, i - 1, 1);
   end;
 end;
   const comparer: IComparer<T>; left, right: Integer): Integer;
 var
   mid, pivotIndex: Integer;
-  pivot: T;
+  pivot, temp: T;
 begin
   mid := left + (right - left) div 2;
 
-  SortThreeItems<T>(values, comparer, left, mid, right);
+  SortThreeItems<T>(comparer, @values[left], @values[mid], @values[right]);
 
   Dec(right);
   pivotIndex := right;
     if left >= right then
       Break;
 
-    Swap<T>(values, left, right);
+    temp := values[left];
+    values[left] := values[right];
+    values[right] := temp;
   end;
 
   pivot := values[left];
         Exit;
       if count = 2 then
       begin
-        if comparer.Compare(values[left], values[right]) > 0 then
-          Swap<T>(values, left, right);
+        SortTwoItems<T>(comparer, @values[left], @values[right]);
         Exit;
       end;
       if count = 3 then
       begin
-        SortThreeItems<T>(values, comparer, left, right - 1, right);
+        SortThreeItems<T>(comparer, @values[left], @values[right - 1], @values[right]);
         Exit;
       end;
       InsertionSort<T>(values, comparer, left, right);
Updated by Stefan Glienke
View revision

File IntroSort.pas Modified

  • Ignore whitespace
  • Hide word diff 
     class function FloorLog2(n: Integer): Integer; static;
 
     class procedure Swap<T>(var values: array of T; left, right: Integer); static;
-    class procedure SortThreeItems<T>(var values: array of T; const comparer: IComparer<T>; lo, mid, hi: Integer); static;
+    class procedure SortThreeItems<T>(var values: array of T; const comparer: IComparer<T>; left, mid, right: Integer); static;
 
-    class procedure InsertionSort<T>(var values: array of T; const comparer: IComparer<T>; lo, hi: Integer); static;
+    class procedure InsertionSort<T>(var values: array of T; const comparer: IComparer<T>; left, right: Integer); static;
 
-    class procedure DownHeap<T>(var values: array of T; const comparer: IComparer<T>; i, n, lo: Integer); static;
-    class procedure HeapSort<T>(var values: array of T; const comparer: IComparer<T>; lo, hi: Integer); static;
+    class procedure DownHeap<T>(var values: array of T; const comparer: IComparer<T>; left, count, i: Integer); static;
+    class procedure HeapSort<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>; lo, hi: Integer): 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>; lo, hi, depthLimit: Integer); static;
-
-    class procedure IntrospectiveSort<T>(var values: array of T; const comparer: IComparer<T>; left, count: 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;
 end;
 
 class procedure TArray.SortThreeItems<T>(var values: array of T;
-  const comparer: IComparer<T>; lo, mid, hi: Integer);
+  const comparer: IComparer<T>; left, mid, right: Integer);
 var
   temp: T;
 begin
-  if comparer.Compare(values[lo], values[mid]) > 0 then
+  if comparer.Compare(values[left], values[mid]) > 0 then
   begin
-    temp := values[lo];
-    values[lo] := values[mid];
+    temp := values[left];
+    values[left] := values[mid];
     values[mid] := temp;
   end;
-  if comparer.Compare(values[lo], values[hi]) > 0 then
+  if comparer.Compare(values[left], values[right]) > 0 then
   begin
-    temp := values[lo];
-    values[lo] := values[hi];
-    values[hi] := temp;
+    temp := values[left];
+    values[left] := values[right];
+    values[right] := temp;
   end;
-  if comparer.Compare(values[mid], values[hi]) > 0 then
+  if comparer.Compare(values[mid], values[right]) > 0 then
   begin
     temp := values[mid];
-    values[mid] := values[hi];
-    values[hi] := temp;
+    values[mid] := values[right];
+    values[right] := temp;
   end;
 end;
 
 class procedure TArray.DownHeap<T>(var values: array of T;
-  const comparer: IComparer<T>; i, n, lo: Integer);
+  const comparer: IComparer<T>; left, count, i: Integer);
 var
   temp: T;
-  child: Integer;
+  child, n, x: Integer;
 begin
-  temp := values[lo + i - 1];
-  while i <= n div 2 do
+  temp := values[left + i - 1];
+  n := count div 2;
+  while i <= n do
   begin
-    child := 2 * i;
-    if (child < n) and (comparer.Compare(values[lo + child - 1], values[lo + child]) < 0) then
+    child := i * 2;
+    if (child < count) and (comparer.Compare(values[left + child - 1], values[left + child]) < 0) then
       Inc(child);
-    if not comparer.Compare(temp, values[lo + child - 1]) < 0 then
+    if not comparer.Compare(temp, values[left + child - 1]) < 0 then
       Break;
-    values[lo + i - 1] := values[lo + child - 1];
+    values[left + i - 1] := values[left + child - 1];
     i := child;
   end;
-  values[lo + i - 1] := temp;
+  values[left + i - 1] := temp;
 end;
 
 class procedure TArray.HeapSort<T>(var values: array of T;
-  const comparer: IComparer<T>; lo, hi: Integer);
+  const comparer: IComparer<T>; left, right: Integer);
 var
-  n, i: Integer;
+  count, i: Integer;
 begin
-  n := hi - lo + 1;
-  for i := n div 2 downto 1 do
-    DownHeap<T>(values, comparer, i, n, lo);
-  for i := n downto 2 do
+  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
-    Swap<T>(values, lo, lo + i - 1);
-    DownHeap<T>(values, comparer, 1, i - 1, lo);
+    Swap<T>(values, left, left + i - 1);
+    DownHeap<T>(values, comparer, left, i - 1, 1);
   end;
 end;
 
 class procedure TArray.InsertionSort<T>(var values: array of T;
-  const comparer: IComparer<T>; lo, hi: Integer);
+  const comparer: IComparer<T>; left, right: Integer);
 var
   i, j: Integer;
   temp: T;
 begin
-  for i := lo to hi - 1 do
+  for i := left + 1 to right do
   begin
     j := i;
-    temp := values[i + 1];
-    while (j >= lo) and (comparer.Compare(temp, values[j]) < 0) do
+    temp := values[i];
+    while (j > left) and (comparer.Compare(temp, values[j - 1]) < 0) do
     begin
-      values[j + 1] := values[j];
+      values[j] := values[j - 1];
       Dec(j);
     end;
-    values[j + 1] := temp;
+    values[j] := temp;
   end;
 end;
 
 class function TArray.QuickSortPartition<T>(var values: array of T;
-  const comparer: IComparer<T>; lo, hi: Integer): Integer;
+  const comparer: IComparer<T>; left, right: Integer): Integer;
 var
-  mid, left, right: Integer;
+  mid, pivotIndex: Integer;
   pivot: T;
 begin
-  mid := lo + (hi - lo) div 2;
+  mid := left + (right - left) div 2;
 
-  SortThreeItems<T>(values, comparer, lo, mid, hi);
+  SortThreeItems<T>(values, comparer, left, mid, right);
 
-  left := lo;
-  right := hi - 1;
+  Dec(right);
+  pivotIndex := right;
 
   pivot := values[mid];
   values[mid] := values[right];
   end;
 
   pivot := values[left];
-  values[left] := values[hi - 1];
-  values[hi - 1] := pivot;
+  values[left] := values[pivotIndex];
+  values[pivotIndex] := pivot;
   Result := left;
 end;
 
 class procedure TArray.IntroSort<T>(var values: array of T;
-  const comparer: IComparer<T>; lo, hi, depthLimit: Integer);
+  const comparer: IComparer<T>; left, right, depthLimit: Integer);
 var
-  length, pivot: Integer;
+  count, pivot: Integer;
 begin
-  while hi > lo do
+  while right > left do
   begin
-    length := hi - lo + 1;
-    if length <= IntrosortSizeThreshold then
+    count := right - left + 1;
+    if count <= IntrosortSizeThreshold then
     begin
-      if length = 1 then
+      if count = 1 then
         Exit;
-      if length = 2 then
+      if count = 2 then
       begin
-        if comparer.Compare(values[lo], values[hi]) > 0 then
-          Swap<T>(values, lo, hi);
+        if comparer.Compare(values[left], values[right]) > 0 then
+          Swap<T>(values, left, right);
         Exit;
       end;
-      if length = 3 then
+      if count = 3 then
       begin
-        SortThreeItems<T>(values, comparer, lo, hi - 1, hi);
+        SortThreeItems<T>(values, comparer, left, right - 1, right);
         Exit;
       end;
-      InsertionSort<T>(values, comparer, lo, hi);
+      InsertionSort<T>(values, comparer, left, right);
       Exit;
     end;
 
     if depthLimit = 0 then
     begin
-      HeapSort<T>(values, comparer, lo, hi);
+      HeapSort<T>(values, comparer, left, right);
       Exit;
     end;
+
     Dec(depthLimit);
-    pivot := QuickSortPartition<T>(values, comparer, lo, hi);
-    IntroSort<T>(values, comparer, pivot + 1, hi, depthLimit);
-    hi := pivot - 1;
+    pivot := QuickSortPartition<T>(values, comparer, left, right);
+    IntroSort<T>(values, comparer, pivot + 1, right, depthLimit);
+    right := pivot - 1;
   end;
 end;
 
-class procedure TArray.IntrospectiveSort<T>(var values: array of T;
-  const comparer: IComparer<T>; left, count: Integer);
+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, left, count + left - 1, 2 * FloorLog2(Length(values)));
+  IntroSort<T>(values, comparer, index, count + index - 1, 2 * FloorLog2(count));
 end;
 
 class procedure TArray.Sort<T>(var values: array of T);
 begin
-  IntrospectiveSort<T>(values, TComparer<T>.Default, Low(Values), High(Values));
+  IntroSort<T>(values, TComparer<T>.Default, Low(Values), High(Values));
 end;
 
 class procedure TArray.Sort<T>(var values: array of T;
   const comparer: IComparer<T>);
 begin
-  IntrospectiveSort<T>(values, comparer, Low(Values), High(Values));
+  IntroSort<T>(values, comparer, Low(Values), High(Values));
 end;
 
 class procedure TArray.Sort<T>(var values: array of T;
     raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
   if count <= 1 then
     Exit;
-  IntrospectiveSort<T>(values, comparer, index, count);
+  IntroSort<T>(values, comparer, index, count);
 end;
 
 end.
Created by Stefan Glienke
View revision

File IntroSort.pas Added

  • Ignore whitespace
  • Hide word diff 
+unit IntroSort;
+
+interface
+
+uses
+  Generics.Defaults;
+
+type
+  TArray = record
+  private
+    const IntrosortSizeThreshold = 16;
+    class function FloorLog2(n: Integer): Integer; static;
+
+    class procedure Swap<T>(var values: array of T; left, right: Integer); static;
+    class procedure SortThreeItems<T>(var values: array of T; const comparer: IComparer<T>; lo, mid, hi: Integer); static;
+
+    class procedure InsertionSort<T>(var values: array of T; const comparer: IComparer<T>; lo, hi: Integer); static;
+
+    class procedure DownHeap<T>(var values: array of T; const comparer: IComparer<T>; i, n, lo: Integer); static;
+    class procedure HeapSort<T>(var values: array of T; const comparer: IComparer<T>; lo, hi: Integer); static;
+
+    class function QuickSortPartition<T>(var values: array of T; const comparer: IComparer<T>; lo, hi: Integer): Integer; static;
+
+    class procedure IntroSort<T>(var values: array of T; const comparer: IComparer<T>; lo, hi, depthLimit: Integer); static;
+
+    class procedure IntrospectiveSort<T>(var values: array of T; const comparer: IComparer<T>; left, count: 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;
+
+implementation
+
+uses
+  RTLConsts,
+  SysUtils;
+
+{ TArray }
+
+class function TArray.FloorLog2(n: Integer): Integer;
+begin
+  Result := 0;
+  while n >= 1 do
+  begin
+    Inc(Result);
+    n := n div 2;
+  end;
+end;
+
+class procedure TArray.Swap<T>(var values: array of T; left, right: Integer);
+var
+  temp: T;
+begin
+  temp := values[left];
+  values[left] := values[right];
+  values[right] := temp;
+end;
+
+class procedure TArray.SortThreeItems<T>(var values: array of T;
+  const comparer: IComparer<T>; lo, mid, hi: Integer);
+var
+  temp: T;
+begin
+  if comparer.Compare(values[lo], values[mid]) > 0 then
+  begin
+    temp := values[lo];
+    values[lo] := values[mid];
+    values[mid] := temp;
+  end;
+  if comparer.Compare(values[lo], values[hi]) > 0 then
+  begin
+    temp := values[lo];
+    values[lo] := values[hi];
+    values[hi] := temp;
+  end;
+  if comparer.Compare(values[mid], values[hi]) > 0 then
+  begin
+    temp := values[mid];
+    values[mid] := values[hi];
+    values[hi] := temp;
+  end;
+end;
+
+class procedure TArray.DownHeap<T>(var values: array of T;
+  const comparer: IComparer<T>; i, n, lo: Integer);
+var
+  temp: T;
+  child: Integer;
+begin
+  temp := values[lo + i - 1];
+  while i <= n div 2 do
+  begin
+    child := 2 * i;
+    if (child < n) and (comparer.Compare(values[lo + child - 1], values[lo + child]) < 0) then
+      Inc(child);
+    if not comparer.Compare(temp, values[lo + child - 1]) < 0 then
+      Break;
+    values[lo + i - 1] := values[lo + child - 1];
+    i := child;
+  end;
+  values[lo + i - 1] := temp;
+end;
+
+class procedure TArray.HeapSort<T>(var values: array of T;
+  const comparer: IComparer<T>; lo, hi: Integer);
+var
+  n, i: Integer;
+begin
+  n := hi - lo + 1;
+  for i := n div 2 downto 1 do
+    DownHeap<T>(values, comparer, i, n, lo);
+  for i := n downto 2 do
+  begin
+    Swap<T>(values, lo, lo + i - 1);
+    DownHeap<T>(values, comparer, 1, i - 1, lo);
+  end;
+end;
+
+class procedure TArray.InsertionSort<T>(var values: array of T;
+  const comparer: IComparer<T>; lo, hi: Integer);
+var
+  i, j: Integer;
+  temp: T;
+begin
+  for i := lo to hi - 1 do
+  begin
+    j := i;
+    temp := values[i + 1];
+    while (j >= lo) and (comparer.Compare(temp, values[j]) < 0) do
+    begin
+      values[j + 1] := values[j];
+      Dec(j);
+    end;
+    values[j + 1] := temp;
+  end;
+end;
+
+class function TArray.QuickSortPartition<T>(var values: array of T;
+  const comparer: IComparer<T>; lo, hi: Integer): Integer;
+var
+  mid, left, right: Integer;
+  pivot: T;
+begin
+  mid := lo + (hi - lo) div 2;
+
+  SortThreeItems<T>(values, comparer, lo, mid, hi);
+
+  left := lo;
+  right := hi - 1;
+
+  pivot := values[mid];
+  values[mid] := values[right];
+  values[right] := pivot;
+
+  while left < right do
+  begin
+    repeat
+      Inc(left);
+    until comparer.Compare(values[left], pivot) >= 0;
+    repeat
+      Dec(right);
+    until comparer.Compare(pivot, values[right]) >= 0;
+
+    if left >= right then
+      Break;
+
+    Swap<T>(values, left, right);
+  end;
+
+  pivot := values[left];
+  values[left] := values[hi - 1];
+  values[hi - 1] := pivot;
+  Result := left;
+end;
+
+class procedure TArray.IntroSort<T>(var values: array of T;
+  const comparer: IComparer<T>; lo, hi, depthLimit: Integer);
+var
+  length, pivot: Integer;
+begin
+  while hi > lo do
+  begin
+    length := hi - lo + 1;
+    if length <= IntrosortSizeThreshold then
+    begin
+      if length = 1 then
+        Exit;
+      if length = 2 then
+      begin
+        if comparer.Compare(values[lo], values[hi]) > 0 then
+          Swap<T>(values, lo, hi);
+        Exit;
+      end;
+      if length = 3 then
+      begin
+        SortThreeItems<T>(values, comparer, lo, hi - 1, hi);
+        Exit;
+      end;
+      InsertionSort<T>(values, comparer, lo, hi);
+      Exit;
+    end;
+
+    if depthLimit = 0 then
+    begin
+      HeapSort<T>(values, comparer, lo, hi);
+      Exit;
+    end;
+    Dec(depthLimit);
+    pivot := QuickSortPartition<T>(values, comparer, lo, hi);
+    IntroSort<T>(values, comparer, pivot + 1, hi, depthLimit);
+    hi := pivot - 1;
+  end;
+end;
+
+class procedure TArray.IntrospectiveSort<T>(var values: array of T;
+  const comparer: IComparer<T>; left, count: Integer);
+begin
+  if count < 2 then
+    Exit;
+
+  IntroSort<T>(values, comparer, left, count + left - 1, 2 * FloorLog2(Length(values)));
+end;
+
+class procedure TArray.Sort<T>(var values: array of T);
+begin
+  IntrospectiveSort<T>(values, TComparer<T>.Default, Low(Values), High(Values));
+end;
+
+class procedure TArray.Sort<T>(var values: array of T;
+  const comparer: IComparer<T>);
+begin
+  IntrospectiveSort<T>(values, comparer, Low(Values), High(Values));
+end;
+
+class procedure TArray.Sort<T>(var values: array of T;
+  const comparer: IComparer<T>; index, count: Integer);
+begin
+  if (index < Low(values)) or ((index > High(values)) and (count > 0))
+    or (index + count - 1 > High(values)) or (count < 0)
+    or (index + count < 0) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+  if count <= 1 then
+    Exit;
+  IntrospectiveSort<T>(values, comparer, index, count);
+end;
+
+end.
  2. 1
  3. 2
HTTPS SSH

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