Doppel schnell aus Liste löschen.

[EgonHugeist]

Delphi-Quellcode:

//v. 2012-05-16
//free for any use

unit ShaRadixSorts;

interface

type
  TShaRadixKey= function(Item: pointer): integer;

//Examples:
//to descending sort by integer field: ShaRadixSort(List, Count, ShaRadixKeyIntegerDesc);
//to ascending sort by int64 field: ShaRadixSort(List, Count, ShaRadixKeyCardinal, ShaRadixKeyInt64High);
procedure ShaRadixSort(List: pointer; Count: integer; RadixKey: TShaRadixKey; RadixKeyHigh: TShaRadixKey= nil);

function ShaRadixKeyInteger(Item: pointer): integer;
function ShaRadixKeyCardinal(Item: pointer): integer;
function ShaRadixKeyInt64High(Item: pointer): integer;

function ShaRadixKeyIntegerDesc(Item: pointer): integer;
function ShaRadixKeyCardinalDesc(Item: pointer): integer;
function ShaRadixKeyInt64HighDesc(Item: pointer): integer;

implementation

//ascending order, signed integers
function ShaRadixKeyInteger(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^) xor $80000000;
  end;

//ascending order, unsigned integers or low part of int64
function ShaRadixKeyCardinal(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^);
  end;

//ascending order, high (signed) part of int64
function ShaRadixKeyInt64High(Item: pointer): integer;
type
  PCardinalArray= ^TCardinalArray;
  TCardinalArray= array[0..1] of cardinal;
begin;
  Result:=PCardinalArray(Item)[1] xor $80000000;
  end;

//descending order, signed integers
function ShaRadixKeyIntegerDesc(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^) xor $7FFFFFFF;
  end;

//descending order, unsigned integers or low part of int64
function ShaRadixKeyCardinalDesc(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^) xor $FFFFFFFF;;
  end;

//descending order, high (signed) part of int64
function ShaRadixKeyInt64HighDesc(Item: pointer): integer;
type
  PCardinalArray= ^TCardinalArray;
  TCardinalArray= array[0..1] of cardinal;
begin;
  Result:=PCardinalArray(Item)[1] xor $7FFFFFFF;
  end;

function Phase0(List, Temp, Cur: pointer; RadixKey: TShaRadixKey): integer;
const
  Skip: array[0..15] of integer= (0, 0, 0, 3, 0, 0, 6, 3, 0, 0, 0, 3, 12, 12, 12, 15);
var
  i, j, k, Zeros: integer;
begin;
  k:=0;
  for j:=-1024 to -1 do pIntegerArray(Temp)[j]:=k;

  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^);
    inc(pIntegerArray(Temp)[j and 255 - 1024]);
    inc(pIntegerArray(Temp)[j shr 8 and 255 - 768]);
    inc(pIntegerArray(Temp)[j shr 16 and 255 - 512]);
    inc(pIntegerArray(Temp)[j shr 24 - 256]);
    until Cur=List;

  j:=-1024; k:=-1; Zeros:=0;
  repeat;
    if j and 255=0 then begin;
      k:=-1; Zeros:=Zeros shl 8;
      end;
    i:=pIntegerArray(Temp)[j];
    if i=0 then inc(Zeros);
    inc(k,i);
    pIntegerArray(Temp)[j]:=k;
    inc(j);
    until j=0;

  k:=0; Zeros:=Zeros xor -1;
  for j:=1 to 4 do begin;
    k:=k+k;
    if Zeros and $FF=0 then inc(k);
    Zeros:=Zeros shr 8;
    end;
  Result:=Skip[k];
  end;

procedure Phase1(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) and 255;
    k:=pIntegerArray(Temp)[j-1024];
    pPointerArray(Temp)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-1024]:=k-1;
    until Cur=List;
  end;

procedure Phase2(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) shr 8 and 255;
    k:=pIntegerArray(Temp)[j-768];
    pPointerArray(List)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-768]:=k-1;
    until Cur=Temp;
  end;

procedure Phase3(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) shr 16 and 255;
    k:=pIntegerArray(Temp)[j-512];
    pPointerArray(Temp)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-512]:=k-1;
    until Cur=List;
  end;

procedure Phase4(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) shr 24;
    k:=pIntegerArray(Temp)[j-256];
    pPointerArray(List)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-256]:=k-1;
    until Cur=Temp;
  end;

procedure ShaRadixSort(List: pointer; Count: integer; RadixKey: TShaRadixKey; RadixKeyHigh: TShaRadixKey= nil);
var
  Temp: array of pointer;
  Skip: integer;
begin;
  if Count<=0 then exit;
  SetLength(Temp, Count+1024);
  repeat;
    Skip:=Phase0(List, @Temp[1024], @pPointerArray(List)[Count], RadixKey);
    if Skip and 1=0 then Phase1(List, @Temp[1024], @pPointerArray(List)[Count], RadixKey);
    if Skip and 2=0 then Phase2(List, @Temp[1024], @Temp[Count+1024], RadixKey);
    if Skip and 4=0 then Phase3(List, @Temp[1024], @pPointerArray(List)[Count], RadixKey);
    if Skip and 8=0 then Phase4(List, @Temp[1024], @Temp[Count+1024], RadixKey);
    RadixKey:=RadixKeyHigh;
    RadixKeyHigh:=nil;
    until not Assigned(RadixKey);
  end;

end.

Das wäre mal eine sehr schnelle Radix Interpretation von Alexandr Sharahov. QuickSort is da echt langsam dagegen. Muß dir eigentlich nur noch deinen eigen Key basteln..