140 lines
3.1 KiB
Plaintext
140 lines
3.1 KiB
Plaintext
|
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.
|