AW: Doppel schnell aus Lise löschen.
Hallo,
dann nimm doch 10 Punkte die schon nach x sortiert sind, Aber die Y-Werte gegeneinanderlaufen.
Delphi-Quellcode:
Gruß Horst
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; |
AW: Doppel schnell aus Lise löschen.
Delphi-Quellcode:
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..
//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. |
AW: Doppel schnell aus Lise löschen.
Wow. Schau ich mir. Thanx.
Ich hab auch noch einen (allerdings wie gehabt mit Quicksort): :-D
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; |
AW: Doppel schnell aus Lise löschen.
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 :thumb: |
AW: Doppel schnell aus Lise löschen.
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. |
AW: Doppel schnell aus Lise löschen.
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. |
AW: Doppel schnell aus Lise löschen.
Zitat:
|
AW: Doppel schnell aus Lise löschen.
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:
LG
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; Thomas |
AW: Doppel schnell aus Lise löschen.
Liste der Anhänge anzeigen (Anzahl: 1)
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:
Die Ausgabe sieht nicht sehr günstig aus.
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.
Code:
Gruß Horst
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 |
AW: Doppel schnell aus Lise löschen.
Zitat:
(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:
Kurz und knackig.
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); } } |
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:24 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz