+ added randomized quicksort to unit sortalgs

git-svn-id: trunk@41237 -

packages/rtl-extra/src/inc/sortalgs.pp

@@ -76,10 +76,59 @@ const
     ItemListSorter_CustomItemExchanger_ContextComparer: @HeapSort_ItemList_CustomItemExchanger_Context;
   );
 
+{
+                       Randomized QuickSort
+
+  Average performance: O(n log n)
+    Worst performance: O(n*n)
+     Extra memory use: O(log n) on the stack
+               Stable: no
+     Additional notes: Uses a random element as the pivot. This makes it harder
+                       to intentionally produce an input permutation that
+                       triggers its worst O(n*n) performance. Note that, while
+                       this ensures that no particular input triggers the worst
+                       case scenario, this doesn't completely eliminate the
+                       chance of it happening. There is still an extremely
+                       small chance that the random number generator generates
+                       an unlucky sequence that triggers the worst O(n*n)
+                       performance when combined with the input permutation.
+                       And it is still possible for a malicious user to
+                       deliberately construct a worst case scenario, if the
+                       random sequence can be predicted (it is generated by a
+                       pseudorandom-number generator, which means its output is
+                       deterministic, and can be predicted if the initial random
+                       seed is known. And Randomize uses the system time to
+                       initialize the random seed, which also makes it easy to
+                       predict). If these risks cannot be tolerated, a different
+                       sorting algorithm should be used.
+}
+
+procedure RandomizedQuickSort_PtrList_NoContext(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_NoContext);
+procedure RandomizedQuickSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+procedure RandomizedQuickSort_ItemList_Context(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+procedure RandomizedQuickSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+const
+  RandomizedQuickSort: TSortingAlgorithm = (
+    PtrListSorter_NoContextComparer: @RandomizedQuickSort_PtrList_NoContext;
+    PtrListSorter_ContextComparer: @RandomizedQuickSort_PtrList_Context;
+    ItemListSorter_ContextComparer: @RandomizedQuickSort_ItemList_Context;
+    ItemListSorter_CustomItemExchanger_ContextComparer: @RandomizedQuickSort_ItemList_CustomItemExchanger_Context;
+  );
+
 implementation
 
 {$GOTO on}
 
+{*****************************************************************************
+                                   HeapSort
+*****************************************************************************}
+
 function HeapSort_Parent(i: SizeUInt): SizeUInt; inline;
 begin
   Result := (i - 1) div 2;
@@ -311,4 +360,305 @@ begin
   end;
 end;
 
+{*****************************************************************************
+                            Randomized QuickSort
+*****************************************************************************}
+
+function Random_SizeUInt(L: SizeUInt): SizeUInt;
+begin
+{$if sizeof(SizeUInt)=2}
+  Result := Random(LongInt(L));
+{$elseif sizeof(SizeUInt)=4}
+  Result := Random(Int64(L));
+{$elseif sizeof(SizeUInt)=8}
+  Result := Random(Int64($100000000));
+  Result := Result or (SizeUInt(Random(Int64($100000000))) shl 32);
+  if L <> 0 then
+    Result := Result mod L
+  else
+    Result := 0;
+{$else}
+  {$fatal Unexpected size of SizeUInt}
+{$endif}
+end;
+
+procedure RandomizedQuickSort_PtrList_NoContext(ItemPtrs: PPointer; L, R : SizeUInt;
+                                                Comparer: TListSortComparer_NoContext);
+var
+  I, J, PivotIdx : SizeUInt;
+  P, Q : Pointer;
+begin
+ repeat
+   I := L;
+   J := R;
+   PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+   P := ItemPtrs[PivotIdx];
+   repeat
+     while (I < PivotIdx) and (Comparer(P, ItemPtrs[i]) > 0) do
+       Inc(I);
+     while (J > PivotIdx) and (Comparer(P, ItemPtrs[J]) < 0) do
+       Dec(J);
+     if I < J then
+     begin
+       Q := ItemPtrs[I];
+       ItemPtrs[I] := ItemPtrs[J];
+       ItemPtrs[J] := Q;
+       if PivotIdx = I then
+       begin
+         PivotIdx := J;
+         Inc(I);
+       end
+       else if PivotIdx = J then
+       begin
+         PivotIdx := I;
+         Dec(J);
+       end
+       else
+       begin
+         Inc(I);
+         Dec(J);
+       end;
+     end;
+   until I >= J;
+   // sort the smaller range recursively
+   // sort the bigger range via the loop
+   // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+   if (PivotIdx - L) < (R - PivotIdx) then
+   begin
+     if (L + 1) < PivotIdx then
+       RandomizedQuickSort_PtrList_NoContext(ItemPtrs, L, PivotIdx - 1, Comparer);
+     L := PivotIdx + 1;
+   end
+   else
+   begin
+     if (PivotIdx + 1) < R then
+       RandomizedQuickSort_PtrList_NoContext(ItemPtrs, PivotIdx + 1, R, Comparer);
+     if (L + 1) < PivotIdx then
+       R := PivotIdx - 1
+     else
+       exit;
+   end;
+ until L >= R;
+end;
+
+procedure RandomizedQuickSort_PtrList_NoContext(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_NoContext);
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  RandomizedQuickSort_PtrList_NoContext(ItemPtrs, 0, ItemCount - 1, Comparer);
+end;
+
+procedure RandomizedQuickSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+
+  procedure QuickSort(L, R : SizeUInt);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P, Q : Pointer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+      P := ItemPtrs[PivotIdx];
+      repeat
+        while (I < PivotIdx) and (Comparer(P, ItemPtrs[I], Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, ItemPtrs[J], Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Q := ItemPtrs[I];
+          ItemPtrs[I] := ItemPtrs[J];
+          ItemPtrs[J] := Q;
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  QuickSort(0, ItemCount - 1);
+end;
+
+procedure RandomizedQuickSort_ItemList_Context(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+
+var
+  TempBuf: Pointer;
+
+  procedure QuickSort(L, R : SizeUInt);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P : Pointer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+      P := Items + ItemSize*PivotIdx;
+      repeat
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Move((Items + ItemSize*I)^, TempBuf^, ItemSize);
+          Move((Items + ItemSize*J)^, (Items + ItemSize*I)^, ItemSize);
+          Move(TempBuf^, (Items + ItemSize*J)^, ItemSize);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+  GetMem(TempBuf, ItemSize);
+  try
+    QuickSort(0, ItemCount - 1);
+  finally
+    FreeMem(TempBuf, ItemSize);
+  end;
+end;
+
+procedure RandomizedQuickSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+  procedure QuickSort(L, R : SizeUInt);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P : Pointer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+      P := Items + ItemSize*PivotIdx;
+      repeat
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+  QuickSort(0, ItemCount - 1);
+end;
+
 end.