Doppel schnell aus Liste löschen.

[Horst_]

Hallo,

dann nimm doch 10 Punkte die schon nach x sortiert sind, Aber die Y-Werte gegeneinanderlaufen.

Delphi-Quellcode:

N := 5;
for I := 1 to N do
begin
  FLoatPoints.AddXY(i*cEps/N,i);
  FLoatPoints.AddXY(i*cEps/N,(N-I+1)+0.5*cEps);
end;

Gruß Horst

[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..

[Bjoerk]

Wow. Schau ich mir. Thanx.

Ich hab auch noch einen (allerdings wie gehabt mit Quicksort):

Delphi-Quellcode:

procedure TFloatPoints.Sort;
const
  Eps = 1E-4;
var
  X: double;
  A, B: integer;
begin
  // Koordinaten können mit einem instabilen Sortierverfahren nicht eindimensional sortiert werden;
  // Wir wollen aber mit dem QuickSort sortieren, weil eben schnell;
  // Deshalb sortieren wir zuerst nach X (SortByX) und anschließend alle Punkte
  // mit den gleichen X-Werten nach Y (SortByY);
  // Wir sortieren auch desshalb, weil wir Doppel schnell rauslöschen wollen;
  // Wir sortieren also zunächst (die ganze Liste) nach X;
  QuickSort(0, FCount - 1, SortCompareX);
  // Jetzt suchen wir alle Punkte mit den gleichen X-Werten und sortieren diese nach Y;
  A := 0;
  while A < FCount do
  begin
     X := FItems[A].X; // Wir suchen Punkte mit diesem X-Wert;
     B := A; // A = Index des 1. aktuellen X-Wertes, B = Index des letzten aktuellen X-Wertes;
     while (B < FCount - 1) and (SameValue(X, FItems[B + 1].X, Eps)) do
       Inc(B);
     // Nun sortieren wir diesen Teil der Liste nach Y;
     if B > A then // Wenn es mehr als 1 Punkt gibt;
     begin
       QuickSort(A, B, SortCompareY);
       A := B; // Indices A bis B abgearbeitet;
     end;
     Inc(A); // Mit diesem Index geht es weiter;
  end;
end;

[EgonHugeist]

Habe das Teil selber noch nicht getestet. Bin wegen Zeos mit ihm in Kontakt.. Wirst so einige RTL Replacements von ihm in deiner Delphi IDE finden. CompareMem z.B.

Kannst dich aber auch Dejan anschließen und meinen wenige Code bringt die schnellsten Ergebnisse

[Jens01]

Wenn das wirklich immer noch so lange dauert, könnte man vielleicht darüber nachdenken, ob Multithreading irgendwie hilfreich ist.
Habe mir gerade Dein Drawpad-Tutorial angeguckt. Genau verstanden habe ich es aber nicht, warum Du diese Löschorgie benötigst.

[Bjoerk]

Hi Bud,
nee, das dauert (mit #73) nicht (mehr) lange. So 1 bis 2 sec. beim Dxf Einlesen (Nur 1 mal erforderlich). Hier geht es um Fangpunkte, weil ohne diese ist die Zeichnerei eine Quälerei. Wichtig sind die Anzahl der Fangpunkte später beim Zeichenprozess (von neuen Objekten), weil diese bei MouseMove abgefragt werden (müssen). Deshalb kann man die auch nicht in einen Thread auslagern, weil die just in time zur Verfügung stehen müssen. Die Berechnung von weiteren Fangpunkten hab ich allerdings in einen Thread ausgelagert (z.B. Schnittpunkte). Das Programm prüft auf Fangpunkte in der Umgebung zur aktuellen Mausposition und wenn der Abstand zum nächsten Fangpunkt 1mm unterschreitet nimmt es den als MouseMove Punkt. Damit ist die Exaktheit der Zeichnung gewährleistet. Die Anzahl der Fangpunkte spielt also eine wichtige Rolle für einen flüssigen MouseMove Prozess. Und da in der Dxf viele Punkte doppelt vorhanden sind lösche ich die vorher raus. Mit #1 hat das eine Ewigkeit gedauert. Jetzt nicht mehr.

[Dejan Vu]

Zitat von Horst_:

Hallo,

dann nimm doch 10 Punkte die schon nach x sortiert sind, Aber die Y-Werte gegeneinanderlaufen.

Delphi-Quellcode:

N := 5;
for I := 1 to N do
begin
  FLoatPoints.AddXY(i*cEps/N,i);
  FLoatPoints.AddXY(i*cEps/N,(N-I+1)+0.5*cEps);
end;

Gruß Horst

Welches Ergebnis erwartest Du? Ich habe das eben probiert und es bleiben 5 Punkte übrig.

[Bjoerk]

Also, ich verabschiede mich mal an der Stelle hier und danke allen für die freundliche Unterstützung. Mit ca. 100.000 Punkten und ca. 30.000 Doppel bin ich mit #61 bei 100 ms.

Delphi-Quellcode:

    FLoatPoints.Clear;
    N := 30000;
    for I := 1 to N do
      FLoatPoints.AddXY(FloatRandom(0, 10000), FloatRandom(0, 10000));
    for I := 0 to FLoatPoints.Count div 2 do
      FLoatPoints.Insert(Random(FLoatPoints.Count), FloatPoints[Random(N)]);
    for I := 0 to FLoatPoints.Count div 2 do
      FLoatPoints.Insert(Random(FLoatPoints.Count), FloatPoint(FloatPoints[I].X + Eps, FloatPoints[I].Y));
    for I := 0 to FLoatPoints.Count div 2 do
      FLoatPoints.Insert(Random(FLoatPoints.Count), FloatPoint(FloatPoints[I].X, FloatPoints[I].Y + Eps));
    FLoatPoints.RemoveDoubles;

LG
Thomas

[Horst_]

Hallo,

wie kannst Du Dir so sicher sein?
Ich weiß nicht, wie bei Dir uFloatPoint.pas aussieht.
Wahrscheinlich habe ich jetzt eine falsche Version.

Delphi-Quellcode:

program FloatPointsTest;

{$IFDEF FPC}
  {$MODE Delphi}
{$ELSE}
  {$APPTYPE console}
{$ENDIF}

uses
  sysutils,uFloatPoints in 'uFloatPoints.pas';
// const cEps = 1e-4 in uFloatPoints
var
  OrgPoints,
  FLoatPoints,
  TmpFP : TFloatPoints;

function FloatRandom(const AFrom, ATo: double): double;
begin
  FloatRandom := random *(ATo - AFrom)+AFrom;
end;

procedure Mischen(var FP:TFloatPoints);
var
  i,j: integer;
begin
  For i := FP.Count-1 downto 1 do
  begin
    j := Random(i);
    FP.Exchange(i,j);
  end;
end;

procedure CreateNew(var FP:TFloatPoints);
var
  I, N: integer;
  Faktor : double;
begin
  randomize;
  FP.Clear;
  N := 5000;
  Writeln(n,' neue');
  Faktor := 0.1*cEps;
  for I := 1 to N do
    FP.AddXY(Faktor*I,-Faktor*I);
  writeln(FP.Count,' insgesamt' );
end;

function CheckforDoubles(var FP :TFloatPoints;check:integer): boolean;
var
  I, J: integer;
begin
  Result := true;
  Write('Vor  check double ',FP.Count);
  case check of
    0:  FP.FastRemoveDoubles;
    1:  FP.RemoveDoubles;
    2:  FP.RemoveDoublesII;
  end;
  Write(' Nach check double ',FP.Count);
  Write(' Check ');

  for I := 0 to FP.Count - 2 do
    for J := I + 1 to FP.Count - 1 do
      if SameFloatPoint(FP[I], FP[J]) then
        begin

          write(i:10,j:10,' ');
{
          writeln(FP[I].x:10:7,FP[I].y:10:7);
          writeln(FP[j].x:10:7,FP[j].y:10:7);
          writeln(sqrt(sqr(FP[j].x-FP[i].x)+
                       sqr(FP[j].y-FP[i].y)));
}
          Result := false;

          EXIT;
        end;
end;

var
  i,j: integer;
begin
  randomize;
  OrgPoints :=  TFloatPoints.Create;
  CreateNew(OrgPoints);
  For i := 1 to 10 do
  begin
    FLoatPoints := OrgPoints.Copy;
    Mischen(FLoatPoints);
    TmpFp := FLoatPoints.Copy;
    FLoatPoints.Free;
    For j := 0 to 2 do
    begin
      FLoatPoints := TmpFp.Copy;
      writeln(CheckforDoubles(FloatPoints,j));
      FLoatPoints.Free;
    end;
    TmpFp.free;
  end;
end.

Die Ausgabe sieht nicht sehr günstig aus.

Code:

5000 neue
5000 insgesamt
Vor  check double 5000 Nach check double 4999 Check          0         1 FALSE
Vor  check double 5000 Nach check double 467 Check        465       466 FALSE
Vor  check double 5000 Nach check double 625 Check TRUE

Gruß Horst

[Dejan Vu]

Zitat von Horst_:

(1)wie kannst Du Dir so sicher sein?...(2) Wahrscheinlich habe ich jetzt eine falsche Version.

(1) Ich habe es ausprobiert (sonst würde ich hier nicht so rumkrakeelen)
(2) Anders kann ich mir das nicht erklären. Ich hab hier kein Delphi (nur privat) und es mit C# kurz nachgebaut. Es geht ja ums Verfahren und nicht um den Code an sich

Code:

class Point
{
    public decimal X, Y;
    public override string ToString()
    {
        return string.Format("[{0:N2}, {1:N2}]" , X,Y);
    }
}

class PointList
{
    public decimal Eps = (decimal) 0.1;
    private readonly List<Point> items=new List<Point>();

    public List<Point> Items
    {
         get { return this.items; }
    }

    int Compare(Decimal a, Decimal b)
    {
        if (a + Eps < b)
            return -1;
        
        if (a > b + Eps)
            return +1;
        return 0;
    }
 
    int Compare(Point p1, Point p2)
    {
        int result = Compare(p1.X, p2.X);
        if (result == 0)
            result = Compare(p1.Y, p2.Y);
        return result;
    }

    public void Add(decimal x, decimal y)
    {
        items.Add(new Point {X = x, Y = y});
    }

    public void RemoveDuplicates()
    {
        items.Sort(Compare);
        int n = 0;
            
        for (int i=1;i<items.Count;i++)
        {
            if (Compare(items[i], items[n]) != 0)
            {
                n++;
                items[n] = items[i];
            }
        }
        items.RemoveRange(n+1,items.Count-n-1);
    }
}

Kurz und knackig.