rs26src.zip from torry.net

Xtra/QSortUnit.pas

@@ -0,0 +1,139 @@
+unit QSortUnit;
+{-------------------------------------------------------------------------------
+  Quick Sort unit
+  ---------------
+  reSource (C) 1998 Victor K /97S66
+
+  Desc:
+  Sorts the index of a block.
+  This is the classic quick sort. Idiot proof, gueranteed to sort everytime.
+  Used for debugging. To confirm that any corrupted data is not the fault of
+  the sort.
+
+
+  Notes:
+  Uses a custom CompareStr routine that wraps around the end of the block.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses BWTCompressUnit, StructsUnit;
+
+
+type
+  TQSortBlock = class
+  private
+    block: PBlock;           // block that contains the data
+    index: PLongintBlock;    // index to sort
+    block_length: longint;   // data size in block
+    last_index: longint;     // the index to the last piece of data in the block
+  public
+    constructor Create(const _block: PBlock; const _index: PLongintBlock; const _block_length: longint);
+    procedure Run;
+  end;
+
+
+
+(**) implementation (**)
+
+
+constructor TQSortBlock.Create(const _block: PBlock; const _index: PLongintBlock; const _block_length: longint);
+begin
+  block := _block;
+  index := _index;
+  block_length := _block_length;
+  last_index := block_length-1;
+end;
+
+
+
+procedure TQSortBlock.Run;
+
+  function CompareStr(a, b: integer): integer;
+  var
+    times: byte;
+    first, index: longint;
+  begin
+    if (a <> b) then
+    begin
+      for times := 1 to 3 do
+      begin
+        {Take the later index to be the counter so that we know when we reach
+        the end}
+        if (a > b) then
+          first := a
+        else
+          first := b;
+
+        for index := first to last_index do
+        begin
+          if block^[a] < block^[b] then
+          begin
+            result := -1;
+            exit;
+          end
+          else
+          if block^[a] > block^[b] then
+          begin
+            result := 1;
+            exit;
+          end;
+
+          inc(a);
+          inc(b);
+        end;
+
+        {wrap indices around}
+        if (a = last_index+1) then
+          a := 0;
+        if (b = last_index+1) then
+          b := 0;
+      end;
+
+      {Equal comparison right to the end.
+      Shorter string, or the index closer to the end is greater}
+      if (a < b) then
+        result := -1
+      else
+        result := 1;
+    end
+    else
+      result := 0;
+  end;  {Compare Str}
+
+
+
+  procedure QuickSort(const iLo, iHi: Integer);
+  var
+    Lo, Hi, Mid, T: Integer;
+  begin
+    Lo := iLo;
+    Hi := iHi;
+    Mid := index[(Lo + Hi) div 2];
+    repeat
+      while (CompareStr(index^[Lo], Mid) < 0) do inc(Lo);
+      while (CompareStr(index^[Hi], Mid) > 0) do dec(Hi);
+      {Swap}
+      if (Lo <= Hi) then
+      begin
+        T := index^[Lo];
+        index^[Lo] := index^[Hi];
+        index^[Hi] := T;
+
+        Inc(Lo);
+        Dec(Hi);
+      end;
+    until Lo > Hi;
+
+    if Hi > iLo then QuickSort(iLo, Hi);
+    if Lo < iHi then QuickSort(Lo, iHi);
+  end;
+
+begin
+  QuickSort(0, last_index);
+end;
+
+
+
+
+end.